rpms/gcc/devel gcc43-fortran-debug1.patch, NONE, 1.1 gcc43-fortran-debug2.patch, NONE, 1.1 gcc43-fortran-debug3.patch, NONE, 1.1 gcc43-fortran-debug4.patch, NONE, 1.1 gcc43-fortran-debug5.patch, NONE, 1.1 gcc43-fortran-debug6.patch, NONE, 1.1 gcc43-fortran-debug7.patch, NONE, 1.1 gcc43-fortran-debug8.patch, NONE, 1.1 gcc43-fortran-debug9.patch, NONE, 1.1 .cvsignore, 1.240, 1.241 gcc43.spec, 1.38, 1.39 sources, 1.243, 1.244 gcc43-pr37103.patch, 1.1, NONE
Jakub Jelinek
jakub at fedoraproject.org
Mon Aug 25 12:07:40 UTC 2008
Author: jakub
Update of /cvs/pkgs/rpms/gcc/devel
In directory cvs1.fedora.phx.redhat.com:/tmp/cvs-serv6201
Modified Files:
.cvsignore gcc43.spec sources
Added Files:
gcc43-fortran-debug1.patch gcc43-fortran-debug2.patch
gcc43-fortran-debug3.patch gcc43-fortran-debug4.patch
gcc43-fortran-debug5.patch gcc43-fortran-debug6.patch
gcc43-fortran-debug7.patch gcc43-fortran-debug8.patch
gcc43-fortran-debug9.patch
Removed Files:
gcc43-pr37103.patch
Log Message:
4.3.1-8
gcc43-fortran-debug1.patch:
--- NEW FILE gcc43-fortran-debug1.patch ---
2008-05-07 Jakub Jelinek <jakub at 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 at 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 at gcc.gnu.org>
PR fortran/35724
* trans-common.c (create_common): Revert patch causing regression.
2008-04-01 George Helffrich <george at 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
gcc43-fortran-debug2.patch:
--- NEW FILE gcc43-fortran-debug2.patch ---
2008-08-22 Jakub Jelinek <jakub at redhat.com>
PR fortran/29635
PR fortran/23057
* debug.h (struct gcc_debug_hooks): Add NAME and CHILD
arguments to imported_module_or_decl.
(debug_nothing_tree_tree): Removed.
(debug_nothing_tree_tree_tree_bool): New prototype.
* debug.c (do_nothing_debug_hooks): Adjust.
(debug_nothing_tree_tree): Removed.
(debug_nothing_tree_tree_tree_bool): New function.
* dwarf2out.c (is_symbol_die): Handle DW_TAG_module.
(gen_variable_die): Put all common vars for the
same COMMON block under one DW_TAG_common_block.
(declare_in_namespace): Return new context_die, for Fortran
return the module DIE instead of adding extra declarations into
the namespace.
(gen_type_die_with_usage): Adjust declare_in_namespace caller.
(gen_namespace_die): If is_fortran (), generate DW_TAG_module
instead of DW_TAG_namespace. If DECL_EXTERNAL is set, add
DW_AT_declaration.
(dwarf2out_global_decl): Don't skip Fortran global vars.
(gen_decl_die): Likewise. Adjust declare_in_namespace callers.
(dwarf2out_imported_module_or_decl): Add NAME and CHILD arguments.
If NAME is non-NULL, add DW_AT_name. If CHILD is non-NULL, put
DW_TAG_imported_declaration as child of previous
DW_TAG_imported_module.
* dbxout.c (dbx_debug_hooks, xcoff_debug_hooks): Adjust.
* sdbout.c (sdb_debug_hooks): Likewise.
* vmsdbgout.c (vmsdbg_debug_hooks): Likewise.
* name-lookup.c (do_using_directive, cp_emit_debug_info_for_using):
Adjust debug_hooks->imported_module_or_decl callers.
* f95-lang.c (gfc_init_ts): New function.
(LANG_HOOKS_INIT_TS): Define.
* gfortran.h (gfc_use_rename): New type, moved from module.c.
(gfc_get_use_rename): New macro, moved from module.c.
(gfc_use_list): New type.
(gfc_get_use_list): New macro.
(gfc_namespace): Add use_stmts field.
(gfc_free_use_stmts): New prototype.
* Make-lang.in (fortran/trans-decl.o): Depend on debug.h.
* module.c (gfc_use_rename, gfc_get_use_rename): Moved to
gfortran.h.
(gfc_use_module): Chain the USE statement info to
ns->use_stmts.
(gfc_free_use_stmts): New function.
* symbol.c (gfc_free_namespace): Call gfc_free_use_stmts.
* trans.h (struct module_htab_entry): New type.
(gfc_find_module, gfc_module_add_decl): New functions.
* trans.c (gfc_generate_module_code): Create NAMESPACE_DECL for
the module, adjust DECL_CONTEXTs of module procedures and
call gfc_module_add_decl for them.
* trans-common.c (build_common_decl): Set DECL_IGNORED_P
on the common variable.
(create_common): Set DECL_IGNORED_P for use associated vars.
* trans-decl.c: Include debug.h.
(gfc_get_symbol_decl): Set DECL_IGNORED_P on use_assoc vars from
modules.
(build_function_decl): Allow current_function_decl's context
to be a NAMESPACE_DECL.
(module_htab, cur_module): New variables.
(module_htab_do_hash, module_htab_eq, module_htab_decls_hash,
module_htab_decls_eq, gfc_find_module, gfc_module_add_decl): New
functions.
(gfc_create_module_variable): Adjust DECL_CONTEXTs of module
variables and types and call gfc_module_add_decl for them.
(gfc_generate_module_vars): Temporarily set cur_module.
(gfc_trans_use_stmts): New function.
(gfc_generate_function_code): Call it.
(gfc_generate_block_data): Set DECL_IGNORED_P on decl.
* trans-types.c (gfc_get_derived_type): Adjust DECL_CONTEXT
and TYPE_CONTEXT of module derived types.
--- gcc/fortran/f95-lang.c.jj 2008-08-21 10:19:49.000000000 +0200
+++ gcc/fortran/f95-lang.c 2008-08-21 10:21:30.000000000 +0200
@@ -99,6 +99,7 @@ void insert_block (tree);
static void gfc_clear_binding_stack (void);
static void gfc_be_parse_file (int);
static alias_set_type gfc_get_alias_set (tree);
+static void gfc_init_ts (void);
#undef LANG_HOOKS_NAME
#undef LANG_HOOKS_INIT
@@ -113,6 +114,7 @@ static alias_set_type gfc_get_alias_set
#undef LANG_HOOKS_TYPE_FOR_SIZE
#undef LANG_HOOKS_CLEAR_BINDING_STACK
#undef LANG_HOOKS_GET_ALIAS_SET
+#undef LANG_HOOKS_INIT_TS
#undef LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE
#undef LANG_HOOKS_OMP_PREDETERMINED_SHARING
#undef LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR
@@ -140,6 +142,7 @@ static alias_set_type gfc_get_alias_set
#define LANG_HOOKS_TYPE_FOR_SIZE gfc_type_for_size
#define LANG_HOOKS_CLEAR_BINDING_STACK gfc_clear_binding_stack
#define LANG_HOOKS_GET_ALIAS_SET gfc_get_alias_set
+#define LANG_HOOKS_INIT_TS gfc_init_ts
#define LANG_HOOKS_OMP_PRIVATIZE_BY_REFERENCE gfc_omp_privatize_by_reference
#define LANG_HOOKS_OMP_PREDETERMINED_SHARING gfc_omp_predetermined_sharing
#define LANG_HOOKS_OMP_CLAUSE_DEFAULT_CTOR gfc_omp_clause_default_ctor
@@ -1184,5 +1187,15 @@ gfc_init_builtin_functions (void)
#undef DEFINE_MATH_BUILTIN_C
#undef DEFINE_MATH_BUILTIN
+static void
+gfc_init_ts (void)
+{
+ tree_contains_struct[NAMESPACE_DECL][TS_DECL_NON_COMMON] = 1;
+ tree_contains_struct[NAMESPACE_DECL][TS_DECL_WITH_VIS] = 1;
+ tree_contains_struct[NAMESPACE_DECL][TS_DECL_WRTL] = 1;
+ tree_contains_struct[NAMESPACE_DECL][TS_DECL_COMMON] = 1;
+ tree_contains_struct[NAMESPACE_DECL][TS_DECL_MINIMAL] = 1;
+}
+
#include "gt-fortran-f95-lang.h"
#include "gtype-fortran.h"
--- gcc/fortran/trans.c.jj 2008-08-21 10:19:49.000000000 +0200
+++ gcc/fortran/trans.c 2008-08-21 10:21:30.000000000 +0200
@@ -1209,6 +1209,19 @@ void
gfc_generate_module_code (gfc_namespace * ns)
{
gfc_namespace *n;
+ struct module_htab_entry *entry;
+
+ gcc_assert (ns->proc_name->backend_decl == NULL);
+ ns->proc_name->backend_decl
+ = build_decl (NAMESPACE_DECL, get_identifier (ns->proc_name->name),
+ void_type_node);
+ gfc_set_decl_location (ns->proc_name->backend_decl,
+ &ns->proc_name->declared_at);
+ entry = gfc_find_module (ns->proc_name->name);
+ if (entry->namespace_decl)
+ /* Buggy sourcecode, using a module before defining it? */
+ htab_empty (entry->decls);
+ entry->namespace_decl = ns->proc_name->backend_decl;
gfc_generate_module_vars (ns);
@@ -1216,10 +1229,21 @@ gfc_generate_module_code (gfc_namespace
sibling calls. */
for (n = ns->contained; n; n = n->sibling)
{
+ gfc_entry_list *el;
+
if (!n->proc_name)
continue;
gfc_create_function_decl (n);
+ gcc_assert (DECL_CONTEXT (n->proc_name->backend_decl) == NULL_TREE);
+ DECL_CONTEXT (n->proc_name->backend_decl) = ns->proc_name->backend_decl;
+ gfc_module_add_decl (entry, n->proc_name->backend_decl);
+ for (el = ns->entries; el; el = el->next)
+ {
+ gcc_assert (DECL_CONTEXT (el->sym->backend_decl) == NULL_TREE);
+ DECL_CONTEXT (el->sym->backend_decl) = ns->proc_name->backend_decl;
+ gfc_module_add_decl (entry, el->sym->backend_decl);
+ }
}
for (n = ns->contained; n; n = n->sibling)
--- gcc/fortran/module.c.jj 2008-08-21 10:19:49.000000000 +0200
+++ gcc/fortran/module.c 2008-08-21 10:21:30.000000000 +0200
@@ -161,20 +161,6 @@ pointer_info;
#define gfc_get_pointer_info() gfc_getmem(sizeof(pointer_info))
-/* Lists of rename info for the USE statement. */
-
-typedef struct gfc_use_rename
-{
- char local_name[GFC_MAX_SYMBOL_LEN + 1], use_name[GFC_MAX_SYMBOL_LEN + 1];
- struct gfc_use_rename *next;
- int found;
- gfc_intrinsic_op operator;
- locus where;
-}
-gfc_use_rename;
-
-#define gfc_get_use_rename() gfc_getmem(sizeof(gfc_use_rename))
-
/* Local variables */
/* The FILE for the module we're reading or writing. */
@@ -4749,6 +4735,7 @@ gfc_use_module (void)
gfc_state_data *p;
int c, line, start;
gfc_symtree *mod_symtree;
+ gfc_use_list *use_stmt;
filename = (char *) alloca (strlen (module_name) + strlen (MODULE_EXTENSION)
+ 1);
@@ -4841,6 +4828,33 @@ gfc_use_module (void)
pi_root = NULL;
fclose (module_fp);
+
+ use_stmt = gfc_get_use_list ();
+ use_stmt->module_name = gfc_get_string (module_name);
+ use_stmt->only_flag = only_flag;
+ use_stmt->rename = gfc_rename_list;
+ gfc_rename_list = NULL;
+ use_stmt->next = gfc_current_ns->use_stmts;
+ gfc_current_ns->use_stmts = use_stmt;
+}
+
+
+void
+gfc_free_use_stmts (gfc_use_list *use_stmts)
+{
+ gfc_use_list *next;
+ for (; use_stmts; use_stmts = next)
+ {
+ gfc_use_rename *next_rename;
+
+ for (; use_stmts->rename; use_stmts->rename = next_rename)
+ {
+ next_rename = use_stmts->rename->next;
+ gfc_free (use_stmts->rename);
+ }
+ next = use_stmts->next;
+ gfc_free (use_stmts);
+ }
}
--- gcc/fortran/Make-lang.in.jj 2008-08-21 10:19:49.000000000 +0200
+++ gcc/fortran/Make-lang.in 2008-08-21 10:21:30.000000000 +0200
@@ -310,7 +310,7 @@ fortran/convert.o: $(GFORTRAN_TRANS_DEPS
fortran/trans.o: $(GFORTRAN_TRANS_DEPS)
fortran/trans-decl.o: $(GFORTRAN_TRANS_DEPS) gt-fortran-trans-decl.h \
$(CGRAPH_H) $(TARGET_H) $(FUNCTION_H) $(FLAGS_H) $(RTL_H) $(TREE_GIMPLE_H) \
- $(TREE_DUMP_H)
+ $(TREE_DUMP_H) debug.h
fortran/trans-types.o: $(GFORTRAN_TRANS_DEPS) gt-fortran-trans-types.h \
$(REAL_H) toplev.h $(TARGET_H) $(FLAGS_H) dwarf2out.h
fortran/trans-const.o: $(GFORTRAN_TRANS_DEPS)
--- gcc/fortran/gfortran.h.jj 2008-08-21 10:19:49.000000000 +0200
+++ gcc/fortran/gfortran.h 2008-08-21 10:21:30.000000000 +0200
@@ -1093,6 +1093,35 @@ gfc_entry_list;
#define gfc_get_entry_list() \
(gfc_entry_list *) gfc_getmem(sizeof(gfc_entry_list))
+/* Lists of rename info for the USE statement. */
+
+typedef struct gfc_use_rename
+{
+ char local_name[GFC_MAX_SYMBOL_LEN + 1], use_name[GFC_MAX_SYMBOL_LEN + 1];
+ struct gfc_use_rename *next;
+ int found;
+ gfc_intrinsic_op operator;
+ locus where;
+}
+gfc_use_rename;
+
+#define gfc_get_use_rename() XCNEW (gfc_use_rename);
+
+/* A list of all USE statements in a namespace. */
+
+typedef struct gfc_use_list
+{
+ const char *module_name;
+ int only_flag;
+ struct gfc_use_rename *rename;
+ /* Next USE statement. */
+ struct gfc_use_list *next;
+}
+gfc_use_list;
+
+#define gfc_get_use_list() \
+ (gfc_use_list *) gfc_getmem(sizeof(gfc_use_list))
+
/* Within a namespace, symbols are pointed to by symtree nodes that
are linked together in a balanced binary tree. There can be
several symtrees pointing to the same symbol node via USE
@@ -1189,6 +1218,9 @@ typedef struct gfc_namespace
/* A list of all alternate entry points to this procedure (or NULL). */
gfc_entry_list *entries;
+ /* A list of USE statements in this namespace. */
+ gfc_use_list *use_stmts;
+
/* Set to 1 if namespace is a BLOCK DATA program unit. */
int is_block_data;
@@ -2340,6 +2372,7 @@ void gfc_module_init_2 (void);
void gfc_module_done_2 (void);
void gfc_dump_module (const char *, int);
bool gfc_check_access (gfc_access, gfc_access);
+void gfc_free_use_stmts (gfc_use_list *);
/* primary.c */
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)
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]);
--- 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
gfc_finish_type (typenode);
gfc_set_decl_location (TYPE_STUB_DECL (typenode), &derived->declared_at);
+ if (derived->module && derived->ns->proc_name->attr.flavor == FL_MODULE)
+ {
+ if (derived->ns->proc_name->backend_decl
+ && TREE_CODE (derived->ns->proc_name->backend_decl)
+ == NAMESPACE_DECL)
+ {
+ TYPE_CONTEXT (typenode) = derived->ns->proc_name->backend_decl;
+ DECL_CONTEXT (TYPE_STUB_DECL (typenode))
+ = derived->ns->proc_name->backend_decl;
+ }
+ }
derived->backend_decl = typenode;
- /* Add this backend_decl to all the other, equal derived types. */
- for (dt = gfc_derived_types; dt; dt = dt->next)
- copy_dt_decls_ifequal (derived, dt->derived);
+ /* Add this backend_decl to all the other, equal derived types. */
+ for (dt = gfc_derived_types; dt; dt = dt->next)
+ copy_dt_decls_ifequal (derived, dt->derived);
return derived->backend_decl;
}
--- gcc/fortran/trans.h.jj 2008-08-21 10:19:49.000000000 +0200
+++ gcc/fortran/trans.h 2008-08-21 10:21:30.000000000 +0200
@@ -429,6 +429,16 @@ void gfc_generate_block_data (gfc_namesp
/* Output a decl for a module variable. */
void gfc_generate_module_vars (gfc_namespace *);
+struct module_htab_entry GTY(())
+{
+ const char *name;
+ tree namespace_decl;
+ htab_t GTY ((param_is (union tree_node))) decls;
+};
+
+struct module_htab_entry *gfc_find_module (const char *);
+void gfc_module_add_decl (struct module_htab_entry *, tree);
+
/* Get and set the current location. */
void gfc_set_backend_locus (locus *);
void gfc_get_backend_locus (locus *);
--- gcc/fortran/trans-decl.c 2008-08-21 11:56:09.000000000 +0200
+++ gcc/fortran/trans-decl.c 2008-08-22 21:31:28.000000000 +0200
@@ -35,6 +35,7 @@ along with GCC; see the file COPYING3.
#include "function.h"
#include "flags.h"
#include "cgraph.h"
+#include "debug.h"
#include "gfortran.h"
#include "trans.h"
#include "trans-types.h"
@@ -982,7 +983,11 @@ gfc_get_symbol_decl (gfc_symbol * sym)
This is done here rather than in gfc_finish_var_decl because it
is different for string length variables. */
if (sym->module)
- SET_DECL_ASSEMBLER_NAME (decl, gfc_sym_mangled_identifier (sym));
+ {
+ SET_DECL_ASSEMBLER_NAME (decl, gfc_sym_mangled_identifier (sym));
+ if (sym->attr.use_assoc)
+ DECL_IGNORED_P (decl) = 1;
+ }
if (sym->attr.dimension)
{
@@ -1247,7 +1252,9 @@ build_function_decl (gfc_symbol * sym)
/* Allow only one nesting level. Allow public declarations. */
gcc_assert (current_function_decl == NULL_TREE
- || DECL_CONTEXT (current_function_decl) == NULL_TREE);
+ || DECL_CONTEXT (current_function_decl) == NULL_TREE
+ || TREE_CODE (DECL_CONTEXT (current_function_decl))
+ == NAMESPACE_DECL);
type = gfc_get_function_type (sym);
fndecl = build_decl (FUNCTION_DECL, gfc_sym_identifier (sym), type);
@@ -2790,6 +2797,88 @@ gfc_trans_deferred_vars (gfc_symbol * pr
return gfc_finish_block (&body);
}
+static GTY ((param_is (struct module_htab_entry))) htab_t module_htab;
+
+/* Hash and equality functions for module_htab. */
+
+static hashval_t
+module_htab_do_hash (const void *x)
+{
+ return htab_hash_string (((const struct module_htab_entry *)x)->name);
+}
+
+static int
+module_htab_eq (const void *x1, const void *x2)
+{
+ return strcmp ((((const struct module_htab_entry *)x1)->name),
+ (const char *)x2) == 0;
+}
+
+/* Hash and equality functions for module_htab's decls. */
+
+static hashval_t
+module_htab_decls_hash (const void *x)
+{
+ const_tree t = (const_tree) x;
+ const_tree n = DECL_NAME (t);
+ if (n == NULL_TREE)
+ n = TYPE_NAME (TREE_TYPE (t));
+ return htab_hash_string (IDENTIFIER_POINTER (n));
+}
+
+static int
+module_htab_decls_eq (const void *x1, const void *x2)
+{
+ const_tree t1 = (const_tree) x1;
+ const_tree n1 = DECL_NAME (t1);
+ if (n1 == NULL_TREE)
+ n1 = TYPE_NAME (TREE_TYPE (t1));
+ return strcmp (IDENTIFIER_POINTER (n1), (const char *) x2) == 0;
+}
+
+struct module_htab_entry *
+gfc_find_module (const char *name)
+{
+ void **slot;
+
+ if (! module_htab)
+ module_htab = htab_create_ggc (10, module_htab_do_hash,
+ module_htab_eq, NULL);
+
+ slot = htab_find_slot_with_hash (module_htab, name,
+ htab_hash_string (name), INSERT);
+ if (*slot == NULL)
+ {
+ struct module_htab_entry *entry = GGC_CNEW (struct module_htab_entry);
+
+ entry->name = gfc_get_string (name);
+ entry->decls = htab_create_ggc (10, module_htab_decls_hash,
+ module_htab_decls_eq, NULL);
+ *slot = (void *) entry;
+ }
+ return (struct module_htab_entry *) *slot;
+}
+
+void
+gfc_module_add_decl (struct module_htab_entry *entry, tree decl)
+{
+ void **slot;
+ const char *name;
+
+ if (DECL_NAME (decl))
+ name = IDENTIFIER_POINTER (DECL_NAME (decl));
+ else
+ {
+ gcc_assert (TREE_CODE (decl) == TYPE_DECL);
+ name = IDENTIFIER_POINTER (TYPE_NAME (TREE_TYPE (decl)));
+ }
+ slot = htab_find_slot_with_hash (entry->decls, name,
+ htab_hash_string (name), INSERT);
+ if (*slot == NULL)
+ *slot = (void *) decl;
+}
+
+static struct module_htab_entry *cur_module;
/* Output an initialized decl for a module variable. */
@@ -2809,6 +2898,22 @@ gfc_create_module_variable (gfc_symbol *
&& sym->ts.type == BT_DERIVED)
sym->backend_decl = gfc_typenode_for_spec (&(sym->ts));
+ if (sym->attr.flavor == FL_DERIVED
+ && sym->backend_decl
+ && TREE_CODE (sym->backend_decl) == RECORD_TYPE)
+ {
+ decl = sym->backend_decl;
+ gcc_assert (sym->ns->proc_name->attr.flavor == FL_MODULE);
+ gcc_assert (TYPE_CONTEXT (decl) == NULL_TREE
+ || TYPE_CONTEXT (decl) == sym->ns->proc_name->backend_decl);
+ gcc_assert (DECL_CONTEXT (TYPE_STUB_DECL (decl)) == NULL_TREE
+ || DECL_CONTEXT (TYPE_STUB_DECL (decl))
+ == sym->ns->proc_name->backend_decl);
+ TYPE_CONTEXT (decl) = sym->ns->proc_name->backend_decl;
+ DECL_CONTEXT (TYPE_STUB_DECL (decl)) = sym->ns->proc_name->backend_decl;
+ gfc_module_add_decl (cur_module, TYPE_STUB_DECL (decl));
+ }
+
/* Only output variables and array valued, or derived type,
parameters. */
if (sym->attr.flavor != FL_VARIABLE
@@ -2816,6 +2921,15 @@ gfc_create_module_variable (gfc_symbol *
&& (sym->attr.dimension || sym->ts.type == BT_DERIVED)))
return;
+ if ((sym->attr.in_common || sym->attr.in_equivalence) && sym->backend_decl)
+ {
+ decl = sym->backend_decl;
+ gcc_assert (DECL_CONTEXT (decl) == NULL_TREE);
+ gcc_assert (sym->ns->proc_name->attr.flavor == FL_MODULE);
+ DECL_CONTEXT (decl) = sym->ns->proc_name->backend_decl;
+ gfc_module_add_decl (cur_module, decl);
+ }
+
/* Don't generate variables from other modules. Variables from
COMMONs will already have been generated. */
if (sym->attr.use_assoc || sym->attr.in_common)
@@ -2823,8 +2937,8 @@ gfc_create_module_variable (gfc_symbol *
/* Equivalenced variables arrive here after creation. */
if (sym->backend_decl
- && (sym->equiv_built || sym->attr.in_equivalence))
- return;
+ && (sym->equiv_built || sym->attr.in_equivalence))
+ return;
if (sym->backend_decl)
internal_error ("backend decl for module variable %s already exists",
@@ -2837,7 +2951,11 @@ gfc_create_module_variable (gfc_symbol *
/* Create the variable. */
pushdecl (decl);
+ gcc_assert (DECL_CONTEXT (decl) == NULL_TREE);
+ gcc_assert (sym->ns->proc_name->attr.flavor == FL_MODULE);
+ DECL_CONTEXT (decl) = sym->ns->proc_name->backend_decl;
rest_of_decl_compilation (decl, 1, 0);
+ gfc_module_add_decl (cur_module, decl);
/* Also add length of strings. */
if (sym->ts.type == BT_CHARACTER)
@@ -2860,6 +2978,7 @@ 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);
@@ -2869,6 +2988,79 @@ gfc_generate_module_vars (gfc_namespace
/* Create decls for all the module variables. */
gfc_traverse_ns (ns, gfc_create_module_variable);
+
+ cur_module = NULL;
+}
+
+static void
+gfc_trans_use_stmts (gfc_namespace * ns)
+{
+ gfc_use_list *use_stmt;
+ for (use_stmt = ns->use_stmts; use_stmt; use_stmt = use_stmt->next)
+ {
+ struct module_htab_entry *entry
+ = gfc_find_module (use_stmt->module_name);
+ gfc_use_rename *rent;
+
+ if (entry->namespace_decl == NULL)
+ {
+ entry->namespace_decl
+ = build_decl (NAMESPACE_DECL,
+ get_identifier (use_stmt->module_name),
+ void_type_node);
+ DECL_EXTERNAL (entry->namespace_decl) = 1;
+ }
+ if (!use_stmt->only_flag)
+ (*debug_hooks->imported_module_or_decl) (entry->namespace_decl,
+ NULL_TREE,
+ ns->proc_name->backend_decl,
+ false);
+ for (rent = use_stmt->rename; rent; rent = rent->next)
+ {
+ tree decl, local_name;
+ void **slot;
+
+ if (rent->operator != INTRINSIC_NONE)
+ continue;
+
+ slot = htab_find_slot_with_hash (entry->decls, rent->use_name,
+ htab_hash_string (rent->use_name),
+ INSERT);
+ if (*slot == NULL)
+ {
+ gfc_symtree *st;
+
+ st = gfc_find_symtree (ns->sym_root,
+ 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))
+ {
+ gcc_assert (DECL_EXTERNAL (entry->namespace_decl));
+ decl = copy_node (st->n.sym->backend_decl);
+ DECL_CONTEXT (decl) = entry->namespace_decl;
+ DECL_EXTERNAL (decl) = 1;
+ DECL_IGNORED_P (decl) = 0;
+ DECL_INITIAL (decl) = NULL_TREE;
+ }
+ else
+ {
+ *slot = error_mark_node;
+ htab_clear_slot (entry->decls, slot);
+ continue;
+ }
+ *slot = decl;
+ }
+ decl = (tree) *slot;
+ if (rent->local_name[0])
+ local_name = get_identifier (rent->local_name);
+ else
+ local_name = NULL_TREE;
+ (*debug_hooks->imported_module_or_decl) (decl, local_name,
+ ns->proc_name->backend_decl,
+ !use_stmt->only_flag);
+ }
+ }
}
static void
@@ -3373,6 +3567,8 @@ gfc_generate_function_code (gfc_namespac
gfc_gimplify_function (fndecl);
cgraph_finalize_function (fndecl, false);
}
+
+ gfc_trans_use_stmts (ns);
}
void
@@ -3464,6 +3660,7 @@ gfc_generate_block_data (gfc_namespace *
decl = build_decl (VAR_DECL, id, gfc_array_index_type);
TREE_PUBLIC (decl) = 1;
TREE_STATIC (decl) = 1;
+ DECL_IGNORED_P (decl) = 1;
pushdecl (decl);
rest_of_decl_compilation (decl, 1, 0);
--- gcc/fortran/trans-common.c.jj 2008-08-21 10:19:49.000000000 +0200
+++ gcc/fortran/trans-common.c 2008-08-21 10:21:30.000000000 +0200
@@ -416,6 +416,7 @@ build_common_decl (gfc_common_head *com,
SET_DECL_ASSEMBLER_NAME (decl, gfc_sym_mangled_common_id (com));
TREE_PUBLIC (decl) = 1;
TREE_STATIC (decl) = 1;
+ DECL_IGNORED_P (decl) = 1;
if (!com->is_bind_c)
DECL_ALIGN (decl) = BIGGEST_ALIGNMENT;
else
@@ -680,6 +681,8 @@ create_common (gfc_common_head *com, seg
TREE_PUBLIC (var_decl) = TREE_PUBLIC (decl);
TREE_STATIC (var_decl) = TREE_STATIC (decl);
TREE_USED (var_decl) = TREE_USED (decl);
+ if (s->sym->attr.use_assoc)
+ DECL_IGNORED_P (var_decl) = 1;
if (s->sym->attr.target)
TREE_ADDRESSABLE (var_decl) = 1;
/* This is a fake variable just for debugging purposes. */
--- gcc/cp/name-lookup.c.jj 2008-08-21 10:19:52.000000000 +0200
+++ gcc/cp/name-lookup.c 2008-08-21 10:21:30.000000000 +0200
@@ -3401,7 +3401,8 @@ do_using_directive (tree namespace)
/* Emit debugging info. */
if (!processing_template_decl)
- (*debug_hooks->imported_module_or_decl) (namespace, context);
+ (*debug_hooks->imported_module_or_decl) (namespace, NULL_TREE,
+ context, false);
}
/* Deal with a using-directive seen by the parser. Currently we only
@@ -5234,7 +5235,7 @@ cp_emit_debug_info_for_using (tree t, tr
/* FIXME: Handle TEMPLATE_DECLs. */
for (t = OVL_CURRENT (t); t; t = OVL_NEXT (t))
if (TREE_CODE (t) != TEMPLATE_DECL)
- (*debug_hooks->imported_module_or_decl) (t, context);
+ (*debug_hooks->imported_module_or_decl) (t, NULL_TREE, context, false);
}
#include "gt-cp-name-lookup.h"
--- gcc/debug.h.jj 2008-08-21 10:19:49.000000000 +0200
+++ gcc/debug.h 2008-08-21 10:21:30.000000000 +0200
@@ -98,7 +98,8 @@ struct gcc_debug_hooks
void (* type_decl) (tree decl, int local);
/* Debug information for imported modules and declarations. */
- void (* imported_module_or_decl) (tree decl, tree context);
+ void (* imported_module_or_decl) (tree decl, tree name,
+ tree context, bool child);
/* DECL is an inline function, whose body is present, but which is
not being output at this point. */
@@ -139,7 +140,7 @@ extern void debug_nothing_int (unsigned
extern void debug_nothing_int_int (unsigned int, unsigned int);
extern void debug_nothing_tree (tree);
extern void debug_nothing_tree_int (tree, int);
-extern void debug_nothing_tree_tree (tree, tree);
+extern void debug_nothing_tree_tree_tree_bool (tree, tree, tree, bool);
extern bool debug_true_const_tree (const_tree);
extern void debug_nothing_rtx (rtx);
--- gcc/vmsdbgout.c.jj 2008-08-21 10:19:48.000000000 +0200
+++ gcc/vmsdbgout.c 2008-08-21 10:21:30.000000000 +0200
@@ -204,7 +204,7 @@ const struct gcc_debug_hooks vmsdbg_debu
vmsdbgout_decl,
vmsdbgout_global_decl,
debug_nothing_tree_int, /* type_decl */
- debug_nothing_tree_tree, /* imported_module_or_decl */
+ debug_nothing_tree_tree_tree_bool, /* imported_module_or_decl */
debug_nothing_tree, /* deferred_inline_function */
vmsdbgout_abstract_function,
debug_nothing_rtx, /* label */
--- gcc/dbxout.c.jj 2008-08-21 10:19:49.000000000 +0200
+++ gcc/dbxout.c 2008-08-21 10:21:30.000000000 +0200
@@ -369,7 +369,7 @@ const struct gcc_debug_hooks dbx_debug_h
dbxout_function_decl,
dbxout_global_decl, /* global_decl */
dbxout_type_decl, /* type_decl */
- debug_nothing_tree_tree, /* imported_module_or_decl */
+ debug_nothing_tree_tree_tree_bool, /* imported_module_or_decl */
debug_nothing_tree, /* deferred_inline_function */
debug_nothing_tree, /* outlining_inline_function */
debug_nothing_rtx, /* label */
@@ -401,7 +401,7 @@ const struct gcc_debug_hooks xcoff_debug
debug_nothing_tree, /* function_decl */
dbxout_global_decl, /* global_decl */
dbxout_type_decl, /* type_decl */
- debug_nothing_tree_tree, /* imported_module_or_decl */
+ debug_nothing_tree_tree_tree_bool, /* imported_module_or_decl */
debug_nothing_tree, /* deferred_inline_function */
debug_nothing_tree, /* outlining_inline_function */
debug_nothing_rtx, /* label */
--- gcc/debug.c.jj 2008-08-21 10:19:49.000000000 +0200
+++ gcc/debug.c 2008-08-21 10:21:30.000000000 +0200
@@ -42,7 +42,7 @@ const struct gcc_debug_hooks do_nothing_
debug_nothing_tree, /* function_decl */
debug_nothing_tree, /* global_decl */
debug_nothing_tree_int, /* type_decl */
- debug_nothing_tree_tree, /* imported_module_or_decl */
+ debug_nothing_tree_tree_tree_bool, /* imported_module_or_decl */
debug_nothing_tree, /* deferred_inline_function */
debug_nothing_tree, /* outlining_inline_function */
debug_nothing_rtx, /* label */
@@ -66,8 +66,10 @@ debug_nothing_tree (tree decl ATTRIBUTE_
}
void
-debug_nothing_tree_tree (tree t1 ATTRIBUTE_UNUSED,
- tree t2 ATTRIBUTE_UNUSED)
+debug_nothing_tree_tree_tree_bool (tree t1 ATTRIBUTE_UNUSED,
+ tree t2 ATTRIBUTE_UNUSED,
+ tree t3 ATTRIBUTE_UNUSED,
+ bool b1 ATTRIBUTE_UNUSED)
{
}
--- gcc/dwarf2out.c.jj 2008-08-21 10:19:49.000000000 +0200
+++ gcc/dwarf2out.c 2008-08-21 13:15:41.000000000 +0200
@@ -3910,7 +3910,7 @@ static void dwarf2out_end_block (unsigne
static bool dwarf2out_ignore_block (const_tree);
static void dwarf2out_global_decl (tree);
static void dwarf2out_type_decl (tree, int);
-static void dwarf2out_imported_module_or_decl (tree, tree);
+static void dwarf2out_imported_module_or_decl (tree, tree, tree, bool);
static void dwarf2out_abstract_function (tree);
static void dwarf2out_var_location (rtx);
static void dwarf2out_begin_function (tree);
@@ -4541,7 +4541,7 @@ static void gen_decl_die (tree, dw_die_r
static dw_die_ref force_decl_die (tree);
static dw_die_ref force_type_die (tree);
static dw_die_ref setup_namespace_context (tree, dw_die_ref);
-static void declare_in_namespace (tree, dw_die_ref);
+static dw_die_ref declare_in_namespace (tree, dw_die_ref);
static struct dwarf_file_data * lookup_filename (const char *);
static void retry_incomplete_types (void);
static void gen_type_die_for_member (tree, tree, dw_die_ref);
@@ -6621,7 +6621,8 @@ is_symbol_die (dw_die_ref c)
return (is_type_die (c)
|| (get_AT (c, DW_AT_declaration)
&& !get_AT (c, DW_AT_specification))
- || c->die_tag == DW_TAG_namespace);
+ || c->die_tag == DW_TAG_namespace
+ || c->die_tag == DW_TAG_module);
}
static char *
@@ -12898,29 +12899,49 @@ gen_variable_die (tree decl, dw_die_ref
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. */
+ of a data member. */
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);
+ if (lookup_decl_die (decl))
+ return;
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);
+ var_die = lookup_decl_die (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);
+ 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)
+ {
+ 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);
+ }
+ }
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? */
+ equate_decl_number_to_die (decl, com_die);
return;
}
@@ -13685,7 +13706,7 @@ gen_type_die_with_usage (tree type, dw_d
}
else
{
- declare_in_namespace (type, context_die);
+ context_die = declare_in_namespace (type, context_die);
need_pop = 0;
}
@@ -14057,29 +14078,32 @@ setup_namespace_context (tree thing, dw_
For compatibility with older debuggers, namespace DIEs only contain
declarations; all definitions are emitted at CU scope. */
-static void
+static dw_die_ref
declare_in_namespace (tree thing, dw_die_ref context_die)
{
dw_die_ref ns_context;
if (debug_info_level <= DINFO_LEVEL_TERSE)
- return;
+ return context_die;
/* If this decl is from an inlined function, then don't try to emit it in its
namespace, as we will get confused. It would have already been emitted
when the abstract instance of the inline function was emitted anyways. */
if (DECL_P (thing) && DECL_ABSTRACT_ORIGIN (thing))
- return;
+ return context_die;
ns_context = setup_namespace_context (thing, context_die);
if (ns_context != context_die)
{
+ if (is_fortran ())
+ return ns_context;
if (DECL_P (thing))
gen_decl_die (thing, ns_context);
else
gen_type_die (thing, ns_context);
}
+ return context_die;
}
/* Generate a DIE for a namespace or namespace alias. */
@@ -14095,8 +14119,11 @@ gen_namespace_die (tree decl)
{
/* Output a real namespace. */
dw_die_ref namespace_die
- = new_die (DW_TAG_namespace, context_die, decl);
+ = new_die (is_fortran () ? DW_TAG_module : DW_TAG_namespace,
+ context_die, decl);
add_name_and_src_coords_attributes (namespace_die, decl);
+ if (DECL_EXTERNAL (decl))
+ add_AT_flag (namespace_die, DW_AT_declaration, 1);
equate_decl_number_to_die (decl, namespace_die);
}
else
@@ -14186,7 +14213,7 @@ gen_decl_die (tree decl, dw_die_ref cont
gen_type_die_for_member (origin, decl, context_die);
/* And its containing namespace. */
- declare_in_namespace (decl, context_die);
+ context_die = declare_in_namespace (decl, context_die);
}
/* Now output a DIE to represent the function itself. */
@@ -14231,16 +14258,6 @@ 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))
@@ -14254,7 +14271,7 @@ gen_decl_die (tree decl, dw_die_ref cont
gen_type_die_for_member (origin, decl, context_die);
/* And its containing namespace. */
- declare_in_namespace (decl, context_die);
+ context_die = declare_in_namespace (decl, context_die);
/* Now output the DIE to represent the data object itself. This gets
complicated because of the possibility that the VAR_DECL really
@@ -14307,15 +14324,7 @@ 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.
-
- 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;
-
+ definitions which have not yet been forced out. */
if (TREE_CODE (decl) != FUNCTION_DECL || !DECL_INITIAL (decl))
dwarf2out_decl (decl);
}
@@ -14329,10 +14338,14 @@ dwarf2out_type_decl (tree decl, int loca
dwarf2out_decl (decl);
}
-/* Output debug information for imported module or decl. */
+/* Output debug information for imported module or decl DECL.
+ NAME is non-NULL name in context if the decl has been renamed.
+ CHILD is true if decl is one of the renamed decls as part of
+ importing whole module. */
static void
-dwarf2out_imported_module_or_decl (tree decl, tree context)
+dwarf2out_imported_module_or_decl (tree decl, tree name, tree context,
+ bool child)
{
dw_die_ref imported_die, at_import_die;
dw_die_ref scope_die;
@@ -14355,6 +14368,14 @@ dwarf2out_imported_module_or_decl (tree
return;
scope_die = get_context_die (context);
+ if (child)
+ {
+ gcc_assert (scope_die->die_child);
+ gcc_assert (scope_die->die_child->die_tag == DW_TAG_imported_module);
+ gcc_assert (TREE_CODE (decl) != NAMESPACE_DECL);
+ scope_die = scope_die->die_child;
+ }
+
/* For TYPE_DECL or CONST_DECL, lookup TREE_TYPE. */
if (TREE_CODE (decl) == TYPE_DECL || TREE_CODE (decl) == CONST_DECL)
{
@@ -14405,6 +14426,8 @@ dwarf2out_imported_module_or_decl (tree
xloc = expand_location (input_location);
add_AT_file (imported_die, DW_AT_decl_file, lookup_filename (xloc.file));
add_AT_unsigned (imported_die, DW_AT_decl_line, xloc.line);
+ if (name)
+ add_AT_string (imported_die, DW_AT_name, IDENTIFIER_POINTER (name));
add_AT_die_ref (imported_die, DW_AT_import, at_import_die);
}
--- gcc/sdbout.c.jj 2008-08-21 10:19:49.000000000 +0200
+++ gcc/sdbout.c 2008-08-21 10:21:30.000000000 +0200
@@ -329,7 +329,7 @@ const struct gcc_debug_hooks sdb_debug_h
debug_nothing_tree, /* function_decl */
sdbout_global_decl, /* global_decl */
sdbout_symbol, /* type_decl */
- debug_nothing_tree_tree, /* imported_module_or_decl */
+ debug_nothing_tree_tree_tree_bool, /* imported_module_or_decl */
debug_nothing_tree, /* deferred_inline_function */
debug_nothing_tree, /* outlining_inline_function */
sdbout_label, /* label */
gcc43-fortran-debug3.patch:
--- NEW FILE gcc43-fortran-debug3.patch ---
2008-08-21 Jakub Jelinek <jakub at 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;
}
gcc43-fortran-debug4.patch:
--- NEW FILE gcc43-fortran-debug4.patch ---
2008-08-22 Jakub Jelinek <jakub at 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" } }
gcc43-fortran-debug5.patch:
--- NEW FILE gcc43-fortran-debug5.patch ---
2008-08-22 Jakub Jelinek <jakub at 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;
}
gcc43-fortran-debug6.patch:
--- NEW FILE gcc43-fortran-debug6.patch ---
2008-08-22 Jakub Jelinek <jakub at 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);
gcc43-fortran-debug7.patch:
--- NEW FILE gcc43-fortran-debug7.patch ---
2008-08-22 Jakub Jelinek <jakub at 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
gcc43-fortran-debug8.patch:
--- NEW FILE gcc43-fortran-debug8.patch ---
2008-08-22 Jakub Jelinek <jakub at 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);
gcc43-fortran-debug9.patch:
--- NEW FILE gcc43-fortran-debug9.patch ---
2008-08-25 Jakub Jelinek <jakub at 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)
{
Index: .cvsignore
===================================================================
RCS file: /cvs/pkgs/rpms/gcc/devel/.cvsignore,v
retrieving revision 1.240
retrieving revision 1.241
diff -u -r1.240 -r1.241
--- .cvsignore 12 Aug 2008 19:35:02 -0000 1.240
+++ .cvsignore 25 Aug 2008 12:07:40 -0000 1.241
@@ -1,2 +1,2 @@
-gcc-4.3.1-20080812.tar.bz2
+gcc-4.3.1-20080825.tar.bz2
fastjar-0.95.tar.gz
Index: gcc43.spec
===================================================================
RCS file: /cvs/pkgs/rpms/gcc/devel/gcc43.spec,v
retrieving revision 1.38
retrieving revision 1.39
diff -u -r1.38 -r1.39
--- gcc43.spec 14 Aug 2008 07:10:39 -0000 1.38
+++ gcc43.spec 25 Aug 2008 12:07:40 -0000 1.39
@@ -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 @@
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 @@
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 @@
%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 @@
%doc rpm.doc/changelogs/libmudflap/ChangeLog*
%changelog
+* Mon Aug 25 2008 Jakub Jelinek <jakub at 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 at redhat.com> 4.3.1-7
- update from gcc-4_3-branch
- PRs bootstrap/35752, c++/36688, c++/36999, c++/37016, c/35746,
Index: sources
===================================================================
RCS file: /cvs/pkgs/rpms/gcc/devel/sources,v
retrieving revision 1.243
retrieving revision 1.244
diff -u -r1.243 -r1.244
--- sources 12 Aug 2008 19:35:02 -0000 1.243
+++ sources 25 Aug 2008 12:07:40 -0000 1.244
@@ -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
--- gcc43-pr37103.patch DELETED ---
More information about the fedora-extras-commits
mailing list