From patchwork Sun Jan 8 20:01:01 2012 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 134932 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id 388D7B6F68 for ; Mon, 9 Jan 2012 07:01:37 +1100 (EST) Comment: DKIM? See http://www.dkim.org DKIM-Signature: v=1; a=rsa-sha1; c=relaxed/relaxed; d=gcc.gnu.org; s=default; x=1326657698; h=Comment: DomainKey-Signature:Received:Received:Received:Received: Message-ID:Date:From:User-Agent:MIME-Version:To:Subject: Content-Type:Mailing-List:Precedence:List-Id:List-Unsubscribe: List-Archive:List-Post:List-Help:Sender:Delivered-To; bh=QMXldcu GWncTxdEECUmhtwxz7Mk=; b=M93eY/ClCafuDFrV2j6vDU0BdB6VFFI9kuS9cH+ HiDAFXbNK3wJXdTNKVHM/SWFceTrAi/je4Boqk0vd40rTragozsjjJJea5NDntJJ 7ybWEFbV9+VLOFSKUaLrciOMqNvNqUv9DEzdCw2hc9PobG1DEa7Rkz3l77z07Yk+ 8Vq0= Comment: DomainKeys? See http://antispam.yahoo.com/domainkeys DomainKey-Signature: a=rsa-sha1; q=dns; c=nofws; s=default; d=gcc.gnu.org; h=Received:Received:X-SWARE-Spam-Status:X-Spam-Check-By:Received:Received:Message-ID:Date:From:User-Agent:MIME-Version:To:Subject:Content-Type:Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive:List-Post:List-Help:Sender:Delivered-To; b=fgViYLmAyqTJ27RPZxrdPlURmVsLXtEWicDsm8uA41acmHecLweGh1ZHkw0/PN ynBJBVucmWQDTZqUYrh5ikowPuaBxNHmvgXjMI0D/QdDeOtBl7i2YnIl+hF5fO7k okv2rWmU802hLVLTaIPOPHzItuZ/7TtQAP7yEzJmlBwIQ=; Received: (qmail 6164 invoked by alias); 8 Jan 2012 20:01:26 -0000 Received: (qmail 6148 invoked by uid 22791); 8 Jan 2012 20:01:19 -0000 X-SWARE-Spam-Status: No, hits=-1.7 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE, TW_CP, TW_TM X-Spam-Check-By: sourceware.org Received: from mx01.qsc.de (HELO mx01.qsc.de) (213.148.129.14) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Sun, 08 Jan 2012 20:01:04 +0000 Received: from [192.168.178.22] (port-92-204-59-150.dynamic.qsc.de [92.204.59.150]) by mx01.qsc.de (Postfix) with ESMTP id B328A3CE35; Sun, 8 Jan 2012 21:01:01 +0100 (CET) Message-ID: <4F09F5FD.7070909@net-b.de> Date: Sun, 08 Jan 2012 21:01:01 +0100 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:9.0) Gecko/20111220 Thunderbird/9.0 MIME-Version: 1.0 To: gcc patches , gfortran Subject: [Patch, Fortran] PR51578 Fix symbol import with renaming and only Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Hi all, gfortran mishandles the module import, if one uses multiple USE statements and rename/only. This part got "broken" when the following has been implemented: "More than one USE statement for a given module may appear in a specification part. If one of the USE statements is without an ONLY option, all public entities in the module are accessible. If all the USE statements have ONLY options, only those entities in one or more of the only-lists are accessible." However, that old patch (4.2 or 4.3?) also removes the "A" symbol for: USE m2 ! contains "USE m" USE m1, B => A Instead of processing each USE statement and then fixing things, with the attached patch first all USE statements are parsed, the USE only/rename lists are merged - avoiding the postprocessing. (There is still a very special case which is not handled, see FIXME in gfc_use_modules.) The patch has been build and regtested (check-gfortran + libgomp's check) on x86-64-linux. OK for the trunk? What shall we do about the branch? It's known to work on 4.1, it fails with 4.3 to 4.7. Shall we only commit it to the trunk? Or also to 4.6? Additionally to 4.5? Or even to 4.4? Given that it is a rather old regression and that the patch is not tiny, I am inclined to only apply it to either 4.7 only or to 4.6 and 4.7. Tobias 2012-01-08 Tobias Burnus 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-08 Tobias Burnus PR fortran/51578 * gfortran.dg/use_17.f90: New. 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..a5d5497 100644 --- a/gcc/fortran/match.h +++ b/gcc/fortran/match.h @@ -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..703c586 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -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,7 +5966,10 @@ 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); @@ -5979,12 +5979,12 @@ gfc_use_module (void) /* 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,74 @@ 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; + + for (seek = next->next; seek; seek = seek->next) + if (next->module_name == seek->module_name && seek->non_intrinsic) + non_intrinsic = true; + + if (non_intrinsic && !next->intrinsic) + next->non_intrinsic = true; + + /* FIXME: The following algorithm will fail if one mixes for the same + module name "use, intrinsic ::" with "use ::" and uses renaming: The + renamed symbol might be also imported under the original name. */ + last = next; + for (seek = next->next; seek; seek = last->next) + { + if (next->module_name != seek->module_name) + { + last = seek; + continue; + } + + if (non_intrinsic && !seek->intrinsic) + seek->non_intrinsic = true; + + if ((next->intrinsic && seek->intrinsic) + || (next->non_intrinsic && seek->non_intrinsic) + || (!next->intrinsic && !next->non_intrinsic + && !seek->intrinsic && !seek->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 +6184,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..3f9e45e 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -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; --- /dev/null 2012-01-05 19:53:04.947579545 +0100 +++ gcc/gcc/testsuite/gfortran.dg/use_17.f90 2012-01-08 11:29:39.000000000 +0100 @@ -0,0 +1,32 @@ +! { 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 + +! { dg-final { cleanup-modules "mod1 mod2" } }