rpms/gcc
7
0
Fork 0
Code Issues Pull Requests Releases Activity

4.3.1-8

Browse Source
This commit is contained in:
Jakub Jelinek 2008-08-25 12:56:48 +00:00
parent dc4fc4efba
commit 66f35a6aae
13 changed files with 1348 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.cvsignore
View File

@ -1,2 +1,2 @@
gcc-4.3.1-20080812.tar.bz2
gcc-4.3.1-20080825.tar.bz2
fastjar-0.95.tar.gz

739
gcc43-fortran-debug1.patch Normal file
View File

@ -0,0 +1,739 @@
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

4
gcc43-fortran-debug2.patch
View File

@ -293,14 +293,14 @@
symbol_attribute gfc_variable_attr (gfc_expr *, gfc_typespec *);
--- gcc/fortran/symbol.c.jj 2008-08-21 10:19:49.000000000 +0200
+++ gcc/fortran/symbol.c 2008-08-21 10:21:30.000000000 +0200
@@ -3042,6 +3042,7 @@ gfc_free_namespace (gfc_namespace *ns)
@@ -2903,6 +2903,7 @@ gfc_free_namespace (gfc_namespace *ns)
gfc_free_equiv (ns->equiv);
gfc_free_equiv_lists (ns->equiv_lists);
+ gfc_free_use_stmts (ns->use_stmts);
for (i = GFC_INTRINSIC_BEGIN; i != GFC_INTRINSIC_END; i++)
gfc_free_interface (ns->op[i]);
gfc_free_interface (ns->operator[i]);
--- gcc/fortran/trans-types.c.jj 2008-08-21 10:19:49.000000000 +0200
+++ gcc/fortran/trans-types.c 2008-08-21 10:21:30.000000000 +0200
@@ -1934,12 +1934,23 @@ gfc_get_derived_type (gfc_symbol * deriv

82
gcc43-fortran-debug3.patch Normal file
View File

@ -0,0 +1,82 @@
2008-08-21 Jakub Jelinek <jakub@redhat.com>
* trans-decl.c (gfc_build_qualified_array): Build non-flat
array type for debug info purposes.
* dwarf2out.c (add_bound_info): If lookup_decl_die failed, try
loc_descriptor_from_tree_1.
--- gcc/fortran/trans-decl.c.jj 2008-08-21 11:56:09.000000000 +0200
+++ gcc/fortran/trans-decl.c 2008-08-21 23:07:01.000000000 +0200
@@ -703,6 +703,50 @@ gfc_build_qualified_array (tree decl, gf
TYPE_DOMAIN (type) = range;
layout_type (type);
}
+
+ if (nest || write_symbols == NO_DEBUG)
+ return;
+
+ if (TYPE_NAME (type) != NULL_TREE
+ && GFC_TYPE_ARRAY_UBOUND (type, sym->as->rank - 1) != NULL_TREE
+ && TREE_CODE (GFC_TYPE_ARRAY_UBOUND (type, sym->as->rank - 1)) == VAR_DECL)
+ {
+ tree gtype = DECL_ORIGINAL_TYPE (TYPE_NAME (type));
+
+ for (dim = 0; dim < sym->as->rank - 1; dim++)
+ {
+ gcc_assert (TREE_CODE (gtype) == ARRAY_TYPE);
+ gtype = TREE_TYPE (gtype);
+ }
+ gcc_assert (TREE_CODE (gtype) == ARRAY_TYPE);
+ if (TYPE_MAX_VALUE (TYPE_DOMAIN (gtype)) == NULL)
+ TYPE_NAME (type) = NULL_TREE;
+ }
+
+ if (TYPE_NAME (type) == NULL_TREE)
+ {
+ tree gtype = TREE_TYPE (type), rtype, type_decl;
+
+ for (dim = sym->as->rank - 1; dim >= 0; dim--)
+ {
+ rtype = build_range_type (gfc_array_index_type,
+ GFC_TYPE_ARRAY_LBOUND (type, dim),
+ GFC_TYPE_ARRAY_UBOUND (type, dim));
+ gtype = build_array_type (gtype, rtype);
+ /* Ensure the bound variables aren't optimized out at -O0. */
+ if (!optimize)
+ {
+ if (GFC_TYPE_ARRAY_LBOUND (type, dim)
+ && TREE_CODE (GFC_TYPE_ARRAY_LBOUND (type, dim)) == VAR_DECL)
+ DECL_IGNORED_P (GFC_TYPE_ARRAY_LBOUND (type, dim)) = 0;
+ if (GFC_TYPE_ARRAY_UBOUND (type, dim)
+ && TREE_CODE (GFC_TYPE_ARRAY_UBOUND (type, dim)) == VAR_DECL)
+ DECL_IGNORED_P (GFC_TYPE_ARRAY_UBOUND (type, dim)) = 0;
+ }
+ }
+ TYPE_NAME (type) = type_decl = build_decl (TYPE_DECL, NULL, gtype);
+ DECL_ORIGINAL_TYPE (type_decl) = gtype;
+ }
}
--- gcc/dwarf2out.c.jj 2008-08-21 13:15:41.000000000 +0200
+++ gcc/dwarf2out.c 2008-08-21 18:27:30.000000000 +0200
@@ -11943,6 +11943,7 @@ add_bound_info (dw_die_ref subrange_die,
case RESULT_DECL:
{
dw_die_ref decl_die = lookup_decl_die (bound);
+ dw_loc_descr_ref loc;
/* ??? Can this happen, or should the variable have been bound
first? Probably it can, since I imagine that we try to create
@@ -11951,6 +11952,11 @@ add_bound_info (dw_die_ref subrange_die,
later parameter. */
if (decl_die != NULL)
add_AT_die_ref (subrange_die, bound_attr, decl_die);
+ else
+ {
+ loc = loc_descriptor_from_tree_1 (bound, 0);
+ add_AT_location_description (subrange_die, bound_attr, loc);
+ }
break;
}

112
gcc43-fortran-debug4.patch Normal file
View File

@ -0,0 +1,112 @@
2008-08-22 Jakub Jelinek <jakub@redhat.com>
PR fortran/23057
* dwarf2out.c (gen_variable_die): Represent Fortran COMMON vars
as DW_TAG_variable children of DW_TAG_common_block rather than
DW_TAG_member children. Put DW_AT_external to individual
DW_TAG_variable DIEs, not to DW_TAG_common_block.
* gfortran.dg/debug/pr35154-dwarf2.f: Adjust for replacement
of DW_TAG_member with DW_TAG_variable.
--- gcc/dwarf2out.c.jj 2008-08-21 18:27:30.000000000 +0200
+++ gcc/dwarf2out.c 2008-08-22 12:12:56.000000000 +0200
@@ -13540,43 +13540,66 @@ gen_variable_die (tree decl, dw_die_ref
{
tree field;
dw_die_ref com_die;
+ dw_loc_descr_ref loc;
- if (lookup_decl_die (decl))
- return;
+ com_die = lookup_decl_die (decl);
+ if (com_die)
+ {
+ if (get_AT (com_die, DW_AT_location) == NULL)
+ {
+ loc = loc_descriptor_from_tree (com_decl);
+ if (loc)
+ {
+ if (off)
+ add_loc_descr (&loc, new_loc_descr (DW_OP_plus_uconst,
+ off, 0));
+ add_AT_loc (com_die, DW_AT_location, loc);
+ remove_AT (com_die, DW_AT_declaration);
+ }
+ }
+ return;
+ }
field = TREE_OPERAND (DECL_VALUE_EXPR (decl), 0);
var_die = lookup_decl_die (com_decl);
+ loc = loc_descriptor_from_tree (com_decl);
if (var_die == NULL)
{
const char *cnam
= IDENTIFIER_POINTER (DECL_ASSEMBLER_NAME (com_decl));
- dw_loc_descr_ref loc = loc_descriptor_from_tree (com_decl);
var_die = new_die (DW_TAG_common_block, context_die, decl);
add_name_and_src_coords_attributes (var_die, com_decl);
- add_AT_flag (var_die, DW_AT_external, 1);
if (loc)
- add_AT_loc (var_die, DW_AT_location, loc);
+ {
+ add_AT_loc (var_die, DW_AT_location, loc);
+ /* Avoid sharing the same loc descriptor between
+ DW_TAG_common_block and DW_TAG_variable. */
+ loc = loc_descriptor_from_tree (com_decl);
+ }
else if (DECL_EXTERNAL (decl))
add_AT_flag (var_die, DW_AT_declaration, 1);
add_pubname_string (cnam, var_die); /* ??? needed? */
equate_decl_number_to_die (com_decl, var_die);
}
- else if (get_AT (var_die, DW_AT_location) == NULL)
+ else if (get_AT (var_die, DW_AT_location) == NULL && loc)
{
- dw_loc_descr_ref loc = loc_descriptor_from_tree (com_decl);
-
- if (loc)
- {
- add_AT_loc (var_die, DW_AT_location, loc);
- remove_AT (var_die, DW_AT_declaration);
- }
+ add_AT_loc (var_die, DW_AT_location, loc);
+ loc = loc_descriptor_from_tree (com_decl);
+ remove_AT (var_die, DW_AT_declaration);
}
- com_die = new_die (DW_TAG_member, var_die, decl);
+ com_die = new_die (DW_TAG_variable, 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_AT_flag (com_die, DW_AT_external, 1);
+ if (loc)
+ {
+ if (off)
+ add_loc_descr (&loc, new_loc_descr (DW_OP_plus_uconst, off, 0));
+ add_AT_loc (com_die, DW_AT_location, loc);
+ }
+ else if (DECL_EXTERNAL (decl))
+ add_AT_flag (com_die, DW_AT_declaration, 1);
equate_decl_number_to_die (decl, com_die);
return;
}
--- gcc/testsuite/gfortran.dg/debug/pr35154-dwarf2.f.jj 2008-04-27 12:42:44.000000000 +0200
+++ gcc/testsuite/gfortran.dg/debug/pr35154-dwarf2.f 2008-08-22 10:56:44.000000000 +0200
@@ -27,11 +27,11 @@ C { dg-options "-dA" }
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 "(DIE.*DW_TAG_variable)" } }
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 "(DIE.*DW_TAG_variable)" } }
C { dg-final { scan-assembler "\"l.*\".*DW_AT_name" } }
C { dg-final { scan-assembler "\"m.*\".*DW_AT_name" } }

91
gcc43-fortran-debug5.patch Normal file
View File

@ -0,0 +1,91 @@
2008-08-22 Jakub Jelinek <jakub@redhat.com>
* dwarf2out.c (loc_by_reference): New function.
(add_location_or_const_value_attribute): Use it.
--- gcc/dwarf2out.c.jj 2008-08-22 12:12:56.000000000 +0200
+++ gcc/dwarf2out.c 2008-08-22 13:39:21.000000000 +0200
@@ -10971,6 +10971,32 @@ fortran_common (tree decl, HOST_WIDE_INT
return cvar;
}
+/* Dereference a location expression LOC if DECL is passed by invisible
+ reference. */
+
+static dw_loc_descr_ref
+loc_by_reference (dw_loc_descr_ref loc, tree decl)
+{
+ HOST_WIDE_INT size;
+ enum dwarf_location_atom op;
+
+ if (loc == NULL)
+ return NULL;
+
+ if ((TREE_CODE (decl) != PARM_DECL && TREE_CODE (decl) != RESULT_DECL)
+ || !DECL_BY_REFERENCE (decl))
+ return loc;
+
+ size = int_size_in_bytes (TREE_TYPE (decl));
+ if (size > DWARF2_ADDR_SIZE || size == -1)
+ return 0;
+ else if (size == DWARF2_ADDR_SIZE)
+ op = DW_OP_deref;
+ else
+ op = DW_OP_deref_size;
+ add_loc_descr (&loc, new_loc_descr (op, size, 0));
+ return loc;
+}
/* 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
@@ -11029,8 +11055,8 @@ add_location_or_const_value_attribute (d
else
initialized = VAR_INIT_STATUS_INITIALIZED;
- list = new_loc_list (loc_descriptor (varloc, initialized),
- node->label, node->next->label, secname, 1);
+ descr = loc_by_reference (loc_descriptor (varloc, initialized), decl);
+ list = new_loc_list (descr, node->label, node->next->label, secname, 1);
node = node->next;
for (; node->next; node = node->next)
@@ -11041,8 +11067,9 @@ add_location_or_const_value_attribute (d
enum var_init_status initialized =
NOTE_VAR_LOCATION_STATUS (node->var_loc_note);
varloc = NOTE_VAR_LOCATION (node->var_loc_note);
- add_loc_descr_to_loc_list (&list,
- loc_descriptor (varloc, initialized),
+ descr = loc_by_reference (loc_descriptor (varloc, initialized),
+ decl);
+ add_loc_descr_to_loc_list (&list, descr,
node->label, node->next->label, secname);
}
@@ -11063,8 +11090,9 @@ add_location_or_const_value_attribute (d
current_function_funcdef_no);
endname = ggc_strdup (label_id);
}
- add_loc_descr_to_loc_list (&list,
- loc_descriptor (varloc, initialized),
+ descr = loc_by_reference (loc_descriptor (varloc, initialized),
+ decl);
+ add_loc_descr_to_loc_list (&list, descr,
node->label, endname, secname);
}
@@ -11094,6 +11122,7 @@ add_location_or_const_value_attribute (d
descr = loc_descriptor (NOTE_VAR_LOCATION (node->var_loc_note), status);
if (descr)
{
+ descr = loc_by_reference (descr, decl);
add_AT_location_description (die, attr, descr);
return;
}
@@ -11104,6 +11133,7 @@ add_location_or_const_value_attribute (d
descr = loc_descriptor_from_tree (decl);
if (descr)
{
+ descr = loc_by_reference (descr, decl);
add_AT_location_description (die, attr, descr);
return;
}

17
gcc43-fortran-debug6.patch Normal file
View File

@ -0,0 +1,17 @@
2008-08-22 Jakub Jelinek <jakub@redhat.com>
PR fortran/24790
* trans-decl.c (create_function_arglist): Set DECL_BY_REFERENCE on
PARM_DECLs with pointer or reference type.
--- gcc/fortran/trans-decl.c.jj 2008-08-21 23:07:01.000000000 +0200
+++ gcc/fortran/trans-decl.c 2008-08-22 14:47:59.000000000 +0200
@@ -1588,6 +1588,8 @@ create_function_arglist (gfc_symbol * sy
DECL_ARG_TYPE (parm) = TREE_VALUE (typelist);
/* All implementation args are read-only. */
TREE_READONLY (parm) = 1;
+ if (POINTER_TYPE_P (type) && f->sym->attr.flavor != FL_PROCEDURE)
+ DECL_BY_REFERENCE (parm) = 1;
gfc_finish_decl (parm);

82
gcc43-fortran-debug7.patch Normal file
View File

@ -0,0 +1,82 @@
2008-08-22 Jakub Jelinek <jakub@redhat.com>
* dwarf2out.c (add_subscript_info): Stop on Fortran TYPE_STRING_FLAG
types.
(gen_array_type_die): Emit DW_TAG_string_type for Fortran character
types.
--- gcc/dwarf2out.c.jj 2008-08-22 13:39:21.000000000 +0200
+++ gcc/dwarf2out.c 2008-08-22 17:49:10.000000000 +0200
@@ -11418,6 +11418,9 @@ add_subscript_info (dw_die_ref type_die,
{
tree domain = TYPE_DOMAIN (type);
+ if (TYPE_STRING_FLAG (type) && is_fortran () && dimension_number > 0)
+ break;
+
/* Arrays come in three flavors: Unspecified bounds, fixed bounds,
and (in GNU C only) variable bounds. Handle all three forms
here. */
@@ -11940,6 +11943,39 @@ gen_array_type_die (tree type, dw_die_re
dw_die_ref array_die;
tree element_type;
+ /* Emit DW_TAG_string_type for Fortran character types (with kind 1 only, as
+ DW_TAG_string_type doesn't have DW_AT_type attribute). */
+ if (TYPE_STRING_FLAG (type)
+ && TREE_CODE (type) == ARRAY_TYPE
+ && is_fortran ()
+ && TYPE_MODE (TREE_TYPE (type)) == TYPE_MODE (char_type_node))
+ {
+ HOST_WIDE_INT size;
+
+ array_die = new_die (DW_TAG_string_type, scope_die, type);
+ add_name_attribute (array_die, type_tag (type));
+ equate_type_number_to_die (type, array_die);
+ size = int_size_in_bytes (type);
+ if (size >= 0)
+ add_AT_unsigned (array_die, DW_AT_byte_size, size);
+ else if (TYPE_DOMAIN (type) != NULL_TREE
+ && TYPE_MAX_VALUE (TYPE_DOMAIN (type)) != NULL_TREE
+ && DECL_P (TYPE_MAX_VALUE (TYPE_DOMAIN (type))))
+ {
+ tree szdecl = TYPE_MAX_VALUE (TYPE_DOMAIN (type));
+ dw_loc_descr_ref loc = loc_descriptor_from_tree (szdecl);
+
+ size = int_size_in_bytes (TREE_TYPE (szdecl));
+ if (loc && size > 0)
+ {
+ add_AT_loc (array_die, DW_AT_string_length, loc);
+ if (size != DWARF2_ADDR_SIZE)
+ add_AT_unsigned (array_die, DW_AT_byte_size, size);
+ }
+ }
+ return;
+ }
+
/* ??? The SGI dwarf reader fails for array of array of enum types unless
the inner array type comes before the outer array type. Thus we must
call gen_type_die before we call new_die. See below also. */
@@ -11962,7 +11998,8 @@ gen_array_type_die (tree type, dw_die_re
/* For Fortran multidimensional arrays use DW_ORD_col_major ordering. */
if (is_fortran ()
&& TREE_CODE (type) == ARRAY_TYPE
- && TREE_CODE (TREE_TYPE (type)) == ARRAY_TYPE)
+ && TREE_CODE (TREE_TYPE (type)) == ARRAY_TYPE
+ && !TYPE_STRING_FLAG (TREE_TYPE (type)))
add_AT_unsigned (array_die, DW_AT_ordering, DW_ORD_col_major);
#if 0
@@ -11994,7 +12031,11 @@ gen_array_type_die (tree type, dw_die_re
add_subscript_info. */
#ifndef MIPS_DEBUGGING_INFO
while (TREE_CODE (element_type) == ARRAY_TYPE)
- element_type = TREE_TYPE (element_type);
+ {
+ if (TYPE_STRING_FLAG (element_type) && is_fortran ())
+ break;
+ element_type = TREE_TYPE (element_type);
+ }
gen_type_die (element_type, context_die);
#endif

48
gcc43-fortran-debug8.patch Normal file
View File

@ -0,0 +1,48 @@
2008-08-22 Jakub Jelinek <jakub@redhat.com>
* dwarf2out.c (gen_formal_parameter_die, gen_variable_die): For
DECL_BY_REFERENCE decls don't pass TREE_READONLY and
TREE_THIS_VOLATILE to add_type_attribute.
--- gcc/dwarf2out.c.jj 2008-08-22 17:49:10.000000000 +0200
+++ gcc/dwarf2out.c 2008-08-22 18:04:15.000000000 +0200
@@ -13033,11 +13033,13 @@ gen_formal_parameter_die (tree node, dw_
tree type = TREE_TYPE (node);
add_name_and_src_coords_attributes (parm_die, node);
if (DECL_BY_REFERENCE (node))
- type = TREE_TYPE (type);
- add_type_attribute (parm_die, type,
- TREE_READONLY (node),
- TREE_THIS_VOLATILE (node),
- context_die);
+ add_type_attribute (parm_die, TREE_TYPE (type), 0, 0,
+ context_die);
+ else
+ add_type_attribute (parm_die, type,
+ TREE_READONLY (node),
+ TREE_THIS_VOLATILE (node),
+ context_die);
if (DECL_ARTIFICIAL (node))
add_AT_flag (parm_die, DW_AT_artificial, 1);
}
@@ -13714,14 +13716,15 @@ gen_variable_die (tree decl, dw_die_ref
else
{
tree type = TREE_TYPE (decl);
+
+ add_name_and_src_coords_attributes (var_die, decl);
if ((TREE_CODE (decl) == PARM_DECL
|| TREE_CODE (decl) == RESULT_DECL)
&& DECL_BY_REFERENCE (decl))
- type = TREE_TYPE (type);
-
- add_name_and_src_coords_attributes (var_die, decl);
- add_type_attribute (var_die, type, TREE_READONLY (decl),
- TREE_THIS_VOLATILE (decl), context_die);
+ add_type_attribute (var_die, TREE_TYPE (type), 0, 0, context_die);
+ else
+ add_type_attribute (var_die, type, TREE_READONLY (decl),
+ TREE_THIS_VOLATILE (decl), context_die);
if (TREE_PUBLIC (decl))
add_AT_flag (var_die, DW_AT_external, 1);

144
gcc43-fortran-debug9.patch Normal file
View File

@ -0,0 +1,144 @@
2008-08-25 Jakub Jelinek <jakub@redhat.com>
* gfortran.h (gfc_use_list): Add where field.
* module.c (use_locus): New static variable.
(gfc_match_use): Set it.
(gfc_use_module): Copy it to gfc_use_list's where field.
* trans-decl.c (gfc_generate_module_vars): Call gfc_trans_use_stmts.
(gfc_trans_use_stmts): Set backend locus before calling the debug
hook. Allow non-VAR_DECLs to be created even for non-external
module. Don't emit anything so far for renames from different
modules.
--- gcc/fortran/gfortran.h.jj 2008-08-22 20:11:22.000000000 +0200
+++ gcc/fortran/gfortran.h 2008-08-25 13:03:42.000000000 +0200
@@ -1131,6 +1131,7 @@ typedef struct gfc_use_list
const char *module_name;
int only_flag;
struct gfc_use_rename *rename;
+ locus where;
/* Next USE statement. */
struct gfc_use_list *next;
}
--- gcc/fortran/module.c.jj 2008-08-22 20:11:22.000000000 +0200
+++ gcc/fortran/module.c 2008-08-25 13:10:57.000000000 +0200
@@ -188,6 +188,8 @@ static int symbol_number; /* Counter for
/* Tells mio_expr_ref to make symbols for unused equivalence members. */
static bool in_load_equiv;
+static locus use_locus;
+
/*****************************************************************/
@@ -546,6 +548,8 @@ gfc_match_use (void)
}
}
+ use_locus = gfc_current_locus;
+
m = gfc_match_name (module_name);
if (m != MATCH_YES)
return m;
@@ -5044,6 +5048,7 @@ gfc_use_module (void)
use_stmt->module_name = gfc_get_string (module_name);
use_stmt->only_flag = only_flag;
use_stmt->rename = gfc_rename_list;
+ use_stmt->where = use_locus;
gfc_rename_list = NULL;
use_stmt->next = gfc_current_ns->use_stmts;
gfc_current_ns->use_stmts = use_stmt;
--- gcc/fortran/trans-decl.c.jj 2008-08-25 12:44:00.000000000 +0200
+++ gcc/fortran/trans-decl.c 2008-08-25 13:16:17.000000000 +0200
@@ -3151,26 +3151,7 @@ gfc_create_module_variable (gfc_symbol *
}
}
-
-/* Generate all the required code for module variables. */
-
-void
-gfc_generate_module_vars (gfc_namespace * ns)
-{
- module_namespace = ns;
- cur_module = gfc_find_module (ns->proc_name->name);
-
- /* Check if the frontend left the namespace in a reasonable state. */
- gcc_assert (ns->proc_name && !ns->proc_name->tlink);
-
- /* Generate COMMON blocks. */
- gfc_trans_common (ns);
-
- /* Create decls for all the module variables. */
- gfc_traverse_ns (ns, gfc_create_module_variable);
-
- cur_module = NULL;
-}
+/* Emit debug information for USE statements. */
static void
gfc_trans_use_stmts (gfc_namespace * ns)
@@ -3190,6 +3171,7 @@ gfc_trans_use_stmts (gfc_namespace * ns)
void_type_node);
DECL_EXTERNAL (entry->namespace_decl) = 1;
}
+ gfc_set_backend_locus (&use_stmt->where);
if (!use_stmt->only_flag)
(*debug_hooks->imported_module_or_decl) (entry->namespace_decl,
NULL_TREE,
@@ -3214,9 +3196,14 @@ gfc_trans_use_stmts (gfc_namespace * ns)
rent->local_name[0]
? rent->local_name : rent->use_name);
gcc_assert (st && st->n.sym->attr.use_assoc);
- if (st->n.sym->backend_decl && DECL_P (st->n.sym->backend_decl))
+ if (st->n.sym->backend_decl
+ && DECL_P (st->n.sym->backend_decl)
+ && st->n.sym->module
+ && strcmp (st->n.sym->module, use_stmt->module_name) == 0)
{
- gcc_assert (DECL_EXTERNAL (entry->namespace_decl));
+ gcc_assert (DECL_EXTERNAL (entry->namespace_decl)
+ || (TREE_CODE (st->n.sym->backend_decl)
+ != VAR_DECL));
decl = copy_node (st->n.sym->backend_decl);
DECL_CONTEXT (decl) = entry->namespace_decl;
DECL_EXTERNAL (decl) = 1;
@@ -3236,6 +3223,7 @@ gfc_trans_use_stmts (gfc_namespace * ns)
local_name = get_identifier (rent->local_name);
else
local_name = NULL_TREE;
+ gfc_set_backend_locus (&rent->where);
(*debug_hooks->imported_module_or_decl) (decl, local_name,
ns->proc_name->backend_decl,
!use_stmt->only_flag);
@@ -3243,6 +3231,30 @@ gfc_trans_use_stmts (gfc_namespace * ns)
}
}
+
+/* Generate all the required code for module variables. */
+
+void
+gfc_generate_module_vars (gfc_namespace * ns)
+{
+ module_namespace = ns;
+ cur_module = gfc_find_module (ns->proc_name->name);
+
+ /* Check if the frontend left the namespace in a reasonable state. */
+ gcc_assert (ns->proc_name && !ns->proc_name->tlink);
+
+ /* Generate COMMON blocks. */
+ gfc_trans_common (ns);
+
+ /* Create decls for all the module variables. */
+ gfc_traverse_ns (ns, gfc_create_module_variable);
+
+ cur_module = NULL;
+
+ gfc_trans_use_stmts (ns);
+}
+
+
static void
gfc_generate_contained_functions (gfc_namespace * parent)
{

56
gcc43-pr37103.patch
View File

@ -1,56 +0,0 @@
2008-08-13 Jakub Jelinek <jakub@redhat.com>
PR middle-end/37103
* fold-const.c (fold_widened_comparison): Do not allow
sign changes that change the result even if shorter type
is wider than arg1_unw's type.
* gcc.c-torture/execute/20080813-1.c: New test.
--- gcc/fold-const.c.jj 2008-08-13 19:46:11.000000000 +0200
+++ gcc/fold-const.c 2008-08-13 20:18:21.000000000 +0200
@@ -6733,10 +6733,8 @@ fold_widened_comparison (enum tree_code
if ((code == EQ_EXPR || code == NE_EXPR
|| TYPE_UNSIGNED (TREE_TYPE (arg0)) == TYPE_UNSIGNED (shorter_type))
&& (TREE_TYPE (arg1_unw) == shorter_type
- || (TYPE_PRECISION (shorter_type)
- > TYPE_PRECISION (TREE_TYPE (arg1_unw)))
|| ((TYPE_PRECISION (shorter_type)
- == TYPE_PRECISION (TREE_TYPE (arg1_unw)))
+ >= TYPE_PRECISION (TREE_TYPE (arg1_unw)))
&& (TYPE_UNSIGNED (shorter_type)
== TYPE_UNSIGNED (TREE_TYPE (arg1_unw))))
|| (TREE_CODE (arg1_unw) == INTEGER_CST
--- gcc/testsuite/gcc.c-torture/execute/20080813-1.c.jj 2008-08-13 20:22:56.000000000 +0200
+++ gcc/testsuite/gcc.c-torture/execute/20080813-1.c 2008-08-13 20:22:10.000000000 +0200
@@ -0,0 +1,30 @@
+/* PR middle-end/37103 */
+
+extern void abort (void);
+
+void
+foo (unsigned short x)
+{
+ signed char y = -1;
+ if (x == y)
+ abort ();
+}
+
+void
+bar (unsigned short x)
+{
+ unsigned char y = -1;
+ if (x == y)
+ abort ();
+}
+
+int
+main (void)
+{
+ if (sizeof (int) == sizeof (short))
+ return 0;
+ foo (-1);
+ if (sizeof (short) > 1)
+ bar (-1);
+ return 0;
+}

35
gcc43.spec
View File

@ -1,6 +1,6 @@
%define DATE 20080812
%define DATE 20080825
%define gcc_version 4.3.1
%define gcc_release 7
%define gcc_release 8
%define _unpackaged_files_terminate_build 0
%define multilib_64_archs sparc64 ppc64 s390x x86_64
%define include_gappletviewer 1
@ -143,7 +143,15 @@ Patch13: gcc43-i386-libgomp.patch
Patch14: gcc43-rh251682.patch
Patch15: gcc43-sparc-config-detection.patch
Patch16: gcc43-libgomp-omp_h-multilib.patch
Patch17: gcc43-pr37103.patch
Patch17: gcc43-fortran-debug1.patch
Patch18: gcc43-fortran-debug2.patch
Patch19: gcc43-fortran-debug3.patch
Patch20: gcc43-fortran-debug4.patch
Patch21: gcc43-fortran-debug5.patch
Patch22: gcc43-fortran-debug6.patch
Patch23: gcc43-fortran-debug7.patch
Patch24: gcc43-fortran-debug8.patch
Patch25: gcc43-fortran-debug9.patch
# On ARM EABI systems, we do want -gnueabi to be part of the
# target triple.
@ -272,13 +280,13 @@ This package contains Fortran 95 shared library which is needed to run
Fortran 95 dynamically linked programs.
%package -n libgomp
Summary: GCC OpenMP 2.5 shared support library
Summary: GCC OpenMP v3.0 shared support library
Group: System Environment/Libraries
Prereq: /sbin/install-info
%description -n libgomp
This package contains GCC shared support library which is needed
for OpenMP 2.5 support.
for OpenMP v3.0 support.
%package -n libmudflap
Summary: GCC mudflap shared support library
@ -444,7 +452,15 @@ which are required to run programs compiled with the GNAT.
%patch14 -p0 -b .rh251682~
%patch15 -p0 -b .sparc-config-detection~
%patch16 -p0 -b .libgomp-omp_h-multilib~
%patch17 -p0 -b .pr37103~
%patch17 -p0 -b .fortran-debug1~
%patch18 -p0 -b .fortran-debug2~
%patch19 -p0 -b .fortran-debug3~
%patch20 -p0 -b .fortran-debug4~
%patch21 -p0 -b .fortran-debug5~
%patch22 -p0 -b .fortran-debug6~
%patch23 -p0 -b .fortran-debug7~
%patch24 -p0 -b .fortran-debug8~
%patch25 -p0 -b .fortran-debug9~
tar xzf %{SOURCE4}
@ -1666,6 +1682,13 @@ fi
%doc rpm.doc/changelogs/libmudflap/ChangeLog*
%changelog
* Mon Aug 25 2008 Jakub Jelinek <jakub@redhat.com> 4.3.1-8
- update from gcc-4_3-branch
- PRs debug/37156, libgcj/8995, libstdc++/37100, target/37101
- backport Fortran debuginfo improvements (PRs debug/35896, fortran/35154,
fortran/35724, fortran/35892, fortran/29635, fortran/23057
fortran/24790, #457792, #457793, #459374, #459376, #459378)
* Thu Aug 14 2008 Jakub Jelinek <jakub@redhat.com> 4.3.1-7
- update from gcc-4_3-branch
- PRs bootstrap/35752, c++/36688, c++/36999, c++/37016, c/35746,

2
sources
View File

@ -1,2 +1,2 @@
9301ae7cc2316dc82630bc63a543a0f8 gcc-4.3.1-20080812.tar.bz2
13550eec00d2563c42d1879e1f8f3407 gcc-4.3.1-20080825.tar.bz2
92a70f9e56223b653bce0f58f90cf950 fastjar-0.95.tar.gz