aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJakub Jelinek <jakub@redhat.com>2008-08-29 20:41:19 +0200
committerJakub Jelinek <jakub@gcc.gnu.org>2008-08-29 20:41:19 +0200
commita64f5186dd1a3ea27bc7540c625ab24afd8030a3 (patch)
treeb8ebe79cda960c2d7a984748713c834f78fc8847
parentca30a5396af8e55bb19746eeb323de7064da6c46 (diff)
downloadgcc-a64f5186dd1a3ea27bc7540c625ab24afd8030a3.zip
gcc-a64f5186dd1a3ea27bc7540c625ab24afd8030a3.tar.gz
gcc-a64f5186dd1a3ea27bc7540c625ab24afd8030a3.tar.bz2
re PR fortran/29635 (debug info of modules)
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. From-SVN: r139773
-rw-r--r--gcc/ChangeLog31
-rw-r--r--gcc/cp/ChangeLog7
-rw-r--r--gcc/cp/name-lookup.c5
-rw-r--r--gcc/dbxout.c4
-rw-r--r--gcc/debug.c8
-rw-r--r--gcc/debug.h5
-rw-r--r--gcc/dwarf2out.c107
-rw-r--r--gcc/fortran/ChangeLog45
-rw-r--r--gcc/fortran/Make-lang.in2
-rw-r--r--gcc/fortran/f95-lang.c21
-rw-r--r--gcc/fortran/gfortran.h33
-rw-r--r--gcc/fortran/module.c42
-rw-r--r--gcc/fortran/symbol.c1
-rw-r--r--gcc/fortran/trans-common.c3
-rw-r--r--gcc/fortran/trans-decl.c203
-rw-r--r--gcc/fortran/trans-types.c17
-rw-r--r--gcc/fortran/trans.c24
-rw-r--r--gcc/fortran/trans.h10
-rw-r--r--gcc/sdbout.c2
-rw-r--r--gcc/vmsdbgout.c2
20 files changed, 493 insertions, 79 deletions
diff --git a/gcc/ChangeLog b/gcc/ChangeLog
index a808305d..2bed3cd 100644
--- a/gcc/ChangeLog
+++ b/gcc/ChangeLog
@@ -1,3 +1,34 @@
+2008-08-29 Jakub Jelinek <jakub@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.
+
2008-08-29 Jan Hubicka <jh@suse.cz>
* cgraph.c (cgraph_remove_node): Do not remove nested nodes.
diff --git a/gcc/cp/ChangeLog b/gcc/cp/ChangeLog
index 4952399..0020274 100644
--- a/gcc/cp/ChangeLog
+++ b/gcc/cp/ChangeLog
@@ -1,3 +1,10 @@
+2008-08-29 Jakub Jelinek <jakub@redhat.com>
+
+ PR fortran/29635
+ PR fortran/23057
+ * name-lookup.c (do_using_directive, cp_emit_debug_info_for_using):
+ Adjust debug_hooks->imported_module_or_decl callers.
+
2008-08-29 Jan Hubicka <jh@suse.cz>
* cp-gimplify.c (cp_gimplify_expr): Add PRED_CONTINUE heuristic.
diff --git a/gcc/cp/name-lookup.c b/gcc/cp/name-lookup.c
index 727258a..7fc6a93 100644
--- a/gcc/cp/name-lookup.c
+++ b/gcc/cp/name-lookup.c
@@ -3490,7 +3490,8 @@ do_using_directive (tree name_space)
/* Emit debugging info. */
if (!processing_template_decl)
- (*debug_hooks->imported_module_or_decl) (name_space, context);
+ (*debug_hooks->imported_module_or_decl) (name_space, NULL_TREE,
+ context, false);
}
/* Deal with a using-directive seen by the parser. Currently we only
@@ -5327,7 +5328,7 @@ cp_emit_debug_info_for_using (tree t, tree context)
/* 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"
diff --git a/gcc/dbxout.c b/gcc/dbxout.c
index 2843f9c..68cf28e 100644
--- a/gcc/dbxout.c
+++ b/gcc/dbxout.c
@@ -369,7 +369,7 @@ const struct gcc_debug_hooks dbx_debug_hooks =
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_hooks =
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 */
diff --git a/gcc/debug.c b/gcc/debug.c
index 12a726f..84fc2df 100644
--- a/gcc/debug.c
+++ b/gcc/debug.c
@@ -42,7 +42,7 @@ const struct gcc_debug_hooks do_nothing_debug_hooks =
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_UNUSED)
}
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)
{
}
diff --git a/gcc/debug.h b/gcc/debug.h
index 6cdf786..956ad0c 100644
--- a/gcc/debug.h
+++ b/gcc/debug.h
@@ -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 int);
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);
diff --git a/gcc/dwarf2out.c b/gcc/dwarf2out.c
index 5e29af8..cc27e39 100644
--- a/gcc/dwarf2out.c
+++ b/gcc/dwarf2out.c
@@ -4485,7 +4485,7 @@ static void dwarf2out_end_block (unsigned, unsigned);
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);
@@ -5115,7 +5115,7 @@ static void gen_decl_die (tree, dw_die_ref);
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);
@@ -7196,7 +7196,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 *
@@ -13519,29 +13520,49 @@ gen_variable_die (tree decl, dw_die_ref 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. */
+ 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;
}
@@ -14306,7 +14327,7 @@ gen_type_die_with_usage (tree type, dw_die_ref context_die,
}
else
{
- declare_in_namespace (type, context_die);
+ context_die = declare_in_namespace (type, context_die);
need_pop = 0;
}
@@ -14678,29 +14699,32 @@ setup_namespace_context (tree thing, dw_die_ref context_die)
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. */
@@ -14716,8 +14740,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
@@ -14807,7 +14834,7 @@ gen_decl_die (tree decl, dw_die_ref context_die)
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. */
@@ -14852,16 +14879,6 @@ gen_decl_die (tree decl, dw_die_ref context_die)
if (debug_info_level <= DINFO_LEVEL_TERSE)
break;
- /* If this is the global definition of the Fortran COMMON block, we don't
- need to do anything. Syntactically, the block itself has no identity,
- just its constituent identifiers. */
- if (TREE_CODE (decl) == VAR_DECL
- && TREE_PUBLIC (decl)
- && TREE_STATIC (decl)
- && is_fortran ()
- && !DECL_HAS_VALUE_EXPR_P (decl))
- break;
-
/* Output any DIEs that are needed to specify the type of this data
object. */
if (TREE_CODE (decl) == RESULT_DECL && DECL_BY_REFERENCE (decl))
@@ -14875,7 +14892,7 @@ gen_decl_die (tree decl, dw_die_ref context_die)
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
@@ -14928,15 +14945,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;
-
+ and definitions which have not yet been forced out. */
if (TREE_CODE (decl) != FUNCTION_DECL || !DECL_INITIAL (decl))
dwarf2out_decl (decl);
}
@@ -14950,10 +14959,14 @@ dwarf2out_type_decl (tree decl, int local)
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;
@@ -14976,6 +14989,14 @@ dwarf2out_imported_module_or_decl (tree decl, tree context)
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)
{
@@ -15026,6 +15047,8 @@ dwarf2out_imported_module_or_decl (tree decl, tree context)
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);
}
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e6b1866..a1a72e6 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,48 @@
+2008-08-29 Jakub Jelinek <jakub@redhat.com>
+
+ PR fortran/29635
+ PR fortran/23057
+ * 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.
+
2008-08-28 Daniel Kraft <d@domob.eu>
* gfortran.h (enum expr_t): New value `EXPR_COMPCALL'.
diff --git a/gcc/fortran/Make-lang.in b/gcc/fortran/Make-lang.in
index 20ac249..255f07e 100644
--- a/gcc/fortran/Make-lang.in
+++ b/gcc/fortran/Make-lang.in
@@ -314,7 +314,7 @@ fortran/convert.o: $(GFORTRAN_TRANS_DEPS)
fortran/trans.o: $(GFORTRAN_TRANS_DEPS) tree-iterator.h
fortran/trans-decl.o: $(GFORTRAN_TRANS_DEPS) gt-fortran-trans-decl.h \
$(CGRAPH_H) $(TARGET_H) $(FUNCTION_H) $(FLAGS_H) $(RTL_H) $(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)
diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.c
index 82da3b1..30cc98e 100644
--- a/gcc/fortran/f95-lang.c
+++ b/gcc/fortran/f95-lang.c
@@ -99,6 +99,7 @@ int global_bindings_p (void);
static void 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
@@ -112,6 +113,7 @@ static alias_set_type gfc_get_alias_set (tree);
#undef LANG_HOOKS_TYPE_FOR_MODE
#undef LANG_HOOKS_TYPE_FOR_SIZE
#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
@@ -134,10 +136,11 @@ static alias_set_type gfc_get_alias_set (tree);
#define LANG_HOOKS_POST_OPTIONS gfc_post_options
#define LANG_HOOKS_PRINT_IDENTIFIER gfc_print_identifier
#define LANG_HOOKS_PARSE_FILE gfc_be_parse_file
-#define LANG_HOOKS_MARK_ADDRESSABLE gfc_mark_addressable
-#define LANG_HOOKS_TYPE_FOR_MODE gfc_type_for_mode
-#define LANG_HOOKS_TYPE_FOR_SIZE gfc_type_for_size
-#define LANG_HOOKS_GET_ALIAS_SET gfc_get_alias_set
+#define LANG_HOOKS_MARK_ADDRESSABLE gfc_mark_addressable
+#define LANG_HOOKS_TYPE_FOR_MODE gfc_type_for_mode
+#define LANG_HOOKS_TYPE_FOR_SIZE gfc_type_for_size
+#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
@@ -1189,5 +1192,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"
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 386668d..81e48b7 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1132,6 +1132,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 op;
+ 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
@@ -1232,6 +1261,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;
@@ -2472,6 +2504,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 *);
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 4cbaaa0..b67b878 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -162,20 +162,6 @@ pointer_info;
#define gfc_get_pointer_info() XCNEW (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 op;
- locus where;
-}
-gfc_use_rename;
-
-#define gfc_get_use_rename() XCNEW (gfc_use_rename);
-
/* Local variables */
/* The FILE for the module we're reading or writing. */
@@ -5058,6 +5044,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);
@@ -5150,6 +5137,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);
+ }
}
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 0b202eb..41e8006 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -3023,6 +3023,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]);
diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c
index 8c30309..9e55792 100644
--- a/gcc/fortran/trans-common.c
+++ b/gcc/fortran/trans-common.c
@@ -416,6 +416,7 @@ build_common_decl (gfc_common_head *com, tree union_type, bool is_init)
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, segment_info *head, bool saw_equiv)
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. */
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 1dfa05c..59b33ca 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -35,6 +35,7 @@ along with GCC; see the file COPYING3. If not see
#include "function.h"
#include "flags.h"
#include "cgraph.h"
+#include "debug.h"
#include "gfortran.h"
#include "trans.h"
#include "trans-types.h"
@@ -994,7 +995,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)
{
@@ -1300,7 +1305,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);
@@ -2922,6 +2929,88 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, tree fnbody)
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. */
@@ -2941,6 +3030,22 @@ gfc_create_module_variable (gfc_symbol * sym)
&& 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
@@ -2948,6 +3053,15 @@ gfc_create_module_variable (gfc_symbol * sym)
&& (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)
@@ -2955,8 +3069,8 @@ gfc_create_module_variable (gfc_symbol * sym)
/* 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",
@@ -2969,7 +3083,11 @@ gfc_create_module_variable (gfc_symbol * sym)
/* 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)
@@ -2992,6 +3110,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);
@@ -3001,6 +3120,79 @@ gfc_generate_module_vars (gfc_namespace * ns)
/* 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->op != 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
@@ -3533,6 +3725,8 @@ gfc_generate_function_code (gfc_namespace * ns)
gfc_gimplify_function (fndecl);
cgraph_finalize_function (fndecl, false);
}
+
+ gfc_trans_use_stmts (ns);
}
void
@@ -3624,6 +3818,7 @@ gfc_generate_block_data (gfc_namespace * ns)
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);
diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.c
index 49ab6a4..dbda199 100644
--- a/gcc/fortran/trans-types.c
+++ b/gcc/fortran/trans-types.c
@@ -1934,12 +1934,23 @@ gfc_get_derived_type (gfc_symbol * derived)
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;
}
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 911e379..1b115f4 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -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 * ns)
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)
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 6e09f24..290c92b 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -429,6 +429,16 @@ void gfc_generate_block_data (gfc_namespace *);
/* 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 *);
diff --git a/gcc/sdbout.c b/gcc/sdbout.c
index 8836a97..e6f14fa 100644
--- a/gcc/sdbout.c
+++ b/gcc/sdbout.c
@@ -329,7 +329,7 @@ const struct gcc_debug_hooks sdb_debug_hooks =
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 */
diff --git a/gcc/vmsdbgout.c b/gcc/vmsdbgout.c
index 6699f52..c655caa 100644
--- a/gcc/vmsdbgout.c
+++ b/gcc/vmsdbgout.c
@@ -204,7 +204,7 @@ const struct gcc_debug_hooks vmsdbg_debug_hooks
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 */