2008-05-07  Jakub Jelinek  <jakub@redhat.com>

	PR debug/35896

	* dwarf2out.c (dw_expand_expr, common_check): Removed.

	(fortran_common): New function.

	(gen_variable_die): Call fortran_common instead of common_check,

	adjust for it returning tree instead of rtx.  Formatting.

2008-04-26  George Helffrich  <george@gcc.gnu.org>

	PR fortran/35892

	PR fortran/35154

	* trans-common.c (create_common):  Add decl to function

	chain (if inside one) to preserve identifier scope in debug output.

	* 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-18  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/35724

	* trans-common.c (create_common): Revert patch causing regression.

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.

--- gcc/dbxout.c	(revision 133800)

+++ gcc/dbxout.c	(revision 133801)

@@ -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 

     {

       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 

 	  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 

 	 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 cha

     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;

 }

--- gcc/dwarf2out.c	(revision 133800)

+++ gcc/dwarf2out.c	(revision 133801)

@@ -4429,6 +4429,7 @@ static void output_compilation_unit_head

 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);

@@ -7659,18 +7660,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

@@ -10914,6 +10920,57 @@ 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 tree

+fortran_common (tree decl, HOST_WIDE_INT *value)

+{

+  tree val_expr, cvar;

+  enum machine_mode mode;

+  HOST_WIDE_INT bitsize, bitpos;

+  tree offset;

+  int volatilep = 0, unsignedp = 0;

+

+  /* 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)

+      || !is_fortran ())

+    return NULL_TREE;

+

+  val_expr = DECL_VALUE_EXPR (decl);

+  if (TREE_CODE (val_expr) != COMPONENT_REF)

+    return NULL_TREE;

+

+  cvar = get_inner_reference (val_expr, &bitsize, &bitpos, &offset,

+			      &mode, &unsignedp, &volatilep, true);

+

+  if (cvar == NULL_TREE

+      || TREE_CODE (cvar) != VAR_DECL

+      || DECL_ARTIFICIAL (cvar)

+      || !TREE_PUBLIC (cvar))

+    return NULL_TREE;

+

+  *value = 0;

+  if (offset != NULL)

+    {

+      if (!host_integerp (offset, 0))

+	return NULL_TREE;

+      *value = tree_low_cst (offset, 0);

+    }

+  if (bitpos != 0)

+    *value += bitpos / BITS_PER_UNIT;

+

+  return cvar;

+}

+

+

 /* 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

@@ -12811,9 +12868,10 @@ gen_subprogram_die (tree decl, dw_die_re

 static void

 gen_variable_die (tree decl, dw_die_ref context_die)

 {

+  HOST_WIDE_INT off;

+  tree com_decl;

+  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

@@ -12837,6 +12895,37 @@ gen_variable_die (tree decl, dw_die_ref 

 			 && DECL_COMDAT (decl) && !TREE_ASM_WRITTEN (decl))

 		     || class_or_namespace_scope_p (context_die));

+  com_decl = fortran_common (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 (com_decl)

+    {

+      tree field;

+      dw_die_ref com_die;

+      const char *cnam = IDENTIFIER_POINTER (DECL_ASSEMBLER_NAME (com_decl));

+      dw_loc_descr_ref loc = loc_descriptor_from_tree (com_decl);

+

+      field = 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, field);

+      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);

@@ -13812,8 +13901,13 @@ decls_for_scope (tree stmt, dw_die_ref c

 	    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);

@@ -14137,6 +14231,16 @@ gen_decl_die (tree decl, dw_die_ref cont

       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))

@@ -14203,7 +14307,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);

 }

--- gcc/fortran/trans-common.c	(revision 134695)

+++ gcc/fortran/trans-common.c	(revision 134696)

@@ -687,7 +687,11 @@ create_common (gfc_common_head *com, seg

       /* This is a fake variable just for debugging purposes.  */

       TREE_ASM_WRITTEN (var_decl) = 1;

-      if (com)

+      /* To preserve identifier names in COMMON, chain to procedure

+	 scope unless at top level in a module definition.  */

+      if (com

+	  && s->sym->ns->proc_name

+	  && s->sym->ns->proc_name->attr.flavor == FL_MODULE)

 	var_decl = pushdecl_top_level (var_decl);

       else

 	gfc_add_decl_to_function (var_decl);

--- gcc/testsuite/gfortran.dg/debug/pr35154-stabs.f	(revision 0)

+++ gcc/testsuite/gfortran.dg/debug/pr35154-stabs.f	(revision 134696)

@@ -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" } }

--- gcc/testsuite/gfortran.dg/debug/pr35154-dwarf2.f	(revision 0)

+++ gcc/testsuite/gfortran.dg/debug/pr35154-dwarf2.f	(revision 134696)

@@ -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" } }

--- gcc/testsuite/gcc.dg/debug/pr35154.c	(revision 0)

+++ gcc/testsuite/gcc.dg/debug/pr35154.c	(revision 133801)

@@ -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" } } */

--- gcc/testsuite/lib/gfortran-dg.exp	(revision 133800)

+++ gcc/testsuite/lib/gfortran-dg.exp	(revision 133801)

@@ -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 def

 	}

     }

 }

+

+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 ""

+           }

+       }

+    }

+}

--- gcc/testsuite/gfortran.dg/debug/debug.exp	(revision 0)

+++ gcc/testsuite/gfortran.dg/debug/debug.exp	(revision 133801)

@@ -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