trans-common.c (create_common): Add decl to function chain to preserve identifier scope in debug output.

	* fortran/trans-common.c (create_common):  Add decl to function
	chain to preserve identifier scope in debug output.

	* dbxout.c: Emit .stabs debug info for Fortran COMMON block
	variables as base symbol name + offset using N_BCOMM/N_ECOMM.
	(is_fortran, dbxout_common_name, dbxout_common_check): New functions.
	(dbxout_symbol_location): Transform N_LCSYM to N_GSYM for storage
	in common.
	(dbxout_syms): Check for COMMON-based symbol and wrap in
	N_BCOMM/N_ECOMM stab bracket, including as many symbols as possible
	in bracket for efficiency.

	* dwarf2out.c: Emit DWARF debug info for Fortran COMMON block
	using DW_TAG_common_block + member offset.
	(add_pubname_string): New function.
	(dw_expand_expr): New function to find block name and offset for
	COMMON var.
	(common_check): New function to check whether symbol in Fortran COMMON.
	(gen_variable_die): If COMMON, use DW_TAG_common_block.

	* testsuite/gcc.dg/debug/pr35154.c:  New test to check that non-Fortran
	use of common is unchanged.

	* testsuite/lib/gfortran-dg.exp:  New harness to compile Fortran progs
	with all combinations of debug options available on target.
	* testsuite/gfortran.dg/debug/debug.exp:  Ditto.
	* testsuite/gfortran.dg/debug/trivial.f:  Ditto.
	* testsuite/gfortran.dg/debug/pr35154-stabs.f:  New test case for
	.stabs functionality.
	* testsuite/gfortran.dg/debug/pr35154-dwarf2.f:  New test case for
	DWARF functionality.

From-SVN: r133801

12 files changed, 650 insertions, 18 deletions

diff --git a/gcc/ChangeLog b/gcc/ChangeLog
index 651dd2a..2ef5a6c 100644
--- a/gcc/ChangeLog
+++ b/gcc/ChangeLog
@@ -1,3 +1,38 @@
+2008-04-01  George Helffrich  <george@gcc.gnu.org>
+
+	PR fortran/PR35154, fortran/PR23057
+	* fortran/trans-common.c (create_common):  Add decl to function
+	chain to preserve identifier scope in debug output.
+
+	* dbxout.c: Emit .stabs debug info for Fortran COMMON block
+	variables as base symbol name + offset using N_BCOMM/N_ECOMM.
+	(is_fortran, dbxout_common_name, dbxout_common_check): New functions.
+	(dbxout_symbol_location): Transform N_LCSYM to N_GSYM for storage
+	in common.
+	(dbxout_syms): Check for COMMON-based symbol and wrap in
+	N_BCOMM/N_ECOMM stab bracket, including as many symbols as possible
+	in bracket for efficiency.
+
+	* dwarf2out.c: Emit DWARF debug info for Fortran COMMON block
+	using DW_TAG_common_block + member offset.
+	(add_pubname_string): New function.
+	(dw_expand_expr): New function to find block name and offset for
+	COMMON var.
+	(common_check): New function to check whether symbol in Fortran COMMON.
+	(gen_variable_die): If COMMON, use DW_TAG_common_block.
+
+	* testsuite/gcc.dg/debug/pr35154.c:  New test to check that non-Fortran
+	use of common is unchanged.
+
+	* testsuite/lib/gfortran-dg.exp:  New harness to compile Fortran progs
+	with all combinations of debug options available on target.
+	* testsuite/gfortran.dg/debug/debug.exp:  Ditto.
+	* testsuite/gfortran.dg/debug/trivial.f:  Ditto.
+	* testsuite/gfortran.dg/debug/pr35154-stabs.f:  New test case for
+	.stabs functionality.
+	* testsuite/gfortran.dg/debug/pr35154-dwarf2.f:  New test case for
+	DWARF functionality.
+
 2008-04-01  Volker Reichelt  <v.reichelt@netcologne.de>
 
 	PR c/35436
diff --git a/gcc/dbxout.c b/gcc/dbxout.c
index 8b11a9a..acf20b2 100644
--- a/gcc/dbxout.c
+++ b/gcc/dbxout.c
@@ -1,6 +1,6 @@
 /* Output dbx-format symbol table information from GNU compiler.
    Copyright (C) 1987, 1988, 1992, 1993, 1994, 1995, 1996, 1997, 1998,
-   1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
+   1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
    Free Software Foundation, Inc.
 
 This file is part of GCC.
@@ -322,10 +322,13 @@ static void dbxout_type_methods (tree);
 static void dbxout_range_type (tree);
 static void dbxout_type (tree, int);
 static bool print_int_cst_bounds_in_octal_p (tree);
+static bool is_fortran (void);
 static void dbxout_type_name (tree);
 static void dbxout_class_name_qualifiers (tree);
 static int dbxout_symbol_location (tree, tree, const char *, rtx);
 static void dbxout_symbol_name (tree, const char *, int);
+static void dbxout_common_name (tree, const char *, STAB_CODE_TYPE);
+static const char *dbxout_common_check (tree, int *);
 static void dbxout_global_decl (tree);
 static void dbxout_type_decl (tree, int);
 static void dbxout_handle_pch (unsigned);
@@ -973,6 +976,14 @@ get_lang_number (void)
 
 }
 
+static bool
+is_fortran (void)
+{
+   unsigned int lang = get_lang_number ();
+
+   return (lang == N_SO_FORTRAN) || (lang == N_SO_FORTRAN90);
+}
+
 /* At the beginning of compilation, start writing the symbol table.
    Initialize `typevec' and output the standard data types of C.  */
 
@@ -2868,8 +2879,15 @@ dbxout_symbol_location (tree decl, tree type, const char *suffix, rtx home)
     {
       if (TREE_PUBLIC (decl))
 	{
+	  int offs;
 	  letter = 'G';
 	  code = N_GSYM;
+	  if (NULL != dbxout_common_check (decl, &offs))
+	    {
+	      letter = 'V';
+	      addr = 0;
+	      number = offs;
+	    }
 	}
       else
 	{
@@ -2915,7 +2933,17 @@ dbxout_symbol_location (tree decl, tree type, const char *suffix, rtx home)
 	  if (DECL_INITIAL (decl) == 0
 	      || (!strcmp (lang_hooks.name, "GNU C++")
 		  && DECL_INITIAL (decl) == error_mark_node))
-	    code = N_LCSYM;
+	    {
+	      int offs;
+	      code = N_LCSYM;
+	      if (NULL != dbxout_common_check (decl, &offs))
+	        {
+		  addr = 0;
+		  number = offs;
+		  letter = 'V';
+		  code = N_GSYM;
+		}
+	    }
 	  else if (DECL_IN_TEXT_SECTION (decl))
 	    /* This is not quite right, but it's the closest
 	       of all the codes that Unix defines.  */
@@ -3004,9 +3032,17 @@ dbxout_symbol_location (tree decl, tree type, const char *suffix, rtx home)
 	 variable, thereby avoiding the need for a register.  In such
 	 cases we're forced to lie to debuggers and tell them that
 	 this variable was itself `static'.  */
+      int offs;
       code = N_LCSYM;
       letter = 'V';
-      addr = XEXP (XEXP (home, 0), 0);
+      if (NULL == dbxout_common_check (decl, &offs))
+        addr = XEXP (XEXP (home, 0), 0);
+      else
+        {
+	  addr = 0;
+	  number = offs;
+	  code = N_GSYM;
+	}
     }
   else if (GET_CODE (home) == CONCAT)
     {
@@ -3091,6 +3127,115 @@ dbxout_symbol_name (tree decl, const char *suffix, int letter)
     stabstr_C (letter);
 }
 
+
+/* Output the common block name for DECL in a stabs.
+
+   Symbols in global common (.comm) get wrapped with an N_BCOMM/N_ECOMM pair
+   around each group of symbols in the same .comm area.  The N_GSYM stabs
+   that are emitted only contain the offset in the common area.  This routine
+   emits the N_BCOMM and N_ECOMM stabs.  */
+
+static void
+dbxout_common_name (tree decl, const char *name, STAB_CODE_TYPE op)
+{
+  dbxout_begin_complex_stabs ();
+  stabstr_S (name);
+  dbxout_finish_complex_stabs (decl, op, NULL_RTX, NULL, 0);
+}
+
+/* Check decl to determine whether it is a VAR_DECL destined for storage in a
+   common area.  If it is, the return value will be a non-null string giving
+   the name of the common storage block it will go into.  If non-null, the
+   value is the offset into the common block for that symbol's storage.  */
+
+static const char *
+dbxout_common_check (tree decl, int *value)
+{
+  rtx home;
+  rtx sym_addr;
+  const char *name = NULL;
+  
+  /* If the decl isn't a VAR_DECL, or if it isn't public or static, or if
+     it does not have a value (the offset into the common area), or if it
+     is thread local (as opposed to global) then it isn't common, and shouldn't
+     be handled as such.
+     
+     ??? DECL_THREAD_LOCAL_P check prevents problems with improper .stabs
+     for thread-local symbols.  Can be handled via same mechanism as used
+     in dwarf2out.c.  */
+  if (TREE_CODE (decl) != VAR_DECL
+      || !TREE_PUBLIC(decl)
+      || !TREE_STATIC(decl)
+      || !DECL_HAS_VALUE_EXPR_P(decl)
+      || DECL_THREAD_LOCAL_P (decl)
+      || !is_fortran ())
+    return NULL;
+
+  home = DECL_RTL (decl); 
+  if (home == NULL_RTX || GET_CODE (home) != MEM)
+    return NULL;
+
+  sym_addr = dbxout_expand_expr (DECL_VALUE_EXPR (decl));
+  if (sym_addr == NULL_RTX || GET_CODE (sym_addr) != MEM)
+    return NULL;
+
+  sym_addr = XEXP (sym_addr, 0);
+  if (GET_CODE (sym_addr) == CONST)
+    sym_addr = XEXP (sym_addr, 0);
+  if ((GET_CODE (sym_addr) == SYMBOL_REF || GET_CODE (sym_addr) == PLUS)
+      && DECL_INITIAL (decl) == 0)
+    {
+
+      /* We have a sym that will go into a common area, meaning that it
+         will get storage reserved with a .comm/.lcomm assembler pseudo-op.
+
+         Determine name of common area this symbol will be an offset into,
+         and offset into that area.  Also retrieve the decl for the area
+         that the symbol is offset into.  */
+      tree cdecl = NULL;
+
+      switch (GET_CODE (sym_addr))
+        {
+        case PLUS:
+          if (GET_CODE (XEXP (sym_addr, 0)) == CONST_INT)
+            {
+              name =
+                targetm.strip_name_encoding(XSTR (XEXP (sym_addr, 1), 0));
+              *value = INTVAL (XEXP (sym_addr, 0));
+              cdecl = SYMBOL_REF_DECL (XEXP (sym_addr, 1));
+            }
+          else
+            {
+              name =
+                targetm.strip_name_encoding(XSTR (XEXP (sym_addr, 0), 0));
+              *value = INTVAL (XEXP (sym_addr, 1));
+              cdecl = SYMBOL_REF_DECL (XEXP (sym_addr, 0));
+            }
+          break;
+
+        case SYMBOL_REF:
+          name = targetm.strip_name_encoding(XSTR (sym_addr, 0));
+          *value = 0;
+          cdecl = SYMBOL_REF_DECL (sym_addr);
+          break;
+
+        default:
+          error ("common symbol debug info is not structured as "
+                 "symbol+offset");
+        }
+
+      /* Check area common symbol is offset into.  If this is not public, then
+         it is not a symbol in a common block.  It must be a .lcomm symbol, not
+         a .comm symbol.  */
+      if (cdecl == NULL || !TREE_PUBLIC(cdecl))
+        name = NULL;
+    }
+  else
+    name = NULL;
+
+  return name;
+}
+
 /* Output definitions of all the decls in a chain. Return nonzero if
    anything was output */
 
@@ -3098,11 +3243,38 @@ int
 dbxout_syms (tree syms)
 {
   int result = 0;
+  const char *comm_prev = NULL;
+  tree syms_prev = NULL;
+
   while (syms)
     {
+      int temp, copen, cclos;
+      const char *comm_new;
+
+      /* Check for common symbol, and then progression into a new/different
+         block of common symbols.  Emit closing/opening common bracket if
+         necessary.  */
+      comm_new = dbxout_common_check (syms, &temp);
+      copen = comm_new != NULL
+              && (comm_prev == NULL || strcmp (comm_new, comm_prev));
+      cclos = comm_prev != NULL
+              && (comm_new == NULL || strcmp (comm_new, comm_prev));
+      if (cclos)
+        dbxout_common_name (syms_prev, comm_prev, N_ECOMM);
+      if (copen)
+        {
+          dbxout_common_name (syms, comm_new, N_BCOMM);
+          syms_prev = syms;
+        }
+      comm_prev = comm_new;
+
       result += dbxout_symbol (syms, 1);
       syms = TREE_CHAIN (syms);
     }
+
+  if (comm_prev != NULL)
+    dbxout_common_name (syms_prev, comm_prev, N_ECOMM);
+
   return result;
 }
 
diff --git a/gcc/dwarf2out.c b/gcc/dwarf2out.c
index 410682b..1d99699 100644
--- a/gcc/dwarf2out.c
+++ b/gcc/dwarf2out.c
@@ -4251,6 +4251,7 @@ static void output_compilation_unit_header (void);
 static void output_comp_unit (dw_die_ref, int);
 static const char *dwarf2_name (tree, int);
 static void add_pubname (tree, dw_die_ref);
+static void add_pubname_string (const char *, dw_die_ref);
 static void add_pubtype (tree, dw_die_ref);
 static void output_pubnames (VEC (pubname_entry,gc) *);
 static void add_arange (tree, dw_die_ref);
@@ -7481,18 +7482,23 @@ dwarf2_name (tree decl, int scope)
 /* Add a new entry to .debug_pubnames if appropriate.  */
 
 static void
-add_pubname (tree decl, dw_die_ref die)
+add_pubname_string (const char *str, dw_die_ref die)
 {
   pubname_entry e;
 
-  if (! TREE_PUBLIC (decl))
-    return;
-
   e.die = die;
-  e.name = xstrdup (dwarf2_name (decl, 1));
+  e.name = xstrdup (str);
   VEC_safe_push (pubname_entry, gc, pubname_table, &e);
 }
 
+static void
+add_pubname (tree decl, dw_die_ref die)
+{
+
+  if (TREE_PUBLIC (decl))
+    add_pubname_string (dwarf2_name (decl, 1), die);
+}
+
 /* Add a new entry to .debug_pubtypes if appropriate.  */
 
 static void
@@ -10504,6 +10510,63 @@ rtl_for_decl_init (tree init, tree type)
   return rtl;
 }
 
+/* This is a specialized subset of expand_expr to evaluate a DECL_VALUE_EXPR.
+   We stop if we find decls that haven't been expanded, or if the expression is
+   getting so complex we won't be able to represent it anyway.  Returns NULL on
+   failure.  */
+
+static rtx
+dw_expand_expr (tree expr)
+{
+  switch (TREE_CODE (expr))
+  {
+  case VAR_DECL:
+  case PARM_DECL:
+    if (DECL_HAS_VALUE_EXPR_P (expr))
+      return dw_expand_expr (DECL_VALUE_EXPR (expr));
+    /* FALLTHRU */
+ 
+  case CONST_DECL:
+  case RESULT_DECL:
+    return DECL_RTL_IF_SET (expr);
+ 
+  case INTEGER_CST:
+    return expand_expr (expr, NULL_RTX, VOIDmode, EXPAND_INITIALIZER);
+
+  case COMPONENT_REF:
+  case ARRAY_REF:
+  case ARRAY_RANGE_REF:
+  case BIT_FIELD_REF:
+  {
+    enum machine_mode mode;
+    HOST_WIDE_INT bitsize, bitpos;
+    tree offset, tem;
+    int volatilep = 0, unsignedp = 0;
+    rtx x;
+
+    tem = get_inner_reference (expr, &bitsize, &bitpos, &offset,
+                               &mode, &unsignedp, &volatilep, true);
+ 
+    x = dw_expand_expr (tem);
+    if (x == NULL || !MEM_P (x))
+       return NULL;
+    if (offset != NULL)
+      {
+        if (!host_integerp (offset, 0))
+          return NULL;
+        x = adjust_address_nv (x, mode, tree_low_cst (offset, 0));
+      }
+    if (bitpos != 0)
+      x = adjust_address_nv (x, mode, bitpos / BITS_PER_UNIT);
+
+    return x;
+  }
+ 
+  default:
+    return NULL;
+  }
+}
+
 /* Generate RTL for the variable DECL to represent its location.  */
 
 static rtx
@@ -10736,6 +10799,93 @@ secname_for_decl (const_tree decl)
   return secname;
 }
 
+/* Check whether decl is a Fortran COMMON symbol.  If not, NULL_RTX is returned.
+   If so, the rtx for the SYMBOL_REF for the COMMON block is returned, and the
+   value is the offset into the common block for the symbol.  */
+
+static rtx
+common_check (tree decl, HOST_WIDE_INT *value)
+{
+  rtx home;
+  rtx sym_addr;
+  rtx res = NULL_RTX;
+ 
+  /* If the decl isn't a VAR_DECL, or if it isn't public or static, or if
+     it does not have a value (the offset into the common area), or if it
+     is thread local (as opposed to global) then it isn't common, and shouldn't
+     be handled as such.  */
+  if (TREE_CODE (decl) != VAR_DECL
+      || !TREE_PUBLIC(decl)
+      || !TREE_STATIC(decl)
+      || !DECL_HAS_VALUE_EXPR_P(decl)
+      || DECL_THREAD_LOCAL_P (decl)
+      || !is_fortran())
+    return NULL;
+
+  home = DECL_RTL (decl);
+  if (home == NULL_RTX || GET_CODE (home) != MEM)
+    return NULL;
+
+  sym_addr = dw_expand_expr (DECL_VALUE_EXPR (decl));
+  if (sym_addr == NULL_RTX || GET_CODE (sym_addr) != MEM)
+    return NULL;
+
+  sym_addr = XEXP (sym_addr, 0);
+  if (GET_CODE (sym_addr) == CONST)
+    sym_addr = XEXP (sym_addr, 0);
+  if ((GET_CODE (sym_addr) == SYMBOL_REF || GET_CODE (sym_addr) == PLUS)
+      && DECL_INITIAL (decl) == 0)
+    {
+ 
+      /* We have a sym that will go into a common area, meaning that it
+         will get storage reserved with a .comm/.lcomm assembler pseudo-op.
+
+         Determine name of common area this symbol will be an offset into,
+         and offset into that area.  Also retrieve the decl for the area
+         that the symbol is offset into.  */
+      tree cdecl = NULL;
+
+      switch (GET_CODE (sym_addr))
+        {
+        case PLUS:
+          if (GET_CODE (XEXP (sym_addr, 0)) == CONST_INT)
+            {
+              res = XEXP (sym_addr, 1);
+              *value = INTVAL (XEXP (sym_addr, 0));
+              cdecl = SYMBOL_REF_DECL (XEXP (sym_addr, 1));
+            }
+          else
+            {
+              res = XEXP (sym_addr, 0);
+              *value = INTVAL (XEXP (sym_addr, 1));
+              cdecl = SYMBOL_REF_DECL (XEXP (sym_addr, 0));
+             }
+          break;
+
+        case SYMBOL_REF:
+          res = sym_addr;
+          *value = 0;
+          cdecl = SYMBOL_REF_DECL (sym_addr);
+          break;
+
+        default:
+          error ("common symbol debug info is not structured as "
+                 "symbol+offset");
+        }
+
+      /* Check area common symbol is offset into.  If this is not public, then
+         it is not a symbol in a common block.  It must be a .lcomm symbol, not
+         a .comm symbol.  */
+      if (cdecl == NULL || !TREE_PUBLIC(cdecl))
+        res = NULL_RTX;
+    }
+  else
+    res = NULL_RTX;
+
+  return res;
+}
+
+
 /* Generate *either* a DW_AT_location attribute or else a DW_AT_const_value
    data attribute for a variable or a parameter.  We generate the
    DW_AT_const_value attribute only in those cases where the given variable
@@ -12633,9 +12783,10 @@ gen_subprogram_die (tree decl, dw_die_ref context_die)
 static void
 gen_variable_die (tree decl, dw_die_ref context_die)
 {
+  HOST_WIDE_INT off;
+  rtx csym;
+  dw_die_ref var_die;
   tree origin = decl_ultimate_origin (decl);
-  dw_die_ref var_die = new_die (DW_TAG_variable, context_die, decl);
-
   dw_die_ref old_die = lookup_decl_die (decl);
   int declaration = (DECL_EXTERNAL (decl)
 		     /* If DECL is COMDAT and has not actually been
@@ -12659,6 +12810,37 @@ gen_variable_die (tree decl, dw_die_ref context_die)
 			 && DECL_COMDAT (decl) && !TREE_ASM_WRITTEN (decl))
 		     || class_or_namespace_scope_p (context_die));
 
+  csym = common_check (decl, &off);
+
+  /* Symbol in common gets emitted as a child of the common block, in the form
+     of a data member.
+
+     ??? This creates a new common block die for every common block symbol.
+     Better to share same common block die for all symbols in that block.  */
+  if (csym)
+    {
+      tree blok;
+      dw_die_ref com_die;
+      const char *cnam = targetm.strip_name_encoding(XSTR (csym, 0));
+      dw_loc_descr_ref loc = mem_loc_descriptor (csym, dw_val_class_addr,
+                                                 VAR_INIT_STATUS_INITIALIZED);
+
+      blok = (tree) TREE_OPERAND (DECL_VALUE_EXPR (decl), 0);
+      var_die = new_die (DW_TAG_common_block, context_die, decl);
+      add_name_and_src_coords_attributes (var_die, blok);
+      add_AT_flag (var_die, DW_AT_external, 1);
+      add_AT_loc (var_die, DW_AT_location, loc);
+      com_die = new_die (DW_TAG_member, var_die, decl);
+      add_name_and_src_coords_attributes (com_die, decl);
+      add_type_attribute (com_die, TREE_TYPE (decl), TREE_READONLY (decl),
+      TREE_THIS_VOLATILE (decl), context_die);
+      add_AT_loc (com_die, DW_AT_data_member_location, int_loc_descriptor(off));
+      add_pubname_string (cnam, var_die); /* ??? needed? */
+      return;
+    }
+
+  var_die = new_die (DW_TAG_variable, context_die, decl);
+
   if (origin != NULL)
     add_abstract_origin_attribute (var_die, origin);
 
@@ -13634,8 +13816,13 @@ decls_for_scope (tree stmt, dw_die_ref context_die, int depth)
 	    add_child_die (context_die, die);
 	  /* Do not produce debug information for static variables since
 	     these might be optimized out.  We are called for these later
-	     in varpool_analyze_pending_decls. */
-	  if (TREE_CODE (decl) == VAR_DECL && TREE_STATIC (decl))
+	     in varpool_analyze_pending_decls.
+
+	     But *do* produce it for Fortran COMMON variables because,
+	     even though they are static, their names can differ depending
+	     on the scope, which we need to preserve.  */
+	  if (TREE_CODE (decl) == VAR_DECL && TREE_STATIC (decl)
+	      && !(is_fortran () && TREE_PUBLIC (decl)))
 	    ;
 	  else
 	    gen_decl_die (decl, context_die);
@@ -13963,6 +14150,16 @@ gen_decl_die (tree decl, dw_die_ref context_die)
       if (debug_info_level <= DINFO_LEVEL_TERSE)
 	break;
 
+      /* If this is the global definition of the Fortran COMMON block, we don't
+         need to do anything.  Syntactically, the block itself has no identity,
+         just its constituent identifiers.  */
+      if (TREE_CODE (decl) == VAR_DECL
+          && TREE_PUBLIC (decl)
+          && TREE_STATIC (decl)
+          && is_fortran ()
+          && !DECL_HAS_VALUE_EXPR_P (decl))
+        break;
+
       /* Output any DIEs that are needed to specify the type of this data
 	 object.  */
       if (TREE_CODE (decl) == RESULT_DECL && DECL_BY_REFERENCE (decl))
@@ -14029,7 +14226,15 @@ dwarf2out_global_decl (tree decl)
   /* Output DWARF2 information for file-scope tentative data object
      declarations, file-scope (extern) function declarations (which had no
      corresponding body) and file-scope tagged type declarations and
-     definitions which have not yet been forced out.  */
+     definitions which have not yet been forced out.
+
+     Ignore the global decl of any Fortran COMMON blocks which also wind up here
+     though they have already been described in the local scope for the 
+     procedures using them.  */
+  if (TREE_CODE (decl) == VAR_DECL
+      && TREE_PUBLIC (decl) && TREE_STATIC (decl) && is_fortran ())
+    return;
+
   if (TREE_CODE (decl) != FUNCTION_DECL || !DECL_INITIAL (decl))
     dwarf2out_decl (decl);
 }
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index cd69cba..9fb19c4 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2008-04-01  George Helffrich <george@gcc.gnu.org>
+
+	* trans-common.c (create_common):  Add decl to function
+	chain to preserve identifier scope in debug output.
+
 2008-04-01  Joseph Myers  <joseph@codesourcery.com>
 
 	* gfortran.texi: Include gpl_v3.texi instead of gpl.texi
diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c
index 7086a6c..f7042cb 100644
--- a/gcc/fortran/trans-common.c
+++ b/gcc/fortran/trans-common.c
@@ -687,10 +687,7 @@ create_common (gfc_common_head *com, segment_info *head, bool saw_equiv)
       /* This is a fake variable just for debugging purposes.  */
       TREE_ASM_WRITTEN (var_decl) = 1;
 
-      if (com)
-	var_decl = pushdecl_top_level (var_decl);
-      else
-	gfc_add_decl_to_function (var_decl);
+      gfc_add_decl_to_function (var_decl);
 
       SET_DECL_VALUE_EXPR (var_decl,
 			   fold_build3 (COMPONENT_REF, TREE_TYPE (s->field),
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 5808d5c..476e05c 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,18 @@
+2008-04-01  George Helffrich  <george@gcc.gnu.org>
+
+	PRs fortran/PR35154, fortran/PR23057
+	* gcc.dg/debug/pr35154.c:  New test to check that non-Fortran
+	use of common is unchanged.
+
+	* lib/gfortran-dg.exp:  New harness to compile Fortran progs
+	with all combinations of debug options available on target.
+        * gfortran.dg/debug/debug.exp:  Ditto.
+        * gfortran.dg/debug/trivial.f:  Ditto.
+        * gfortran.dg/debug/pr35154-stabs.f:  New test case for
+        .stabs functionality.
+        * gfortran.dg/debug/pr35154-dwarf2.f:  New test case for
+        DWARF functionality.
+
 2008-04-01  Volker Reichelt  <v.reichelt@netcologne.de>
 
 	PR c/35436
diff --git a/gcc/testsuite/gcc.dg/debug/pr35154.c b/gcc/testsuite/gcc.dg/debug/pr35154.c
new file mode 100644
index 0000000..fcb7925
--- /dev/null
+++ b/gcc/testsuite/gcc.dg/debug/pr35154.c
@@ -0,0 +1,34 @@
+/* Test to make sure that stabs for C symbols that go into .comm have the
+   proper structure.  These should be lettered G for the struct that gives
+   the name to the .comm, and should be V or S for .lcomm symbols.  */
+
+static char i_outer;
+struct {
+   char f1;
+   char f2;
+} opta;
+struct {
+   char f1;
+   char f2;
+} optb;
+
+int
+main()
+{
+   static char i_inner[2];
+   i_inner[0] = 'a'; i_inner[1] = 'b';
+   opta.f1 = 'c';
+   opta.f2 = 'd';
+   optb.f1 = 'C';
+   optb.f2 = 'D';
+   i_outer = 'e';
+/* { dg-do compile } */
+/* { dg-skip-if "No stabs" { mmix-*-* *-*-netware* alpha*-*-* hppa*64*-*-* ia64-*-* *-*-sysv5* *-*-vxworks* } { "*" } { "" } } */
+/* { dg-skip-if "stabs only" { *-*-* } { "*" } { "-gstabs" } } */
+   return 0;
+}
+
+/* { dg-final { scan-assembler ".stabs.*i_inner:V" } } */
+/* { dg-final { scan-assembler ".stabs.*i_outer:S" } } */
+/* { dg-final { scan-assembler ".stabs.*opta:G" } } */
+/* { dg-final { scan-assembler ".stabs.*optb:G" } } */
diff --git a/gcc/testsuite/gfortran.dg/debug/debug.exp b/gcc/testsuite/gfortran.dg/debug/debug.exp
new file mode 100644
index 0000000..0e0b4b9
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/debug/debug.exp
@@ -0,0 +1,41 @@
+#  Copyright (C) 2008 Free Software Foundation, Inc.
+
+#  This file is part of GCC.
+#
+#  GCC 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, or (at your option) any later
+#  version.
+#
+#  GCC 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 GCC; see the file COPYING3.  If not see
+#  <http://www.gnu.org/licenses/>.
+
+# GCC testsuite that uses the `dg.exp' driver.
+
+# Load support procs.
+load_lib gfortran-dg.exp
+load_lib gfortran.exp
+
+# Debugging testsuite proc
+proc gfortran-debug-dg-test { prog do_what extra_tool_flags } {
+   return [gfortran-dg-test $prog $do_what $extra_tool_flags]
+}
+
+# Initialize `dg'.
+dg-init
+
+# Main loop.
+
+gfortran_init
+
+gfortran-dg-debug-runtest gfortran_target_compile trivial.f "" \
+    [lsort [glob -nocomplain $srcdir/$subdir/*.\[fS\]]]
+
+# All done.
+dg-finish
diff --git a/gcc/testsuite/gfortran.dg/debug/pr35154-dwarf2.f b/gcc/testsuite/gfortran.dg/debug/pr35154-dwarf2.f
new file mode 100644
index 0000000..0203d13
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/debug/pr35154-dwarf2.f
@@ -0,0 +1,37 @@
+C     Test program for common block debugging.  G. Helffrich 11 July 2004.
+C { dg-do compile }
+C { dg-skip-if "DWARF-2 only" { "*-*-*" } { "*" } { "-gdwarf-2" } }
+C { dg-options "-dA" }
+      common i,j
+      common /label/l,m
+      i = 1
+      j = 2
+      k = 3
+      l = 4
+      m = 5
+      call sub
+      end
+      subroutine sub
+      common /label/l,m
+      logical first
+      save n
+      data first /.true./
+      if (first) then
+         n = 0
+	 first = .false.
+      endif
+      n = n + 1
+      l = l + 1
+      return
+      end
+
+C { dg-final { scan-assembler "(DIE.*DW_TAG_common_block)" } }
+C { dg-final { scan-assembler "DW_AT_name: \"__BLNK__\"" } }
+C { dg-final { scan-assembler "(DIE.*DW_TAG_member)" } }
+C { dg-final { scan-assembler "\"i.*\".*DW_AT_name" } }
+C { dg-final { scan-assembler "\"j.*\".*DW_AT_name" } }
+C { dg-final { scan-assembler "(DIE.*DW_TAG_common_block)" } }
+C { dg-final { scan-assembler "DW_AT_name: \"label\"" } }
+C { dg-final { scan-assembler "(DIE.*DW_TAG_member)" } }
+C { dg-final { scan-assembler "\"l.*\".*DW_AT_name" } }
+C { dg-final { scan-assembler "\"m.*\".*DW_AT_name" } }
diff --git a/gcc/testsuite/gfortran.dg/debug/pr35154-stabs.f b/gcc/testsuite/gfortran.dg/debug/pr35154-stabs.f
new file mode 100644
index 0000000..7294771
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/debug/pr35154-stabs.f
@@ -0,0 +1,35 @@
+C     Test program for common block debugging.  G. Helffrich 11 July 2004.
+C { dg-do compile }
+C { dg-skip-if "No stabs" { mmix-*-* *-*-netware* alpha*-*-* hppa*64*-*-* ia64-*-* *-*-sysv5* *-*-vxworks* } { "*" } { "" } }
+C { dg-skip-if "No stabs" {*-*-* } { "*" } { "-gstabs" } }
+      common i,j
+      common /label/l,m
+      i = 1
+      j = 2
+      k = 3
+      l = 4
+      m = 5
+      call sub
+      end
+      subroutine sub
+      common /label/l,m
+      logical first
+      save n
+      data first /.true./
+      if (first) then
+         n = 0
+	 first = .false.
+      endif
+      n = n + 1
+      l = l + 1
+      return
+      end
+
+C { dg-final { scan-assembler ".stabs.*\"__BLNK__\",226" } }
+C { dg-final { scan-assembler ".stabs.*\"i:V.*\",.*,0" } }
+C { dg-final { scan-assembler ".stabs.*\"j:V.*\",.*,4" } }
+C { dg-final { scan-assembler ".stabs.*\"__BLNK__\",228" } }
+C { dg-final { scan-assembler ".stabs.*\"label_\",226" } }
+C { dg-final { scan-assembler ".stabs.*\"l:V.*\",.*,0" } }
+C { dg-final { scan-assembler ".stabs.*\"m:V.*\",.*,4" } }
+C { dg-final { scan-assembler ".stabs.*\"label_\",228" } }
diff --git a/gcc/testsuite/gfortran.dg/debug/trivial.f b/gcc/testsuite/gfortran.dg/debug/trivial.f
new file mode 100644
index 0000000..4c35567
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/debug/trivial.f
@@ -0,0 +1,2 @@
+      program trivial
+      end
diff --git a/gcc/testsuite/lib/gfortran-dg.exp b/gcc/testsuite/lib/gfortran-dg.exp
index 0b7256f..401651c 100644
--- a/gcc/testsuite/lib/gfortran-dg.exp
+++ b/gcc/testsuite/lib/gfortran-dg.exp
@@ -1,4 +1,4 @@
-#   Copyright (C) 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+#   Copyright (C) 2004, 2005, 2006, 2007, 2008 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
@@ -107,3 +107,57 @@ proc gfortran-dg-runtest { testcases default-extra-flags } {
 	}
     }
 }
+
+proc gfortran-dg-debug-runtest { target_compile trivial opt_opts testcases } {
+    global srcdir subdir DEBUG_TORTURE_OPTIONS
+
+    if ![info exists DEBUG_TORTURE_OPTIONS] {
+       set DEBUG_TORTURE_OPTIONS ""
+       set type_list [list "-gstabs" "-gstabs+" "-gxcoff" "-gxcoff+" "-gcoff" "-gdwarf-2" ]
+       foreach type $type_list {
+           set comp_output [$target_compile \
+                   "$srcdir/$subdir/$trivial" "trivial.S" assembly \
+                   "additional_flags=$type"]
+           if { [string match "exit status *" $comp_output] } {
+               continue
+           }
+           if { [string match \
+                       "* target system does not support the * debug format*" \
+                       $comp_output]
+           } {
+               continue
+           }
+           foreach level {1 "" 3} {
+               lappend DEBUG_TORTURE_OPTIONS [list "${type}${level}"]
+               foreach opt $opt_opts {
+                   lappend DEBUG_TORTURE_OPTIONS [list "${type}${level}" \
+                      "$opt" ]
+               }
+           }
+       }
+    }
+
+    verbose -log "Using options $DEBUG_TORTURE_OPTIONS"
+
+    global runtests
+
+    foreach test $testcases {
+       # If we're only testing specific files and this isn't one of 
+       # them, skip it.
+       if ![runtest_file_p $runtests $test] {
+           continue
+       }
+
+       set nshort [file tail [file dirname $test]]/[file tail $test]
+
+       foreach flags $DEBUG_TORTURE_OPTIONS {
+           set doit 1
+           # gcc-specific checking removed here
+
+           if { $doit } {
+               verbose -log "Testing $nshort, $flags" 1
+               dg-test $test $flags ""
+           }
+       }
+    }
+}