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
+
+# 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
--- gcc/testsuite/gfortran.dg/debug/trivial.f (revision 0)
+++ gcc/testsuite/gfortran.dg/debug/trivial.f (revision 133801)
@@ -0,0 +1,2 @@
+ program trivial
+ end