* [Patch, Fortran] PR 44702 - allow multiple USE imports of the same symbol
@ 2010-07-08 17:25 Tobias Burnus
2010-07-10 13:51 ` Daniel Kraft
0 siblings, 1 reply; 2+ messages in thread
From: Tobias Burnus @ 2010-07-08 17:25 UTC (permalink / raw)
To: gcc patches, gfortran
[-- Attachment #1: Type: text/plain, Size: 292 bytes --]
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
[-- Attachment #2: intrinsic_use.diff --]
[-- Type: text/x-patch, Size: 10757 bytes --]
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(-)
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" } }
^ permalink raw reply [flat|nested] 2+ messages in thread
* Re: [Patch, Fortran] PR 44702 - allow multiple USE imports of the same symbol
2010-07-08 17:25 [Patch, Fortran] PR 44702 - allow multiple USE imports of the same symbol Tobias Burnus
@ 2010-07-10 13:51 ` Daniel Kraft
0 siblings, 0 replies; 2+ messages in thread
From: Daniel Kraft @ 2010-07-10 13:51 UTC (permalink / raw)
To: Tobias Burnus; +Cc: gcc patches, gfortran
Tobias Burnus wrote:
> 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?
Ok. Thanks for the patch and the nice clean-up on the way!
Daniel
--
http://www.pro-vegan.info/
--
Done: Arc-Bar-Cav-Ran-Rog-Sam-Tou-Val-Wiz
To go: Hea-Kni-Mon-Pri
^ permalink raw reply [flat|nested] 2+ messages in thread
end of thread, other threads:[~2010-07-10 13:51 UTC | newest]
Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2010-07-08 17:25 [Patch, Fortran] PR 44702 - allow multiple USE imports of the same symbol Tobias Burnus
2010-07-10 13:51 ` Daniel Kraft
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).