OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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
This commit is contained in:
George Helffrich 2008-04-01 21:23:36 +00:00
parent dc197ab91c
commit 7151ffbe56
12 changed files with 650 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
gcc/ChangeLog
View File

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

178
gcc/dbxout.c
View File

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

225
gcc/dwarf2out.c
View File

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

5
gcc/fortran/ChangeLog
View File

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

5
gcc/fortran/trans-common.c
View File

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

15
gcc/testsuite/ChangeLog
View File

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

34
gcc/testsuite/gcc.dg/debug/pr35154.c Normal file
View File

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

41
gcc/testsuite/gfortran.dg/debug/debug.exp Normal file
View File

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

37
gcc/testsuite/gfortran.dg/debug/pr35154-dwarf2.f Normal file
View File

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

35
gcc/testsuite/gfortran.dg/debug/pr35154-stabs.f Normal file
View File

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

2
gcc/testsuite/gfortran.dg/debug/trivial.f Normal file
View File

@ -0,0 +1,2 @@
program trivial
end

56
gcc/testsuite/lib/gfortran-dg.exp
View File

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