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