Re: [PATCH,fortran]: Emit COMMON identifiers in proper debug scope

Re: [PATCH,fortran]: Emit COMMON identifiers in proper debug scope

[Jason Merrill]

It looks like this patch can generate DW_TAG_common_block for languages 
other than FORTRAN, which seems undesirable.  Specifically, it seems 
that any use of DECL_VALUE_EXPR could trigger this code, such as 
anonymous unions in C++.  I notice that you even have C++-specific code 
in common_check.

Jason

Re: [PATCH,fortran]: Emit COMMON identifiers in proper debug scope

[George Helffrich]

On 20 Mar 2008, at 17:15, Jason Merrill wrote:

> It looks like this patch can generate DW_TAG_common_block for 
> languages other than FORTRAN, which seems undesirable.  Specifically, 
> it seems that any use of DECL_VALUE_EXPR could trigger this code, such 
> as anonymous unions in C++.  I notice that you even have C++-specific 
> code in common_check.
>
> Jason
>
>

Thanks for spotting that; easily guarded against with an !if_fortran() 
test at the start of common_check.  With that, the C++-specific code 
can be eliminated, too.

--
George Helffrich

Re: [PATCH,fortran]: Emit COMMON identifiers in proper debug scope

[Jim Wilson]

George Helffrich wrote:
> Modified from earlier submission based on comments received; sorry for 
> any repetition.

You added is_fortran() calls in response to Jason's review.  However, 
you added it to the dwarf2out.c patch but not the dbxout.c patch.  I 
would rather that they be consistent and that both made the is_fortran() 
call.  Also, I see that in the dbxout.c patch the DECL_THEAD_LOCAL_P 
check was mysteriously commented out.  It is still there in uncommented 
form in the dwarf2out.c patch.  Maybe a temporary change that you didn't 
mean to include in the patch?

Otherwise this all looks good.  If you fix dbxout.c to be consistent 
with dwarf2out.c I'm OK with it, and won't insist on another review.  Or 
maybe make that change as a follow up patch, and check in this patch as 
is (without the DECL_THREAD_LOCAL_P change), which would be OK too.  I 
don't want to cause too much trouble for a patch that was already 
approved 4 years ago.

Jason might want to make his own comments, which probably won't happen 
until Monday.

Jim

Re: [PATCH,fortran]: Emit COMMON identifiers in proper debug scope

[George Helffrich]

[-- Attachment #1: Type: text/plain, Size: 1604 bytes --]

Fixes fortran/PR35154, fortran/PR23057.

Modified from earlier submission based on comments received; sorry for 
any repetition.

It consists of three parts, two already approved, one new.  They are
grouped at FX Coudert's request; see

http://gcc.gnu.org/ml/gcc-patches/2008-02/msg01011.html

Component parts are:

1) to fortran/trans-common.c to emit .stabs debug information in the
proper scope for COMMON block variables by linking them to the function
scope rather than the global scope.  This is approved; see above link.

2) to dbxout.c and the testsuite to change how .stabs debug information
is emitted for COMMON block variables.  This was submitted and approved
in Aug. 2004 but never committed.  History is here:
(Approval):  http://gcc.gnu.org/ml/gcc-patches/2004-08/msg02475.html
(Submission): http://gcc.gnu.org/ml/gcc-patches/2004-06/msg02096.html
Now modified based on comments received.

3) to dwarf2out.c and the testsuite to change the way DWARF-2 debug 
information
is emitted for COMMON block variables in an analogous way as .stabs, 
using
DW_TAG_common_block.  This is new.  Now modified based on comments 
received.

New testsuite component updated to GCC3 license.

Bootstraps gcc, g++, objc and gfortran on powerpc-apple-darwin8.8.0,
i386-apple-darwin8.10.1, sparc64-unknown-freebsd6.0.  There are no 
testsuite
regressions against this patch for gfortran, gcc, objc or g++.  Verified
gdb functionality on i386-apple-darwin8.10.1 (-gstabs),
powerpc-apple-darwin8.8.0 (-gstabs) and sparc64-unknown-freebsd6.0 
(-gstabs and
-gdwarf-2).

OK to commit to trunk?

George Helffrich


[-- Attachment #2: gfortran.patch --]
[-- Type: application/octet-stream, Size: 25921 bytes --]

Index: gcc/fortran/trans-common.c
===================================================================
--- gcc/fortran/trans-common.c	(revision 132242)
+++ gcc/fortran/trans-common.c	(working copy)
@@ -687,10 +687,7 @@
       /* 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,
 			   build3 (COMPONENT_REF, TREE_TYPE (s->field),
Index: gcc/dbxout.c
===================================================================
--- gcc/dbxout.c	(revision 132242)
+++ gcc/dbxout.c	(working copy)
@@ -326,6 +326,8 @@
 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);
@@ -2859,8 +2861,15 @@
     {
       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
 	{
@@ -2906,7 +2915,17 @@
 	  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.  */
@@ -2995,9 +3014,17 @@
 	 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)
     {
@@ -3082,6 +3109,112 @@
     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.  */
+  if (TREE_CODE (decl) != VAR_DECL
+      || !TREE_PUBLIC(decl)
+      || !TREE_STATIC(decl)
+      || !DECL_HAS_VALUE_EXPR_P(decl))
+/*    || DECL_THREAD_LOCAL_P (decl)) */
+    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
+          || (!strcmp (lang_hooks.name, "GNU C++")
+          && DECL_INITIAL (decl) == error_mark_node)))
+    {
+
+      /* 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 */
 
@@ -3089,11 +3222,38 @@
 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;
 }
 \f
Index: gcc/dwarf2out.c
===================================================================
--- gcc/dwarf2out.c	(revision 132242)
+++ gcc/dwarf2out.c	(working copy)
@@ -4226,6 +4226,7 @@
 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);
@@ -7456,18 +7457,23 @@
 /* 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
@@ -10479,6 +10485,63 @@
   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
@@ -10711,6 +10774,93 @@
   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
@@ -12608,9 +12758,10 @@
 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
@@ -12634,6 +12785,37 @@
 			 && 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);
 
@@ -13609,8 +13791,13 @@
 	    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);
@@ -13938,6 +14125,16 @@
       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))
@@ -14004,7 +14201,15 @@
   /* 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);
 }
Index: gcc/testsuite/gcc.dg/debug/pr35154.c
===================================================================
--- gcc/testsuite/gcc.dg/debug/pr35154.c	(revision 0)
+++ gcc/testsuite/gcc.dg/debug/pr35154.c	(revision 0)
@@ -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" } } */
Index: gcc/testsuite/lib/gfortran-dg.exp
===================================================================
--- gcc/testsuite/lib/gfortran-dg.exp	(revision 132242)
+++ gcc/testsuite/lib/gfortran-dg.exp	(working copy)
@@ -107,3 +107,57 @@
 	}
     }
 }
+
+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 ""
+           }
+       }
+    }
+}
Index: gcc/testsuite/gfortran.dg/debug/debug.exp
===================================================================
--- gcc/testsuite/gfortran.dg/debug/debug.exp	(revision 0)
+++ gcc/testsuite/gfortran.dg/debug/debug.exp	(revision 0)
@@ -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
Index: gcc/testsuite/gfortran.dg/debug/pr35154-stabs.f
===================================================================
--- gcc/testsuite/gfortran.dg/debug/pr35154-stabs.f	(revision 0)
+++ gcc/testsuite/gfortran.dg/debug/pr35154-stabs.f	(revision 0)
@@ -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" } }
Index: gcc/testsuite/gfortran.dg/debug/pr35154-dwarf2.f
===================================================================
--- gcc/testsuite/gfortran.dg/debug/pr35154-dwarf2.f	(revision 0)
+++ gcc/testsuite/gfortran.dg/debug/pr35154-dwarf2.f	(revision 0)
@@ -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" } }
Index: gcc/testsuite/gfortran.dg/debug/trivial.f
===================================================================
--- gcc/testsuite/gfortran.dg/debug/trivial.f	(revision 0)
+++ gcc/testsuite/gfortran.dg/debug/trivial.f	(revision 0)
@@ -0,0 +1,2 @@
+      program trivial
+      end

Re: [PATCH,fortran]: Emit COMMON identifiers in proper debug scope

[Jim Wilson]

Second try... the mail headers got corrupted somehow and my response
didn't make it to gcc-patches.  Also, where did that wilson@cygnus.com
come from?  That address stopped working about 5 years ago.

On Fri, 2008-03-21 at 10:18 -0700, Jim Wilson wrote:
> On Thu, 2008-03-20 at 08:51 +0000, George Helffrich wrote:
> > +        case PLUS:
> > +          if (GET_CODE (XEXP (sym_addr, 0)) == CONST_INT)
> 
> According to the rules of canonical form for RTL, this case shouldn't
> occur.  A CONST_INT should always be operand 1 of a plus.  So it
> shouldn't be necessary to handle both cases here, though this is
> harmless.  If you did see a case where it was necessary, that was
> probably a bug elsewhere.
> 
> This is present in both the dbxout.c patch and the dwarf2out.c patch.
> 
> > +      if (cclos)
> > +        dbxout_common_name (syms, comm_prev, N_ECOMM)
> 
> > +  if (comm_prev != NULL)
> > +    dbxout_common_name (syms_prev, comm_prev, N_ECOMM);
> 
> This looks wrong.  Shouldn't both of these be using syms_prev?  This is
> in the dbxout.c patch.
> 
> > +  default:
> > +  return NULL;
> 
> This is at the end of dw_expand_expr in dwarf2out.c.  The return NULL
> needs two more spaces before it.
> 
> > +      var_die = new_die (DW_TAG_common_block, context_die, decl);
> 
> Looks like you are creating a new common block die for every variable in
> a common block.  It would be better to have a single common block die
> shared by each variable in that common block.  This is probably OK for
> now though.  Maybe add a ??? comment to indicate that this should be
> fixed some day?  The dbxout code apparently already gets this right.
> 
> > +   emits the N_BCOMM and N_ECOMM stabs. */
> 
> GNU coding conventions say that you are always supposed to put two
> spaces after a period.  This is mentioned in the 6th paragraph at
>     http://www.gnu.org/prep/standards/html_node/Comments.html#Comments
> 
> Otherwise, this looks OK.
> 
> Jim

Re: [PATCH,fortran]: Emit COMMON identifiers in proper debug scope

[FX Coudert]

> +2007-10-27  George Helffrich <ghfbsd@gly.bris.ac.uk>
> +
> +       * trans-common.c (create_common): Identifiers declared in  
> COMMON
> +       go on to the function's decl chain, not the global chain.   
> This makes
> +       the symbols appear in the proper debug scope.


I've looked more into it, and I'm now convinced that this patch is in  
principle OK: commons shouldn't be put on toplevel scope. One thing,  
though, is that in practice applying this patch makes stabs work  
better, but makes us regress on DWARF targets (where having commons  
at global scope hid the preexsiting issue): see http://gcc.gnu.org/ml/ 
gcc-patches/2007-10/msg01685.html for details.

Thus, I okay this patch conditional to the fix to dwarf2out being  
committed at the same time. So, can you make a combined patch (this  
one + the latest version of the dwarf2out patch), submit it and CC  
the dwarf or debug-info maintainer (Jim Wilson and Jason Merrill)?

Thanks,
FX

-- 
François-Xavier Coudert
http://www.homepages.ucl.ac.uk/~uccafco/

Re: [PATCH,fortran]: Emit COMMON identifiers in proper debug scope

[FX Coudert]

Hi George,

First, thanks for contributing! The current state of the debug info  
emitted by gfortran is far from very good (not to mention work  
required on gdb to make it understand Fortran better), so we're  
always happy to fix this.

> This patch fixes scope bug arising with Fortran symbols defined in  
> COMMON.  They get emitted in the wrong debug scope unless they are  
> put on the symbol list associated with each function.  Bug shows up  
> with stabs-type debug information and fixes that; other debug forms  
> possibly also a problem.  Patch follows:

Unfortunately, I don't think we can apply this patch as such. For the  
following simple code:

$ cat x.f90
program test
   integer ii, jj
   common /foo/ ii,jj

   ii = 42
   jj = ii / 2
   print *, ii, jj
   call sub
end program test

subroutine sub
   integer aa, bb
   common /foo/ aa,bb
   print *, aa, bb
end subroutine sub

the current situation with DWARF is fairly satisfying (I set  
breakpoints on each of the "print" lines):

> Breakpoint 1, MAIN__ () at x.f90:7
> 7         print *, ii, jj
> Current language:  auto; currently fortran
> (gdb) p ii
> $1 = 42
> (gdb) p jj
> $2 = 21
> (gdb) c
> Continuing.
>           42          21
>
> Breakpoint 2, sub_ () at x.f90:14
> 14        print *, aa, bb
> (gdb) p aa
> $3 = 42
> (gdb) p bb
> $4 = 21
> (gdb) c
> Continuing.
>           42          21

while for stabs+, it's not working at all:

> Breakpoint 1, MAIN__ () at x.f90:7
> 7         print *, ii, jj
> (gdb) p ii
> Address of symbol "ii" is unknown.
> (gdb) p jj
> No symbol "jj" in current context.
> (gdb) p aa
> $1 = 0
> (gdb) p bb
> $2 = 1431662116
> (gdb) c
> Continuing.
>           42          21
>
> Breakpoint 2, sub_ () at x.f90:14
> 14        print *, aa, bb
> (gdb) p aa
> $5 = 0
> (gdb) p bb
> $6 = 1431662116
> (gdb) p ii
> Address of symbol "ii" is unknown.
> (gdb) p jj
> No symbol "jj" in current context.
> (gdb) c
> Continuing.
>           42          21

With your patch added, it partly fixes stabs+ (partly only: see how  
neither i nor a are displayed ok):

> Breakpoint 1, MAIN__ () at x.f90:7
> 7         print *, ii, jj
> (gdb) p ii
> Address of symbol "ii" is unknown.
> (gdb) p jj
> $1 = 21
> (gdb) p aa
> $2 = 0
> (gdb) p bb
> $3 = 1431662116
> (gdb) c
> Continuing.
>           42          21
>
> Breakpoint 2, sub_ () at x.f90:14
> 14        print *, aa, bb
> (gdb) p ii
> Address of symbol "ii" is unknown.
> (gdb) p jj
> No symbol "jj" in current context.
> (gdb) p aa
> $4 = 0
> (gdb) p bb
> $5 = 21
> (gdb) c
> Continuing.
>           42          21

But it breaks DWARF:

> Breakpoint 1, MAIN__ () at x.f90:7
> 7         print *, ii, jj
> Current language:  auto; currently fortran
> (gdb) p ii
> No symbol "ii" in current context.
> (gdb) p jj
> No symbol "jj" in current context.
> (gdb) p aa
> $1 = 0
> (gdb) p bb
> $2 = 1431662116
> (gdb) c
> Continuing.
>           42          21
>
> Breakpoint 2, sub_ () at x.f90:14
> 14        print *, aa, bb
> (gdb) p aa
> $3 = 0
> (gdb) p bb
> $4 = 1431662116
> (gdb) p ii
> No symbol "ii" in current context.
> (gdb) p jj
> No symbol "jj" in current context.
> (gdb) c
> Continuing.
>           42          21

So, while I agree that the current behaviour is not good for stabs  
and not perfect for dwarf (because the scope of common variables is  
too large, ie we can access aa and bb in the main program, where they  
don't belong), I think it's more complicated than that. I'm fairly  
new to this debug info issues (I started understanding dwarf, and  
haven't yet done anything on stabs), so I'm not sure what is  
happening there, but maybe you have an idea?

Regards,
FX

[PATCH,fortran]: Emit COMMON identifiers in proper debug scope

[George Helffrich]

This patch fixes scope bug arising with Fortran symbols defined in 
COMMON.  They get emitted in the wrong debug scope unless they are put 
on the symbol list associated with each function.  Bug shows up with 
stabs-type debug information and fixes that; other debug forms possibly 
also a problem.  Patch follows:

Index: trans-common.c
===================================================================
--- trans-common.c      (revision 129681)
+++ trans-common.c      (working copy)
@@ -671,10 +671,7 @@
        /* 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,
                            build3 (COMPONENT_REF, TREE_TYPE (s->field),
Index: ChangeLog
===================================================================
--- ChangeLog   (revision 129681)
+++ ChangeLog   (working copy)
@@ -1,3 +1,9 @@
+2007-10-27  George Helffrich <ghfbsd@gly.bris.ac.uk>
+
+       * trans-common.c (create_common): Identifiers declared in COMMON
+       go on to the function's decl chain, not the global chain.  This 
makes
+       the symbols appear in the proper debug scope.
+
  2007-10-27  Tobias Burnus  <burnus@net-b.de>

         PR fortran/33862