2010-07-08 Tobias Burnus <burnus@net-b.de>
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 <burnus@net-b.de>
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(-)
@@ -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);
- }
}
}
@@ -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
@@ -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" } }