aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
Diffstat (limited to 'gcc')
-rw-r--r--gcc/fortran/ChangeLog28
-rw-r--r--gcc/fortran/gfortran.h4
-rw-r--r--gcc/fortran/match.h4
-rw-r--r--gcc/fortran/module.c268
-rw-r--r--gcc/fortran/parse.c64
-rw-r--r--gcc/testsuite/ChangeLog5
-rw-r--r--gcc/testsuite/gfortran.dg/use_17.f9039
7 files changed, 309 insertions, 103 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 656a84c..a12876c 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,31 @@
+2012-01-09 Tobias Burnus <burnus@net-b.de>
+
+ PR fortran/51578
+ * gfortran.h (gfc_use_list):
+ * match.h (gfc_use_module): Rename to ...
+ (gfc_use_modules): ... this.
+ * module.c (use_locus, specified_nonint, specified_int): Remove
+ global variable.
+ (module_name): Change type to const char*, used with gfc_get_string.
+ (module_list): New global variable.
+ (free_rename): Free argument not global var.
+ (gfc_match_use): Save match to module_list.
+ (load_generic_interfaces, read_module): Don't free symtree.
+ (write_dt_extensions, gfc_dump_module): Fix module-name I/O due to the
+ type change of module_name.
+ (write_symbol0, write_generic): Optimize due to the type change.
+ (import_iso_c_binding_module, use_iso_fortran_env_module): Use
+ locus of rename->where.
+ (gfc_use_module): Take module_list as argument.
+ (gfc_use_modules): New function.
+ (gfc_module_init_2, gfc_module_done_2): Init module_list, rename_list.
+ * parse.c (last_was_use_stmt): New global variable.
+ (use_modules): New function.
+ (decode_specification_statement, decode_statement): Move USE match up
+ and call use_modules.
+ (next_free, next_fixed): Call use_modules.
+ (accept_statement): Don't call gfc_module_use.
+
2012-01-06 Tobias Burnus <burnus@net-b.de>
* trans-openmp.c (gfc_omp_clause_dtor, gfc_trans_omp_array_reduction):
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index e8a3de0..f339271 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1299,7 +1299,9 @@ gfc_use_rename;
typedef struct gfc_use_list
{
const char *module_name;
- int only_flag;
+ bool intrinsic;
+ bool non_intrinsic;
+ bool only_flag;
struct gfc_use_rename *rename;
locus where;
/* Next USE statement. */
diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h
index df18074..c4e7e91 100644
--- a/gcc/fortran/match.h
+++ b/gcc/fortran/match.h
@@ -1,5 +1,5 @@
/* All matcher functions.
- Copyright (C) 2003, 2005, 2007, 2008, 2010
+ Copyright (C) 2003, 2005, 2007, 2008, 2010, 2012
Free Software Foundation, Inc.
Contributed by Steven Bosscher
@@ -249,7 +249,7 @@ match gfc_match_expr (gfc_expr **);
/* module.c. */
match gfc_match_use (void);
-void gfc_use_module (void);
+void gfc_use_modules (void);
#endif /* GFC_MATCH_H */
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 1ab08ae..a681325 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -1,7 +1,7 @@
/* Handle modules, which amounts to loading and saving symbols and
their attendant structures.
Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
- 2009, 2010, 2011
+ 2009, 2010, 2011, 2012
Free Software Foundation, Inc.
Contributed by Andy Vaught
@@ -188,10 +188,8 @@ static FILE *module_fp;
static struct md5_ctx ctx;
/* The name of the module we're reading (USE'ing) or writing. */
-static char module_name[GFC_MAX_SYMBOL_LEN + 1];
-
-/* The way the module we're reading was specified. */
-static bool specified_nonint, specified_int;
+static const char *module_name;
+static gfc_use_list *module_list;
static int module_line, module_column, only_flag;
static int prev_module_line, prev_module_column, prev_character;
@@ -207,8 +205,6 @@ static int symbol_number; /* Counter for assigning symbol numbers */
/* Tells mio_expr_ref to make symbols for unused equivalence members. */
static bool in_load_equiv;
-static locus use_locus;
-
/*****************************************************************/
@@ -519,14 +515,14 @@ add_fixup (int integer, void *gp)
/* Free the rename list left behind by a USE statement. */
static void
-free_rename (void)
+free_rename (gfc_use_rename *list)
{
gfc_use_rename *next;
- for (; gfc_rename_list; gfc_rename_list = next)
+ for (; list; list = next)
{
- next = gfc_rename_list->next;
- free (gfc_rename_list);
+ next = list->next;
+ free (list);
}
}
@@ -541,29 +537,29 @@ gfc_match_use (void)
interface_type type, type2;
gfc_intrinsic_op op;
match m;
-
- specified_int = false;
- specified_nonint = false;
-
+ gfc_use_list *use_list;
+
+ use_list = gfc_get_use_list ();
+
if (gfc_match (" , ") == MATCH_YES)
{
if ((m = gfc_match (" %n ::", module_nature)) == MATCH_YES)
{
if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: module "
"nature in USE statement at %C") == FAILURE)
- return MATCH_ERROR;
+ goto cleanup;
if (strcmp (module_nature, "intrinsic") == 0)
- specified_int = true;
+ use_list->intrinsic = true;
else
{
if (strcmp (module_nature, "non_intrinsic") == 0)
- specified_nonint = true;
+ use_list->non_intrinsic = true;
else
{
gfc_error ("Module nature in USE statement at %C shall "
"be either INTRINSIC or NON_INTRINSIC");
- return MATCH_ERROR;
+ goto cleanup;
}
}
}
@@ -576,6 +572,7 @@ gfc_match_use (void)
|| strcmp (module_nature, "non_intrinsic") == 0)
gfc_error ("\"::\" was expected after module nature at %C "
"but was not found");
+ free (use_list);
return m;
}
}
@@ -585,35 +582,41 @@ gfc_match_use (void)
if (m == MATCH_YES &&
gfc_notify_std (GFC_STD_F2003, "Fortran 2003: "
"\"USE :: module\" at %C") == FAILURE)
- return MATCH_ERROR;
+ goto cleanup;
if (m != MATCH_YES)
{
m = gfc_match ("% ");
if (m != MATCH_YES)
- return m;
+ {
+ free (use_list);
+ return m;
+ }
}
}
- use_locus = gfc_current_locus;
+ use_list->where = gfc_current_locus;
- m = gfc_match_name (module_name);
+ m = gfc_match_name (name);
if (m != MATCH_YES)
- return m;
+ {
+ free (use_list);
+ return m;
+ }
- free_rename ();
- only_flag = 0;
+ use_list->module_name = gfc_get_string (name);
if (gfc_match_eos () == MATCH_YES)
- return MATCH_YES;
+ goto done;
+
if (gfc_match_char (',') != MATCH_YES)
goto syntax;
if (gfc_match (" only :") == MATCH_YES)
- only_flag = 1;
+ use_list->only_flag = true;
if (gfc_match_eos () == MATCH_YES)
- return MATCH_YES;
+ goto done;
for (;;)
{
@@ -622,8 +625,8 @@ gfc_match_use (void)
new_use->where = gfc_current_locus;
new_use->found = 0;
- if (gfc_rename_list == NULL)
- gfc_rename_list = new_use;
+ if (use_list->rename == NULL)
+ use_list->rename = new_use;
else
tail->next = new_use;
tail = new_use;
@@ -653,7 +656,7 @@ gfc_match_use (void)
if (type == INTERFACE_USER_OP)
new_use->op = INTRINSIC_USER;
- if (only_flag)
+ if (use_list->only_flag)
{
if (m != MATCH_YES)
strcpy (new_use->use_name, name);
@@ -684,11 +687,11 @@ gfc_match_use (void)
goto cleanup;
}
- if (strcmp (new_use->use_name, module_name) == 0
- || strcmp (new_use->local_name, module_name) == 0)
+ if (strcmp (new_use->use_name, use_list->module_name) == 0
+ || strcmp (new_use->local_name, use_list->module_name) == 0)
{
gfc_error ("The name '%s' at %C has already been used as "
- "an external module name.", module_name);
+ "an external module name.", use_list->module_name);
goto cleanup;
}
break;
@@ -707,15 +710,27 @@ gfc_match_use (void)
goto syntax;
}
+done:
+ if (module_list)
+ {
+ gfc_use_list *last = module_list;
+ while (last->next)
+ last = last->next;
+ last->next = use_list;
+ }
+ else
+ module_list = use_list;
+
return MATCH_YES;
syntax:
gfc_syntax_error (ST_USE);
cleanup:
- free_rename ();
+ free_rename (use_list->rename);
+ free (use_list);
return MATCH_ERROR;
- }
+}
/* Given a name and a number, inst, return the inst name
@@ -4016,20 +4031,7 @@ load_generic_interfaces (void)
if (!sym)
{
- /* Make the symbol inaccessible if it has been added by a USE
- statement without an ONLY(11.3.2). */
- if (st && only_flag
- && !st->n.sym->attr.use_only
- && !st->n.sym->attr.use_rename
- && strcmp (st->n.sym->module, module_name) == 0)
- {
- sym = st->n.sym;
- gfc_delete_symtree (&gfc_current_ns->sym_root, name);
- st = gfc_get_unique_symtree (gfc_current_ns);
- st->n.sym = sym;
- sym = NULL;
- }
- else if (st)
+ if (st)
{
sym = st->n.sym;
if (strcmp (st->name, p) != 0)
@@ -4046,7 +4048,7 @@ load_generic_interfaces (void)
{
gfc_get_symbol (p, NULL, &sym);
sym->name = gfc_get_string (name);
- sym->module = gfc_get_string (module_name);
+ sym->module = module_name;
sym->attr.flavor = FL_PROCEDURE;
sym->attr.generic = 1;
sym->attr.use_assoc = 1;
@@ -4434,7 +4436,7 @@ check_for_ambiguous (gfc_symbol *st_sym, pointer_info *info)
the new symbol is generic there can be no ambiguity. */
if (st_sym->attr.generic
&& st_sym->module
- && strcmp (st_sym->module, module_name))
+ && st_sym->module != module_name)
{
/* The new symbol's attributes have not yet been read. Since
we need attr.generic, read it directly. */
@@ -4609,16 +4611,6 @@ read_module (void)
{
st = gfc_find_symtree (gfc_current_ns->sym_root, name);
- /* Delete the symtree if the symbol has been added by a USE
- statement without an ONLY(11.3.2). Remember that the rsym
- will be the same as the symbol found in the symtree, for
- this case. */
- if (st && (only_flag || info->u.rsym.renamed)
- && !st->n.sym->attr.use_only
- && !st->n.sym->attr.use_rename
- && info->u.rsym.sym == st->n.sym)
- gfc_delete_symtree (&gfc_current_ns->sym_root, name);
-
/* Create a symtree node in the current namespace for this
symbol. */
st = check_unique_name (p)
@@ -4649,9 +4641,6 @@ read_module (void)
if (strcmp (name, p) != 0)
sym->attr.use_rename = 1;
- /* We need to set the only_flag here so that symbols from the
- same USE...ONLY but earlier are not deleted from the tree in
- the gfc_delete_symtree above. */
sym->attr.use_only = only_flag;
/* Store the symtree pointing to this symbol. */
@@ -4976,7 +4965,14 @@ write_dt_extensions (gfc_symtree *st)
if (st->n.sym->module != NULL)
mio_pool_string (&st->n.sym->module);
else
- mio_internal_string (module_name);
+ {
+ char name[GFC_MAX_SYMBOL_LEN + 1];
+ if (iomode == IO_OUTPUT)
+ strcpy (name, module_name);
+ mio_internal_string (name);
+ if (iomode == IO_INPUT)
+ module_name = gfc_get_string (name);
+ }
mio_rparen ();
}
@@ -5051,7 +5047,7 @@ write_symbol0 (gfc_symtree *st)
sym = st->n.sym;
if (sym->module == NULL)
- sym->module = gfc_get_string (module_name);
+ sym->module = module_name;
if (sym->attr.flavor == FL_PROCEDURE && sym->attr.generic
&& !sym->attr.subroutine && !sym->attr.function)
@@ -5142,7 +5138,7 @@ write_generic (gfc_symtree *st)
return;
if (sym->module == NULL)
- sym->module = gfc_get_string (module_name);
+ sym->module = module_name;
mio_symbol_interface (&st->name, &sym->module, &sym->generic);
}
@@ -5378,7 +5374,7 @@ gfc_dump_module (const char *name, int dump_flag)
/* Write the module itself. */
iomode = IO_OUTPUT;
- strcpy (module_name, name);
+ module_name = gfc_get_string (name);
init_pi_tree ();
@@ -5537,8 +5533,8 @@ import_iso_c_binding_module (void)
if (not_in_std)
{
- gfc_error ("The symbol '%s', referenced at %C, is not "
- "in the selected standard", name);
+ gfc_error ("The symbol '%s', referenced at %L, is not "
+ "in the selected standard", name, &u->where);
continue;
}
@@ -5817,16 +5813,17 @@ use_iso_fortran_env_module (void)
u->found = 1;
if (gfc_notify_std (symbol[i].standard, "The symbol '%s', "
- "referenced at %C, is not in the selected "
- "standard", symbol[i].name) == FAILURE)
+ "referenced at %L, is not in the selected "
+ "standard", symbol[i].name,
+ &u->where) == FAILURE)
continue;
if ((gfc_option.flag_default_integer || gfc_option.flag_default_real)
&& symbol[i].id == ISOFORTRANENV_NUMERIC_STORAGE_SIZE)
gfc_warning_now ("Use of the NUMERIC_STORAGE_SIZE named "
"constant from intrinsic module "
- "ISO_FORTRAN_ENV at %C is incompatible with "
- "option %s",
+ "ISO_FORTRAN_ENV at %L is incompatible with "
+ "option %s", &u->where,
gfc_option.flag_default_integer
? "-fdefault-integer-8"
: "-fdefault-real-8");
@@ -5959,8 +5956,8 @@ use_iso_fortran_env_module (void)
/* Process a USE directive. */
-void
-gfc_use_module (void)
+static void
+gfc_use_module (gfc_use_list *module)
{
char *filename;
gfc_state_data *p;
@@ -5969,22 +5966,25 @@ gfc_use_module (void)
gfc_use_list *use_stmt;
locus old_locus = gfc_current_locus;
- gfc_current_locus = use_locus;
+ gfc_current_locus = module->where;
+ module_name = module->module_name;
+ gfc_rename_list = module->rename;
+ only_flag = module->only_flag;
- filename = (char *) alloca (strlen (module_name) + strlen (MODULE_EXTENSION)
- + 1);
+ filename = XALLOCAVEC (char, strlen (module_name) + strlen (MODULE_EXTENSION)
+ + 1);
strcpy (filename, module_name);
strcat (filename, MODULE_EXTENSION);
/* First, try to find an non-intrinsic module, unless the USE statement
specified that the module is intrinsic. */
module_fp = NULL;
- if (!specified_int)
+ if (!module->intrinsic)
module_fp = gfc_open_included_file (filename, true, true);
/* Then, see if it's an intrinsic one, unless the USE statement
specified that the module is non-intrinsic. */
- if (module_fp == NULL && !specified_nonint)
+ if (module_fp == NULL && !module->non_intrinsic)
{
if (strcmp (module_name, "iso_fortran_env") == 0
&& gfc_notify_std (GFC_STD_F2003, "Fortran 2003: ISO_FORTRAN_ENV "
@@ -5992,6 +5992,7 @@ gfc_use_module (void)
{
use_iso_fortran_env_module ();
gfc_current_locus = old_locus;
+ module->intrinsic = true;
return;
}
@@ -6001,12 +6002,13 @@ gfc_use_module (void)
{
import_iso_c_binding_module();
gfc_current_locus = old_locus;
+ module->intrinsic = true;
return;
}
module_fp = gfc_open_intrinsic_module (filename);
- if (module_fp == NULL && specified_int)
+ if (module_fp == NULL && module->intrinsic)
gfc_fatal_error ("Can't find an intrinsic module named '%s' at %C",
module_name);
}
@@ -6083,11 +6085,7 @@ gfc_use_module (void)
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;
- use_stmt->where = use_locus;
- gfc_rename_list = NULL;
+ *use_stmt = *module;
use_stmt->next = gfc_current_ns->use_stmts;
gfc_current_ns->use_stmts = use_stmt;
@@ -6095,6 +6093,93 @@ gfc_use_module (void)
}
+/* Process all USE directives. */
+
+void
+gfc_use_modules (void)
+{
+ gfc_use_list *next, *seek, *last;
+
+ for (next = module_list; next; next = next->next)
+ {
+ bool non_intrinsic = next->non_intrinsic;
+ bool intrinsic = next->intrinsic;
+ bool neither = !non_intrinsic && !intrinsic;
+
+ for (seek = next->next; seek; seek = seek->next)
+ {
+ if (next->module_name != seek->module_name)
+ continue;
+
+ if (seek->non_intrinsic)
+ non_intrinsic = true;
+ else if (seek->intrinsic)
+ intrinsic = true;
+ else
+ neither = true;
+ }
+
+ if (intrinsic && neither && !non_intrinsic)
+ {
+ char *filename;
+ FILE *fp;
+
+ filename = XALLOCAVEC (char,
+ strlen (next->module_name)
+ + strlen (MODULE_EXTENSION) + 1);
+ strcpy (filename, next->module_name);
+ strcat (filename, MODULE_EXTENSION);
+ fp = gfc_open_included_file (filename, true, true);
+ if (fp != NULL)
+ {
+ non_intrinsic = true;
+ fclose (fp);
+ }
+ }
+
+ last = next;
+ for (seek = next->next; seek; seek = last->next)
+ {
+ if (next->module_name != seek->module_name)
+ {
+ last = seek;
+ continue;
+ }
+
+ if ((!next->intrinsic && !seek->intrinsic)
+ || (next->intrinsic && seek->intrinsic)
+ || !non_intrinsic)
+ {
+ if (!seek->only_flag)
+ next->only_flag = false;
+ if (seek->rename)
+ {
+ gfc_use_rename *r = seek->rename;
+ while (r->next)
+ r = r->next;
+ r->next = next->rename;
+ next->rename = seek->rename;
+ }
+ last->next = seek->next;
+ free (seek);
+ }
+ else
+ last = seek;
+ }
+ }
+
+ for (; module_list; module_list = next)
+ {
+ next = module_list->next;
+ gfc_use_module (module_list);
+ if (module_list->intrinsic)
+ free_rename (module_list->rename);
+ free (module_list);
+ }
+ gfc_rename_list = NULL;
+}
+
+
void
gfc_free_use_stmts (gfc_use_list *use_stmts)
{
@@ -6118,11 +6203,14 @@ void
gfc_module_init_2 (void)
{
last_atom = ATOM_LPAREN;
+ gfc_rename_list = NULL;
+ module_list = NULL;
}
void
gfc_module_done_2 (void)
{
- free_rename ();
+ free_rename (gfc_rename_list);
+ gfc_rename_list = NULL;
}
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index ea1d773..317fb84 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -1,6 +1,6 @@
/* Main parser.
Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
- 2009, 2010, 2011
+ 2009, 2010, 2011, 2012
Free Software Foundation, Inc.
Contributed by Andy Vaught
@@ -37,6 +37,7 @@ static locus label_locus;
static jmp_buf eof_buf;
gfc_state_data *gfc_state_stack;
+static bool last_was_use_stmt = false;
/* TODO: Re-order functions to kill these forward decls. */
static void check_statement_label (gfc_statement);
@@ -74,6 +75,26 @@ match_word (const char *str, match (*subr) (void), locus *old_locus)
}
+/* Load symbols from all USE statements encounted in this scoping unit. */
+
+static void
+use_modules (void)
+{
+ gfc_error_buf old_error;
+
+ gfc_push_error (&old_error);
+ gfc_buffer_error (0);
+ gfc_use_modules ();
+ gfc_buffer_error (1);
+ gfc_pop_error (&old_error);
+ gfc_commit_symbols ();
+ gfc_warning_check ();
+ gfc_current_ns->old_cl_list = gfc_current_ns->cl_list;
+ gfc_current_ns->old_equiv = gfc_current_ns->equiv;
+ last_was_use_stmt = false;
+}
+
+
/* Figure out what the next statement is, (mostly) regardless of
proper ordering. The do...while(0) is there to prevent if/else
ambiguity. */
@@ -108,8 +129,19 @@ decode_specification_statement (void)
old_locus = gfc_current_locus;
+ if (match_word ("use", gfc_match_use, &old_locus) == MATCH_YES)
+ {
+ last_was_use_stmt = true;
+ return ST_USE;
+ }
+ else
+ {
+ undo_new_statement ();
+ if (last_was_use_stmt)
+ use_modules ();
+ }
+
match ("import", gfc_match_import, ST_IMPORT);
- match ("use", gfc_match_use, ST_USE);
if (gfc_current_block ()->result->ts.type != BT_DERIVED)
goto end_of_block;
@@ -252,6 +284,22 @@ decode_statement (void)
old_locus = gfc_current_locus;
+ c = gfc_peek_ascii_char ();
+
+ if (c == 'u')
+ {
+ if (match_word ("use", gfc_match_use, &old_locus) == MATCH_YES)
+ {
+ last_was_use_stmt = true;
+ return ST_USE;
+ }
+ else
+ undo_new_statement ();
+ }
+
+ if (last_was_use_stmt)
+ use_modules ();
+
/* Try matching a data declaration or function declaration. The
input "REALFUNCTIONA(N)" can mean several things in different
contexts, so it (and its relatives) get special treatment. */
@@ -322,8 +370,6 @@ decode_statement (void)
statement, we eliminate most possibilities by peeking at the
first character. */
- c = gfc_peek_ascii_char ();
-
switch (c)
{
case 'a':
@@ -454,7 +500,6 @@ decode_statement (void)
case 'u':
match ("unlock", gfc_match_unlock, ST_UNLOCK);
- match ("use", gfc_match_use, ST_USE);
break;
case 'v':
@@ -713,6 +758,8 @@ next_free (void)
gcc_assert (c == ' ' || c == '\t');
gfc_gobble_whitespace ();
+ if (last_was_use_stmt)
+ use_modules ();
return decode_omp_directive ();
}
@@ -801,7 +848,8 @@ next_fixed (void)
gfc_error ("Bad continuation line at %C");
return ST_NONE;
}
-
+ if (last_was_use_stmt)
+ use_modules ();
return decode_omp_directive ();
}
/* FALLTHROUGH */
@@ -1595,10 +1643,6 @@ accept_statement (gfc_statement st)
{
switch (st)
{
- case ST_USE:
- gfc_use_module ();
- break;
-
case ST_IMPLICIT_NONE:
gfc_set_implicit_none ();
break;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 2d78cb5..bab4f89 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2012-01-09 Tobias Burnus <burnus@net-b.de>
+
+ PR fortran/51578
+ * gfortran.dg/use_17.f90: New.
+
2012-01-09 Gary Funck <gary@intrepid.com>
PR preprocessor/33919
diff --git a/gcc/testsuite/gfortran.dg/use_17.f90 b/gcc/testsuite/gfortran.dg/use_17.f90
new file mode 100644
index 0000000..b1b002e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/use_17.f90
@@ -0,0 +1,39 @@
+! { dg-do compile }
+!
+! PR fortran/51578
+!
+! Contributed by Billy Backer
+!
+! Check that indict importing of the symbol "axx" works
+! even if renaming prevent the direct import.
+!
+module mod1
+integer :: axx=2
+end module mod1
+
+module mod2
+use mod1
+end module mod2
+
+subroutine sub1
+use mod1, oxx=>axx
+use mod2
+implicit none
+print*,axx ! Valid - was working before
+end subroutine sub1
+
+subroutine sub2
+use mod2
+use mod1, oxx=>axx
+implicit none
+print*,axx ! Valid - was failing before
+end subroutine sub2
+
+subroutine test1
+ use :: iso_c_binding
+ use, intrinsic :: iso_c_binding, only: c_double_orig => c_double
+ integer :: c_double
+ integer, parameter :: p1 = c_int, p2 = c_double_orig
+end subroutine test1
+
+! { dg-final { cleanup-modules "mod1 mod2" } }
generated by cgit v1.1 at 2024-11-09 05:47:22 +0000