2012-09-26 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 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/testsuite
2012-09-26  Jan Kratochvil  <jan.kratochvil@redhat.com>
	* gdb.fortran/common-block.exp: New file.
	* gdb.fortran/common-block.f90: New file.

10 files changed, 328 insertions, 176 deletions

diff --git a/gdb/ChangeLog b/gdb/ChangeLog
index 300447f..792df94 100644
--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,6 +1,28 @@
 2012-09-26  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 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.
+
+2012-09-26  Jan Kratochvil  <jan.kratochvil@redhat.com>
+	    Tom Tromey  <tromey@redhat.com>
+
 	* f-lang.c (allocate_saved_bf_node,
 	allocate_saved_function_node, allocate_saved_f77_common_node,
 	allocate_common_entry_node, tail_common_list, current_common,
diff --git a/gdb/dwarf2read.c b/gdb/dwarf2read.c
index 758bd3b..87285e3 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"
@@ -11063,50 +11064,47 @@ 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 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;
+      size_t n_entries = 0, size;
+      struct common_block *common_block;
+      struct symbol *sym;
 
+      for (child_die = die->child;
+	   child_die && child_die->tag;
+	   child_die = sibling_die (child_die))
+	++n_entries;
+
+      size = (sizeof (struct 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 = 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[common_block->n_entries++] = sym;
 	}
+
+      sym = new_symbol (die, objfile_type (objfile)->builtin_void, cu);
+      SYMBOL_VALUE_COMMON_BLOCK (sym) = common_block;
     }
 }
 
@@ -14956,6 +14954,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)
@@ -15120,6 +15125,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 94001e8..0d3a0c1 100644
--- a/gdb/f-lang.h
+++ b/gdb/f-lang.h
@@ -48,33 +48,17 @@ 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 common_block
+{
+  /* The number of entries in the block.  */
+  size_t 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.  All
+     pointers in the array are non-NULL.  */
+  struct symbol *contents[1];
+};
 
 #define BLANK_COMMON_NAME_LOCAL    "__BLANK"	/* Local GDB */
 
diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c
index 4f165ce..c3d2383 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,57 @@ 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 common_block *common = SYMBOL_VALUE_COMMON_BLOCK (sym);
+	size_t 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;
+
+	    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 +472,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 +486,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 2c03f42..b01c8f0 100644
--- a/gdb/stack.c
+++ b/gdb/stack.c
@@ -1848,6 +1848,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 041d8cf..b74fbe4 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 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 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
@@ -406,7 +412,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/ChangeLog b/gdb/testsuite/ChangeLog
index 706b9cc..0fbd11b 100644
--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2012-09-26  Jan Kratochvil  <jan.kratochvil@redhat.com>
+
+	* gdb.fortran/common-block.exp: New file.
+	* gdb.fortran/common-block.f90: New file.
+
 2012-09-26  Andrew Burgess  <aburgess@broadcom.com>
 
 	* gdb.base/duplicate-bp.c: New file.
diff --git a/gdb/testsuite/gdb.fortran/common-block.exp b/gdb/testsuite/gdb.fortran/common-block.exp
new file mode 100644
index 0000000..61a98d4
--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/common-block.exp
@@ -0,0 +1,98 @@
+# 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>.
+
+if {[skip_fortran_tests]} {
+    return 0
+}
+
+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