This is the mail archive of the
gdb-patches@sourceware.org
mailing list for the GDB project.
[2/3] RFC - reimplement common block support
- From: Tom Tromey <tromey at redhat dot com>
- To: gdb-patches at sourceware dot org
- Date: Tue, 21 Aug 2012 10:32:20 -0600
- Subject: [2/3] RFC - reimplement common block support
We've had a patch in Fedora for a long time that rewrites the Fortran
common block support. Recently I looked into another bug in this area,
and I decided to update the patch and submit it upstream.
This deletes even more mostly dead code from the Fortran support.
Then it introduces COMMON_BLOCK_DOMAIN and a new type,
fortran_common_block. A symbol in COMMON_BLOCK_DOMAIN points to a
fortran_common_block; this is then used to implement "info common".
A new test case is included.
The old code in gdb is quite broken. read_common_block uses
decode_locdesc, which is a priori wrong, and which in particular doesn't
handle TLS -- but gfortran can generate location expressions using TLS
when using OMP.
I removed the support in read_common_block for a variable in a common
block using DW_AT_data_member_location. This is not specified by DWARF
and, as near as I can tell, was present in old versions of gfortran (and
perhaps the even older g77, I didn't look), but removed in 2008.
I think this deletion makes the code cleaner. However, the next patch
restores it, in case someone thinks it is vital.
Built and regtested on x86-64 Fedora 16.
Tom
2012-08-21 Jan Kratochvil <jan.kratochvil@redhat.com>
Tom Tromey <tromey@redhat.com>
* dwarf2read.c (read_common_block): Rewrite.
(new_symbol_full): Handle DW_TAG_common_block.
* f-lang.c (head_common_list, find_common_for_function):
Remove.
* f-lang.h (struct common_entry, struct saved_f77_common,
SAVED_F77_COMMON, SAVED_F77_COMMON_PTR, COMMON_ENTRY,
COMMON_ENTRY_PTR, head_common_list, find_common_for_function,
BLANK_COMMON_NAME_LOCAL): Remove.
(struct fortran_common_block): New.
* f-valprint.c (list_all_visible_commons): Remove.
(info_common_command_for_block): New function.
(info_common_command): Use it.
* stack.c (iterate_over_block_locals): Special case for
COMMON_BLOCK_DOMAIN.
* symtab.h (enum domain_enum_tag) <COMMON_BLOCK_DOMAIN>: New
constant.
(struct general_symbol_info) <value.common_block>: New field.
(SYMBOL_VALUE_COMMON_BLOCK): New define.
* gdb.fortran/common-block.exp: New file.
* gdb.fortran/common-block.f90: New file.
diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
index 099b67a..ca827eb 100644
--- a/gdb/dwarf2read.c
+++ b/gdb/dwarf2read.c
@@ -65,6 +65,7 @@
#include "gdb/gdb-index.h"
#include <ctype.h>
#include "gdb_bfd.h"
+#include "f-lang.h"
#include <fcntl.h>
#include "gdb_string.h"
@@ -11059,50 +11060,49 @@ read_set_type (struct die_info *die, struct dwarf2_cu *cu)
return set_die_type (die, set_type, cu);
}
-/* First cut: install each common block member as a global variable. */
+/* Create appropriate locally-scoped variables for all the
+ DW_TAG_common_block entries. Also create a struct
+ fortran_common_block listing all such variables for `info common'.
+ COMMON_BLOCK_DOMAIN is used to sepate the common blocks name
+ namespace from regular variable names. */
static void
read_common_block (struct die_info *die, struct dwarf2_cu *cu)
{
- struct die_info *child_die;
- struct attribute *attr;
- struct symbol *sym;
- CORE_ADDR base = (CORE_ADDR) 0;
-
- attr = dwarf2_attr (die, DW_AT_location, cu);
- if (attr)
- {
- /* Support the .debug_loc offsets. */
- if (attr_form_is_block (attr))
- {
- base = decode_locdesc (DW_BLOCK (attr), cu);
- }
- else if (attr_form_is_section_offset (attr))
- {
- dwarf2_complex_location_expr_complaint ();
- }
- else
- {
- dwarf2_invalid_attrib_class_complaint ("DW_AT_location",
- "common block member");
- }
- }
if (die->child != NULL)
{
- child_die = die->child;
- while (child_die && child_die->tag)
- {
- LONGEST offset;
+ struct objfile *objfile = cu->objfile;
+ struct die_info *child_die;
+ unsigned int n_entries = 0;
+ struct fortran_common_block *common_block;
+ int size, count;
+ struct symbol *sym;
+ for (child_die = die->child;
+ child_die && child_die->tag;
+ child_die = sibling_die (child_die))
+ ++n_entries;
+
+ size = (sizeof (struct fortran_common_block)
+ + (n_entries - 1) * sizeof (struct symbol *));
+ common_block = obstack_alloc (&objfile->objfile_obstack, size);
+ memset (common_block->contents, 0, n_entries * sizeof (struct symbol *));
+ common_block->n_entries = n_entries;
+
+ count = 0;
+ for (child_die = die->child;
+ child_die && child_die->tag;
+ child_die = sibling_die (child_die))
+ {
+ /* Create the symbol in the DW_TAG_common_block block in the current
+ symbol scope. */
sym = new_symbol (child_die, NULL, cu);
- if (sym != NULL
- && handle_data_member_location (child_die, cu, &offset))
- {
- SYMBOL_VALUE_ADDRESS (sym) = base + offset;
- add_symbol_to_list (sym, &global_symbols);
- }
- child_die = sibling_die (child_die);
+ if (sym)
+ common_block->contents[count++] = sym;
}
+
+ sym = new_symbol (die, objfile_type (objfile)->builtin_void, cu);
+ SYMBOL_VALUE_COMMON_BLOCK (sym) = common_block;
}
}
@@ -14949,6 +14949,13 @@ new_symbol_full (struct die_info *die, struct type *type, struct dwarf2_cu *cu,
{
var_decode_location (attr, sym, cu);
attr2 = dwarf2_attr (die, DW_AT_external, cu);
+
+ /* Fortran explicitly imports any global symbols to the local
+ scope by DW_TAG_common_block. */
+ if (cu->language == language_fortran && die->parent
+ && die->parent->tag == DW_TAG_common_block)
+ attr2 = NULL;
+
if (SYMBOL_CLASS (sym) == LOC_STATIC
&& SYMBOL_VALUE_ADDRESS (sym) == 0
&& !dwarf2_per_objfile->has_section_at_zero)
@@ -15113,6 +15120,11 @@ new_symbol_full (struct die_info *die, struct type *type, struct dwarf2_cu *cu,
SYMBOL_CLASS (sym) = LOC_TYPEDEF;
list_to_add = &global_symbols;
break;
+ case DW_TAG_common_block:
+ SYMBOL_CLASS (sym) = LOC_STATIC;
+ SYMBOL_DOMAIN (sym) = COMMON_BLOCK_DOMAIN;
+ add_symbol_to_list (sym, cu->list_in_scope);
+ break;
default:
/* Not a tag we recognize. Hopefully we aren't processing
trash data, but since we must specifically ignore things
diff --git a/gdb/f-lang.c b/gdb/f-lang.c
index 3be49af..0b3645f 100644
--- a/gdb/f-lang.c
+++ b/gdb/f-lang.c
@@ -349,27 +349,3 @@ _initialize_f_language (void)
add_language (&f_language_defn);
}
-
-SAVED_F77_COMMON_PTR head_common_list = NULL; /* Ptr to 1st saved COMMON */
-
-/* This routine finds the first encountred COMMON block named "name"
- that belongs to function funcname. */
-
-SAVED_F77_COMMON_PTR
-find_common_for_function (const char *name, const char *funcname)
-{
-
- SAVED_F77_COMMON_PTR tmp;
-
- tmp = head_common_list;
-
- while (tmp != NULL)
- {
- if (strcmp (tmp->name, name) == 0
- && strcmp (tmp->owning_function, funcname) == 0)
- return (tmp);
- else
- tmp = tmp->next;
- }
- return (NULL);
-}
diff --git a/gdb/f-lang.h b/gdb/f-lang.h
index 71dae46..d1b6924 100644
--- a/gdb/f-lang.h
+++ b/gdb/f-lang.h
@@ -48,33 +48,16 @@ enum f90_range_type
NONE_BOUND_DEFAULT /* "(low:high)" */
};
-struct common_entry
- {
- struct symbol *symbol; /* The symbol node corresponding
- to this component */
- struct common_entry *next; /* The next component */
- };
-
-struct saved_f77_common
- {
- char *name; /* Name of COMMON */
- char *owning_function; /* Name of parent function */
- int secnum; /* Section # of .bss */
- CORE_ADDR offset; /* Offset from .bss for
- this block */
- struct common_entry *entries; /* List of block's components */
- struct common_entry *end_of_entries; /* ptr. to end of components */
- struct saved_f77_common *next; /* Next saved COMMON block */
- };
+/* A common block. */
-typedef struct saved_f77_common SAVED_F77_COMMON, *SAVED_F77_COMMON_PTR;
-
-typedef struct common_entry COMMON_ENTRY, *COMMON_ENTRY_PTR;
-
-extern SAVED_F77_COMMON_PTR head_common_list; /* Ptr to 1st saved COMMON */
+struct fortran_common_block
+{
+ /* The number of entries in the block. */
+ unsigned int n_entries;
-extern SAVED_F77_COMMON_PTR find_common_for_function (const char *,
- const char *);
+ /* The contents of the block, allocated using the struct hack. */
+ struct symbol *contents[1];
+};
extern int f77_get_upperbound (struct type *);
diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c
index 4f165ce..3ffd7f4 100644
--- a/gdb/f-valprint.c
+++ b/gdb/f-valprint.c
@@ -34,10 +34,12 @@
#include "gdbcore.h"
#include "command.h"
#include "block.h"
+#include "dictionary.h"
+#include "gdb_assert.h"
+#include "exceptions.h"
extern void _initialize_f_valprint (void);
static void info_common_command (char *, int);
-static void list_all_visible_commons (const char *);
static void f77_create_arrayprint_offset_tbl (struct type *,
struct ui_file *);
static void f77_get_dynamic_length_of_aggregate (struct type *);
@@ -410,21 +412,60 @@ f_val_print (struct type *type, const gdb_byte *valaddr, int embedded_offset,
}
static void
-list_all_visible_commons (const char *funname)
+info_common_command_for_block (struct block *block, const char *comname,
+ int *any_printed)
{
- SAVED_F77_COMMON_PTR tmp;
-
- tmp = head_common_list;
-
- printf_filtered (_("All COMMON blocks visible at this level:\n\n"));
-
- while (tmp != NULL)
- {
- if (strcmp (tmp->owning_function, funname) == 0)
- printf_filtered ("%s\n", tmp->name);
-
- tmp = tmp->next;
- }
+ struct block_iterator iter;
+ struct symbol *sym;
+ const char *name;
+ struct value_print_options opts;
+
+ get_user_print_options (&opts);
+
+ ALL_BLOCK_SYMBOLS (block, iter, sym)
+ if (SYMBOL_DOMAIN (sym) == COMMON_BLOCK_DOMAIN)
+ {
+ struct fortran_common_block *common = SYMBOL_VALUE_COMMON_BLOCK (sym);
+ int index;
+
+ gdb_assert (SYMBOL_CLASS (sym) == LOC_STATIC);
+
+ if (comname && (!SYMBOL_LINKAGE_NAME (sym)
+ || strcmp (comname, SYMBOL_LINKAGE_NAME (sym)) != 0))
+ continue;
+
+ if (*any_printed)
+ putchar_filtered ('\n');
+ else
+ *any_printed = 1;
+ if (SYMBOL_PRINT_NAME (sym))
+ printf_filtered (_("Contents of F77 COMMON block '%s':\n"),
+ SYMBOL_PRINT_NAME (sym));
+ else
+ printf_filtered (_("Contents of blank COMMON block:\n"));
+
+ for (index = 0; index < common->n_entries; index++)
+ {
+ struct value *val = NULL;
+ volatile struct gdb_exception except;
+
+ if (!common->contents[index])
+ continue;
+
+ printf_filtered ("%s = ",
+ SYMBOL_PRINT_NAME (common->contents[index]));
+
+ TRY_CATCH (except, RETURN_MASK_ERROR)
+ {
+ val = value_of_variable (common->contents[index], block);
+ value_print (val, gdb_stdout, &opts);
+ }
+
+ if (except.reason < 0)
+ printf_filtered ("<error reading variable: %s>", except.message);
+ putchar_filtered ('\n');
+ }
+ }
}
/* This function is used to print out the values in a given COMMON
@@ -434,11 +475,9 @@ list_all_visible_commons (const char *funname)
static void
info_common_command (char *comname, int from_tty)
{
- SAVED_F77_COMMON_PTR the_common;
- COMMON_ENTRY_PTR entry;
struct frame_info *fi;
- const char *funname = 0;
- struct symbol *func;
+ struct block *block;
+ int values_printed = 0;
/* We have been told to display the contents of F77 COMMON
block supposedly visible in this function. Let us
@@ -450,87 +489,30 @@ info_common_command (char *comname, int from_tty)
/* The following is generally ripped off from stack.c's routine
print_frame_info(). */
- func = find_pc_function (get_frame_pc (fi));
- if (func)
+ block = get_frame_block (fi, 0);
+ if (block == NULL)
{
- /* In certain pathological cases, the symtabs give the wrong
- function (when we are in the first function in a file which
- is compiled without debugging symbols, the previous function
- is compiled with debugging symbols, and the "foo.o" symbol
- that is supposed to tell us where the file with debugging symbols
- ends has been truncated by ar because it is longer than 15
- characters).
-
- So look in the minimal symbol tables as well, and if it comes
- up with a larger address for the function use that instead.
- I don't think this can ever cause any problems; there shouldn't
- be any minimal symbols in the middle of a function.
- FIXME: (Not necessarily true. What about text labels?) */
-
- struct minimal_symbol *msymbol =
- lookup_minimal_symbol_by_pc (get_frame_pc (fi));
-
- if (msymbol != NULL
- && (SYMBOL_VALUE_ADDRESS (msymbol)
- > BLOCK_START (SYMBOL_BLOCK_VALUE (func))))
- funname = SYMBOL_LINKAGE_NAME (msymbol);
- else
- funname = SYMBOL_LINKAGE_NAME (func);
- }
- else
- {
- struct minimal_symbol *msymbol =
- lookup_minimal_symbol_by_pc (get_frame_pc (fi));
-
- if (msymbol != NULL)
- funname = SYMBOL_LINKAGE_NAME (msymbol);
- else /* Got no 'funname', code below will fail. */
- error (_("No function found for frame."));
+ printf_filtered (_("No symbol table info available.\n"));
+ return;
}
- /* If comname is NULL, we assume the user wishes to see the
- which COMMON blocks are visible here and then return. */
-
- if (comname == 0)
+ while (block)
{
- list_all_visible_commons (funname);
- return;
+ info_common_command_for_block (block, comname, &values_printed);
+ /* After handling the function's top-level block, stop. Don't
+ continue to its superblock, the block of per-file symbols. */
+ if (BLOCK_FUNCTION (block))
+ break;
+ block = BLOCK_SUPERBLOCK (block);
}
- the_common = find_common_for_function (comname, funname);
-
- if (the_common)
+ if (!values_printed)
{
- struct frame_id frame_id = get_frame_id (fi);
-
- if (strcmp (comname, BLANK_COMMON_NAME_LOCAL) == 0)
- printf_filtered (_("Contents of blank COMMON block:\n"));
+ if (comname)
+ printf_filtered (_("No common block '%s'.\n"), comname);
else
- printf_filtered (_("Contents of F77 COMMON block '%s':\n"), comname);
-
- printf_filtered ("\n");
- entry = the_common->entries;
-
- while (entry != NULL)
- {
- fi = frame_find_by_id (frame_id);
- if (fi == NULL)
- {
- warning (_("Unable to restore previously selected frame."));
- break;
- }
-
- print_variable_and_value (NULL, entry->symbol, fi, gdb_stdout, 0);
-
- /* print_variable_and_value invalidates FI. */
- fi = NULL;
-
- entry = entry->next;
- }
+ printf_filtered (_("No common blocks.\n"));
}
- else
- printf_filtered (_("Cannot locate the common block %s in function '%s'\n"),
- comname, funname);
}
void
diff --git a/gdb/stack.c b/gdb/stack.c
index 51747ea..700552d 100644
--- a/gdb/stack.c
+++ b/gdb/stack.c
@@ -1847,6 +1847,8 @@ iterate_over_block_locals (struct block *b,
case LOC_COMPUTED:
if (SYMBOL_IS_ARGUMENT (sym))
break;
+ if (SYMBOL_DOMAIN (sym) == COMMON_BLOCK_DOMAIN)
+ break;
(*cb) (SYMBOL_PRINT_NAME (sym), sym, cb_data);
break;
diff --git a/gdb/symtab.h b/gdb/symtab.h
index 76120a3..42fc178 100644
--- a/gdb/symtab.h
+++ b/gdb/symtab.h
@@ -37,6 +37,7 @@ struct agent_expr;
struct program_space;
struct language_defn;
struct probe;
+struct fortran_common_block;
/* Some of the structures in this file are space critical.
The space-critical structures are:
@@ -119,6 +120,10 @@ struct general_symbol_info
CORE_ADDR address;
+ /* A common block. Used with COMMON_BLOCK_DOMAIN. */
+
+ struct fortran_common_block *common_block;
+
/* For opaque typedef struct chain. */
struct symbol *chain;
@@ -181,6 +186,7 @@ extern CORE_ADDR symbol_overlayed_address (CORE_ADDR, struct obj_section *);
#define SYMBOL_VALUE(symbol) (symbol)->ginfo.value.ivalue
#define SYMBOL_VALUE_ADDRESS(symbol) (symbol)->ginfo.value.address
#define SYMBOL_VALUE_BYTES(symbol) (symbol)->ginfo.value.bytes
+#define SYMBOL_VALUE_COMMON_BLOCK(symbol) (symbol)->ginfo.value.common_block
#define SYMBOL_BLOCK_VALUE(symbol) (symbol)->ginfo.value.block
#define SYMBOL_VALUE_CHAIN(symbol) (symbol)->ginfo.value.chain
#define SYMBOL_LANGUAGE(symbol) (symbol)->ginfo.language
@@ -394,7 +400,10 @@ typedef enum domain_enum_tag
/* LABEL_DOMAIN may be used for names of labels (for gotos). */
- LABEL_DOMAIN
+ LABEL_DOMAIN,
+
+ /* Fortran common blocks. Their naming must be separate from VAR_DOMAIN. */
+ COMMON_BLOCK_DOMAIN
} domain_enum;
/* Searching domains, used for `search_symbols'. Element numbers are
diff --git a/gdb/testsuite/gdb.fortran/common-block.exp b/gdb/testsuite/gdb.fortran/common-block.exp
new file mode 100644
index 0000000..36e1586
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/common-block.exp
@@ -0,0 +1,94 @@
+# Copyright 2008, 2012 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+# This file was written by Jan Kratochvil <jan.kratochvil@redhat.com>.
+
+standard_testfile .f90
+
+if {[prepare_for_testing ${testfile}.exp ${testfile} \
+ $srcfile {debug f90 quiet}]} {
+ return -1
+}
+
+if ![runto MAIN__] then {
+ perror "couldn't run to breakpoint MAIN__"
+ continue
+}
+
+gdb_breakpoint [gdb_get_line_number "stop-here-out"]
+gdb_continue_to_breakpoint "stop-here-out"
+
+# Common block naming with source name /foo/:
+# .symtab DW_TAG_common_block's DW_AT_name
+# Intel Fortran foo_ foo_
+# GNU Fortran foo_ foo
+#set suffix "_"
+set suffix ""
+
+set int4 {(integer\(kind=4\)|INTEGER\(4\))}
+set real4 {(real\(kind=4\)|REAL\(4\))}
+set real8 {(real\(kind=8\)|REAL\(8\))}
+
+gdb_test "whatis foo$suffix" "No symbol \"foo$suffix\" in current context."
+gdb_test "ptype foo$suffix" "No symbol \"foo$suffix\" in current context."
+gdb_test "p foo$suffix" "No symbol \"foo$suffix\" in current context."
+gdb_test "whatis fo_o$suffix" "No symbol \"fo_o$suffix\" in current context."
+gdb_test "ptype fo_o$suffix" "No symbol \"fo_o$suffix\" in current context."
+gdb_test "p fo_o$suffix" "No symbol \"fo_o$suffix\" in current context."
+
+gdb_test "info locals" "ix_x = 11\r\niy_y = 22\r\niz_z = 33\r\nix = 1\r\niy = 2\r\niz = 3" "info locals out"
+gdb_test "info common" "Contents of F77 COMMON block 'fo_o':\r\nix_x = 11\r\niy_y = 22\r\niz_z = 33\r\n\r\nContents of F77 COMMON block 'foo':\r\nix = 1\r\niy = 2\r\niz = 3" "info common out"
+
+gdb_test "ptype ix" "type = $int4" "ptype ix out"
+gdb_test "ptype iy" "type = $real4" "ptype iy out"
+gdb_test "ptype iz" "type = $real8" "ptype iz out"
+gdb_test "ptype ix_x" "type = $int4" "ptype ix_x out"
+gdb_test "ptype iy_y" "type = $real4" "ptype iy_y out"
+gdb_test "ptype iz_z" "type = $real8" "ptype iz_z out"
+
+gdb_test "p ix" " = 1 *" "p ix out"
+gdb_test "p iy" " = 2 *" "p iy out"
+gdb_test "p iz" " = 3 *" "p iz out"
+gdb_test "p ix_x" " = 11 *" "p ix_x out"
+gdb_test "p iy_y" " = 22 *" "p iy_y out"
+gdb_test "p iz_z" " = 33 *" "p iz_z out"
+
+gdb_breakpoint [gdb_get_line_number "stop-here-in"]
+gdb_continue_to_breakpoint "stop-here-in"
+
+gdb_test "whatis foo$suffix" "No symbol \"foo$suffix\" in current context." "whatis foo$suffix in"
+gdb_test "ptype foo$suffix" "No symbol \"foo$suffix\" in current context." "ptype foo$suffix in"
+gdb_test "p foo$suffix" "No symbol \"foo$suffix\" in current context." "p foo$suffix in"
+gdb_test "whatis fo_o$suffix" "No symbol \"fo_o$suffix\" in current context." "whatis fo_o$suffix in"
+gdb_test "ptype fo_o$suffix" "No symbol \"fo_o$suffix\" in current context." "ptype fo_o$suffix in"
+gdb_test "p fo_o$suffix" "No symbol \"fo_o$suffix\" in current context." "p fo_o$suffix in"
+
+gdb_test "info locals" "ix = 11\r\niy2 = 22\r\niz = 33\r\nix_x = 1\r\niy_y = 2\r\niz_z2 = 3\r\niy = 5\r\niz_z = 55" "info locals in"
+gdb_test "info common" "Contents of F77 COMMON block 'fo_o':\r\nix = 11\r\niy2 = 22\r\niz = 33\r\n\r\nContents of F77 COMMON block 'foo':\r\nix_x = 1\r\niy_y = 2\r\niz_z2 = 3" "info common in"
+
+gdb_test "ptype ix" "type = $int4" "ptype ix in"
+gdb_test "ptype iy2" "type = $real4" "ptype iy2 in"
+gdb_test "ptype iz" "type = $real8" "ptype iz in"
+gdb_test "ptype ix_x" "type = $int4" "ptype ix_x in"
+gdb_test "ptype iy_y" "type = $real4" "ptype iy_y in"
+gdb_test "ptype iz_z2" "type = $real8" "ptype iz_z2 in"
+
+gdb_test "p ix" " = 11 *" "p ix in"
+gdb_test "p iy2" " = 22 *" "p iy2 in"
+gdb_test "p iz" " = 33 *" "p iz in"
+gdb_test "p ix_x" " = 1 *" "p ix_x in"
+gdb_test "p iy_y" " = 2 *" "p iy_y in"
+gdb_test "p iz_z2" " = 3 *" "p iz_z2 in"
diff --git a/gdb/testsuite/gdb.fortran/common-block.f90 b/gdb/testsuite/gdb.fortran/common-block.f90
new file mode 100644
index 0000000..1ccfd38
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/common-block.f90
@@ -0,0 +1,67 @@
+! Copyright 2008, 2012 Free Software Foundation, Inc.
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program; if not, write to the Free Software
+! Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+!
+! Ihis file is the Fortran source file for dynamic.exp.
+! Original file written by Jakub Jelinek <jakub@redhat.com>.
+! Modified for the GDB testcase by Jan Kratochvil <jan.kratochvil@redhat.com>.
+
+subroutine in
+
+ INTEGER*4 ix
+ REAL*4 iy2
+ REAL*8 iz
+
+ INTEGER*4 ix_x
+ REAL*4 iy_y
+ REAL*8 iz_z2
+
+ common /fo_o/ix,iy2,iz
+ common /foo/ix_x,iy_y,iz_z2
+
+ iy = 5
+ iz_z = 55
+
+ if (ix .ne. 11 .or. iy2 .ne. 22.0 .or. iz .ne. 33.0) call abort
+ if (ix_x .ne. 1 .or. iy_y .ne. 2.0 .or. iz_z2 .ne. 3.0) call abort
+
+ ix = 0 ! stop-here-in
+
+end subroutine in
+
+program common_test
+
+ INTEGER*4 ix
+ REAL*4 iy
+ REAL*8 iz
+
+ INTEGER*4 ix_x
+ REAL*4 iy_y
+ REAL*8 iz_z
+
+ common /foo/ix,iy,iz
+ common /fo_o/ix_x,iy_y,iz_z
+
+ ix = 1
+ iy = 2.0
+ iz = 3.0
+
+ ix_x = 11
+ iy_y = 22.0
+ iz_z = 33.0
+
+ call in ! stop-here-out
+
+end program common_test