2008-05-07 Jakub Jelinek 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 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 PR fortran/35724 * trans-common.c (create_common): Revert patch causing regression. 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. --- 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 +# . + +# 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