From: burnus Date: Sun, 11 Jul 2010 21:29:30 +0000 (+0000) Subject: tob@archimedes:~/scratch/gcc> head -n 15 ../intrinsic_use.diff X-Git-Url: http://git.sourceforge.jp/view?p=pf3gnuchains%2Fgcc-fork.git;a=commitdiff_plain;h=c6cf1e49f4bcb1b407f7fac6a07cf32e2681eacd tob@archimedes:~/scratch/gcc> head -n 15 ../intrinsic_use.diff 2010-07-11 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-11 Tobias Burnus PR fortran/44702 * gfortran.dg/use_rename_6.f90: New. * gfortran.dg/use_iso_c_binding.f90: Update dg-error. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@162061 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 093631c63a5..af17f5c0ddf 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2010-07-11 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-11 Mikael Morin * arith.c (gfc_arith_done_1): Release mpfr internal caches. diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index aa6e72eeeff..426a17c5cdf 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -5201,53 +5201,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 @@ -5261,7 +5214,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); @@ -5286,57 +5238,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); + } } @@ -5378,7 +5305,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; @@ -5414,60 +5340,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) @@ -5478,19 +5385,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/ChangeLog b/gcc/testsuite/ChangeLog index 2970eacb9f6..1182677f4da 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2010-07-11 Tobias Burnus + + PR fortran/44702 + * gfortran.dg/use_rename_6.f90: New. + * gfortran.dg/use_iso_c_binding.f90: Update dg-error. + 2010-07-11 Janus Weil PR fortran/44869 diff --git a/gcc/testsuite/gfortran.dg/use_iso_c_binding.f90 b/gcc/testsuite/gfortran.dg/use_iso_c_binding.f90 index b35c024c08c..8a28490f7b2 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 diff --git a/gcc/testsuite/gfortran.dg/use_rename_6.f90 b/gcc/testsuite/gfortran.dg/use_rename_6.f90 new file mode 100644 index 00000000000..02f25c36e97 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/use_rename_6.f90 @@ -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" } }