From patchwork Thu Jul 8 17:24:56 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 58265 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 631BDB6EF7 for ; Fri, 9 Jul 2010 03:25:26 +1000 (EST) Received: (qmail 29385 invoked by alias); 8 Jul 2010 17:25:23 -0000 Received: (qmail 29358 invoked by uid 22791); 8 Jul 2010 17:25:20 -0000 X-SWARE-Spam-Status: No, hits=-1.9 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE, 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; Thu, 08 Jul 2010 17:25:13 +0000 Received: from [192.168.178.22] (port-92-204-34-42.dynamic.qsc.de [92.204.34.42]) by mx01.qsc.de (Postfix) with ESMTP id CC1813D364; Thu, 8 Jul 2010 19:24:57 +0200 (CEST) Message-ID: <4C3609E8.6060508@net-b.de> Date: Thu, 08 Jul 2010 19:24:56 +0200 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; U; Linux x86_64; en-US; rv:1.9.1.10) Gecko/20100520 SUSE/3.0.5 Thunderbird/3.0.5 MIME-Version: 1.0 To: gcc patches , gfortran Subject: [Patch, Fortran] PR 44702 - allow multiple USE imports of the same symbol 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 The way both intrinsics imports were written was such that use iso_c_binding, only: A => c_ptr, B => c_ptr was not possible. The fix was some simple restructuring, which also removed several lines and made the code clearer! Build and regtested on x86-64-linux. OK for the trunk? Tobias 2010-07-08 Tobias Burnus PR fortran/44702 * module.c (sort_iso_c_rename_list): Remove. (import_iso_c_binding_module,use_iso_fortran_env_module): Allow multiple imports of the same symbol. 2010-07-08 Tobias Burnus PR fortran/44702 * gfortran.dg/use_rename_6.f90: New. * gfortran.dg/use_iso_c_binding.f90: Update dg-error. b/gcc/fortran/module.c | 210 ++++++---------------- b/gcc/testsuite/gfortran.dg/use_iso_c_binding.f90 | 4 b/gcc/testsuite/gfortran.dg/use_rename_6.f90 | 40 ++++ 3 files changed, 100 insertions(+), 154 deletions(-) diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index b42a9e8..9eeaf04 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -5195,53 +5195,6 @@ gfc_dump_module (const char *name, int dump_flag) } -static void -sort_iso_c_rename_list (void) -{ - gfc_use_rename *tmp_list = NULL; - gfc_use_rename *curr; - gfc_use_rename *kinds_used[ISOCBINDING_NUMBER] = {NULL}; - int c_kind; - int i; - - for (curr = gfc_rename_list; curr; curr = curr->next) - { - c_kind = get_c_kind (curr->use_name, c_interop_kinds_table); - if (c_kind == ISOCBINDING_INVALID || c_kind == ISOCBINDING_LAST) - { - gfc_error ("Symbol '%s' referenced at %L does not exist in " - "intrinsic module ISO_C_BINDING.", curr->use_name, - &curr->where); - } - else - /* Put it in the list. */ - kinds_used[c_kind] = curr; - } - - /* Make a new (sorted) rename list. */ - i = 0; - while (i < ISOCBINDING_NUMBER && kinds_used[i] == NULL) - i++; - - if (i < ISOCBINDING_NUMBER) - { - tmp_list = kinds_used[i]; - - i++; - curr = tmp_list; - for (; i < ISOCBINDING_NUMBER; i++) - if (kinds_used[i] != NULL) - { - curr->next = kinds_used[i]; - curr = curr->next; - curr->next = NULL; - } - } - - gfc_rename_list = tmp_list; -} - - /* Import the intrinsic ISO_C_BINDING module, generating symbols in the current namespace for all named constants, pointer types, and procedures in the module unless the only clause was used or a rename @@ -5255,7 +5208,6 @@ import_iso_c_binding_module (void) const char *iso_c_module_name = "__iso_c_binding"; gfc_use_rename *u; int i; - char *local_name; /* Look only in the current namespace. */ mod_symtree = gfc_find_symtree (gfc_current_ns->sym_root, iso_c_module_name); @@ -5280,57 +5232,32 @@ import_iso_c_binding_module (void) /* Generate the symbols for the named constants representing the kinds for intrinsic data types. */ - if (only_flag) + for (i = 0; i < ISOCBINDING_NUMBER; i++) { - /* Sort the rename list because there are dependencies between types - and procedures (e.g., c_loc needs c_ptr). */ - sort_iso_c_rename_list (); - + bool found = false; for (u = gfc_rename_list; u; u = u->next) - { - i = get_c_kind (u->use_name, c_interop_kinds_table); + if (strcmp (c_interop_kinds_table[i].name, u->use_name) == 0) + { + u->found = 1; + found = true; + generate_isocbinding_symbol (iso_c_module_name, + (iso_c_binding_symbol) i, + u->local_name); + } - if (i == ISOCBINDING_INVALID || i == ISOCBINDING_LAST) - { - gfc_error ("Symbol '%s' referenced at %L does not exist in " - "intrinsic module ISO_C_BINDING.", u->use_name, - &u->where); - continue; - } - - generate_isocbinding_symbol (iso_c_module_name, - (iso_c_binding_symbol) i, - u->local_name); - } - } - else - { - for (i = 0; i < ISOCBINDING_NUMBER; i++) - { - local_name = NULL; - for (u = gfc_rename_list; u; u = u->next) - { - if (strcmp (c_interop_kinds_table[i].name, u->use_name) == 0) - { - local_name = u->local_name; - u->found = 1; - break; - } - } - generate_isocbinding_symbol (iso_c_module_name, - (iso_c_binding_symbol) i, - local_name); - } + if (!found && !only_flag) + generate_isocbinding_symbol (iso_c_module_name, + (iso_c_binding_symbol) i, NULL); + } - for (u = gfc_rename_list; u; u = u->next) - { - if (u->found) - continue; + for (u = gfc_rename_list; u; u = u->next) + { + if (u->found) + continue; - gfc_error ("Symbol '%s' referenced at %L not found in intrinsic " - "module ISO_C_BINDING", u->use_name, &u->where); - } - } + gfc_error ("Symbol '%s' referenced at %L not found in intrinsic " + "module ISO_C_BINDING", u->use_name, &u->where); + } } @@ -5372,7 +5299,6 @@ static void use_iso_fortran_env_module (void) { static char mod[] = "iso_fortran_env"; - const char *local_name; gfc_use_rename *u; gfc_symbol *mod_sym; gfc_symtree *mod_symtree; @@ -5408,60 +5334,41 @@ use_iso_fortran_env_module (void) "non-intrinsic module name used previously", mod); /* Generate the symbols for the module integer named constants. */ - if (only_flag) - for (u = gfc_rename_list; u; u = u->next) - { - for (i = 0; symbol[i].name; i++) - if (strcmp (symbol[i].name, u->use_name) == 0) - break; - if (symbol[i].name == NULL) - { - gfc_error ("Symbol '%s' referenced at %L does not exist in " - "intrinsic module ISO_FORTRAN_ENV", u->use_name, - &u->where); - 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 %L is " - "incompatible with option %s", &u->where, - gfc_option.flag_default_integer - ? "-fdefault-integer-8" : "-fdefault-real-8"); - - if (gfc_notify_std (symbol[i].standard, "The symbol '%s', referrenced " - "at %C, is not in the selected standard", - symbol[i].name) == FAILURE) - continue; - - create_int_parameter (u->local_name[0] ? u->local_name - : symbol[i].name, - symbol[i].value, mod, INTMOD_ISO_FORTRAN_ENV, - symbol[i].id); - } - else + for (i = 0; symbol[i].name; i++) { - for (i = 0; symbol[i].name; i++) + bool found = false; + for (u = gfc_rename_list; u; u = u->next) { - local_name = NULL; - - for (u = gfc_rename_list; u; u = u->next) + if (strcmp (symbol[i].name, u->use_name) == 0) { - if (strcmp (symbol[i].name, u->use_name) == 0) - { - local_name = u->local_name; - u->found = 1; - break; - } + found = true; + u->found = 1; + + if (gfc_notify_std (symbol[i].standard, "The symbol '%s', " + "referrenced at %C, is not in the selected " + "standard", symbol[i].name) == 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", + gfc_option.flag_default_integer + ? "-fdefault-integer-8" + : "-fdefault-real-8"); + + create_int_parameter (u->local_name[0] ? u->local_name : u->use_name, + symbol[i].value, mod, + INTMOD_ISO_FORTRAN_ENV, symbol[i].id); } + } - if (u && gfc_notify_std (symbol[i].standard, "The symbol '%s', " - "referrenced at %C, is not in the selected " - "standard", symbol[i].name) == FAILURE) - continue; - else if ((gfc_option.allow_std & symbol[i].standard) == 0) + if (!found && !only_flag) + { + if ((gfc_option.allow_std & symbol[i].standard) == 0) continue; if ((gfc_option.flag_default_integer || gfc_option.flag_default_real) @@ -5472,19 +5379,18 @@ use_iso_fortran_env_module (void) gfc_option.flag_default_integer ? "-fdefault-integer-8" : "-fdefault-real-8"); - create_int_parameter (local_name ? local_name : symbol[i].name, - symbol[i].value, mod, INTMOD_ISO_FORTRAN_ENV, - symbol[i].id); + create_int_parameter (symbol[i].name, symbol[i].value, mod, + INTMOD_ISO_FORTRAN_ENV, symbol[i].id); } + } - for (u = gfc_rename_list; u; u = u->next) - { - if (u->found) - continue; + for (u = gfc_rename_list; u; u = u->next) + { + if (u->found) + continue; - gfc_error ("Symbol '%s' referenced at %L not found in intrinsic " + gfc_error ("Symbol '%s' referenced at %L not found in intrinsic " "module ISO_FORTRAN_ENV", u->use_name, &u->where); - } } } diff --git a/gcc/testsuite/gfortran.dg/use_iso_c_binding.f90 b/gcc/testsuite/gfortran.dg/use_iso_c_binding.f90 index b35c024..8a28490 100644 --- a/gcc/testsuite/gfortran.dg/use_iso_c_binding.f90 +++ b/gcc/testsuite/gfortran.dg/use_iso_c_binding.f90 @@ -7,12 +7,12 @@ ! intrinsic one. --Rickett, 09.26.06 module use_stmt_0 ! this is an error because c_ptr_2 does not exist - use, intrinsic :: iso_c_binding, only: c_ptr_2 ! { dg-error "Symbol 'c_ptr_2' referenced at \\(1\\) does not exist" } + use, intrinsic :: iso_c_binding, only: c_ptr_2 ! { dg-error "Symbol 'c_ptr_2' referenced at \\(1\\) not found" } end module use_stmt_0 module use_stmt_1 ! this is an error because c_ptr_2 does not exist - use iso_c_binding, only: c_ptr_2 ! { dg-error "Symbol 'c_ptr_2' referenced at \\(1\\) does not exist" } + use iso_c_binding, only: c_ptr_2 ! { dg-error "Symbol 'c_ptr_2' referenced at \\(1\\) not found" } end module use_stmt_1 module use_stmt_2 --- /dev/null 2010-07-08 07:51:48.579354939 +0200 +++ b/gcc/testsuite/gfortran.dg/use_rename_6.f90 2010-07-08 18:25:38.000000000 +0200 @@ -0,0 +1,40 @@ +! { dg-do compile } +! { dg-options "-fdump-tree-original" } +! +! PR fortran/44702 +! +! Based on a test case by Joe Krahn. +! +! Multiple import of the same symbol was failing for +! intrinsic modules. +! +subroutine one() + use iso_c_binding, only: a => c_ptr, b => c_ptr, c_ptr + implicit none + type(a) :: x + type(b) :: y + type(c_ptr) :: z +end subroutine one + +subroutine two() + use iso_c_binding, a => c_ptr, b => c_ptr + implicit none + type(a) :: x + type(b) :: y +end subroutine two + +subroutine three() + use iso_fortran_env, only: a => error_unit, b => error_unit, error_unit + implicit none + if(a /= b) call shall_not_be_there() + if(a /= error_unit) call shall_not_be_there() +end subroutine three + +subroutine four() + use iso_fortran_env, a => error_unit, b => error_unit + implicit none + if(a /= b) call shall_not_be_there() +end subroutine four + +! { dg-final { scan-tree-dump-times "shall_not_be_there" 0 "original" } } +! { dg-final { cleanup-tree-dump "original" } }