Commit d33b6020 by Tobias Burnus

re PR fortran/33072 ("use mod, only: operator(.sub.)" matches any procedure "sub")

2007-08-16  Tobias Burnus  <burnus@net-b.de>

	PR fortran/33072
	* module.c (gfc_match_use): Mark user operators as such.
	(find_use_name_n): Distinguish between operators and other symbols.
	(find_use_name,number_use_names,mio_namelist,
	 load_operator_interfaces,load_generic_interfaces,read_module,
	 write_generic): Update find_use_name_n calls.

2007-08-16  Tobias Burnus  <burnus@net-b.de>

	PR fortran/33072
	* gfortran.dg/use_9.f90: New.

From-SVN: r127564
parent 75407da3
2007-08-16 Tobias Burnus <burnus@net-b.de>
PR fortran/33072
* module.c (gfc_match_use): Mark user operators as such.
(find_use_name_n): Distinguish between operators and other symbols.
(find_use_name,number_use_names,mio_namelist,
load_operator_interfaces,load_generic_interfaces,read_module,
write_generic): Update find_use_name_n calls.
2007-08-15 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> 2007-08-15 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/29459 PR fortran/29459
......
...@@ -612,6 +612,9 @@ gfc_match_use (void) ...@@ -612,6 +612,9 @@ gfc_match_use (void)
== FAILURE)) == FAILURE))
goto cleanup; goto cleanup;
if (type == INTERFACE_USER_OP)
new->operator = INTRINSIC_USER;
if (only_flag) if (only_flag)
{ {
if (m != MATCH_YES) if (m != MATCH_YES)
...@@ -677,10 +680,12 @@ cleanup: ...@@ -677,10 +680,12 @@ cleanup:
/* Given a name and a number, inst, return the inst name /* Given a name and a number, inst, return the inst name
under which to load this symbol. Returns NULL if this under which to load this symbol. Returns NULL if this
symbol shouldn't be loaded. If inst is zero, returns symbol shouldn't be loaded. If inst is zero, returns
the number of instances of this name. */ the number of instances of this name. If interface is
true, a user-defined operator is sought, otherwise only
non-operators are sought. */
static const char * static const char *
find_use_name_n (const char *name, int *inst) find_use_name_n (const char *name, int *inst, bool interface)
{ {
gfc_use_rename *u; gfc_use_rename *u;
int i; int i;
...@@ -688,7 +693,9 @@ find_use_name_n (const char *name, int *inst) ...@@ -688,7 +693,9 @@ find_use_name_n (const char *name, int *inst)
i = 0; i = 0;
for (u = gfc_rename_list; u; u = u->next) for (u = gfc_rename_list; u; u = u->next)
{ {
if (strcmp (u->use_name, name) != 0) if (strcmp (u->use_name, name) != 0
|| (u->operator == INTRINSIC_USER && !interface)
|| (u->operator != INTRINSIC_USER && interface))
continue; continue;
if (++i == *inst) if (++i == *inst)
break; break;
...@@ -713,21 +720,21 @@ find_use_name_n (const char *name, int *inst) ...@@ -713,21 +720,21 @@ find_use_name_n (const char *name, int *inst)
Returns NULL if this symbol shouldn't be loaded. */ Returns NULL if this symbol shouldn't be loaded. */
static const char * static const char *
find_use_name (const char *name) find_use_name (const char *name, bool interface)
{ {
int i = 1; int i = 1;
return find_use_name_n (name, &i); return find_use_name_n (name, &i, interface);
} }
/* Given a real name, return the number of use names associated with it. */ /* Given a real name, return the number of use names associated with it. */
static int static int
number_use_names (const char *name) number_use_names (const char *name, bool interface)
{ {
int i = 0; int i = 0;
const char *c; const char *c;
c = find_use_name_n (name, &i); c = find_use_name_n (name, &i, interface);
return i; return i;
} }
...@@ -2869,7 +2876,7 @@ mio_namelist (gfc_symbol *sym) ...@@ -2869,7 +2876,7 @@ mio_namelist (gfc_symbol *sym)
conditionally? */ conditionally? */
if (sym->attr.flavor == FL_NAMELIST) if (sym->attr.flavor == FL_NAMELIST)
{ {
check_name = find_use_name (sym->name); check_name = find_use_name (sym->name, false);
if (check_name && strcmp (check_name, sym->name) != 0) if (check_name && strcmp (check_name, sym->name) != 0)
gfc_error ("Namelist %s cannot be renamed by USE " gfc_error ("Namelist %s cannot be renamed by USE "
"association to %s", sym->name, check_name); "association to %s", sym->name, check_name);
...@@ -3131,7 +3138,7 @@ load_operator_interfaces (void) ...@@ -3131,7 +3138,7 @@ load_operator_interfaces (void)
mio_internal_string (module); mio_internal_string (module);
/* Decide if we need to load this one or not. */ /* Decide if we need to load this one or not. */
p = find_use_name (name); p = find_use_name (name, true);
if (p == NULL) if (p == NULL)
{ {
while (parse_atom () != ATOM_RPAREN); while (parse_atom () != ATOM_RPAREN);
...@@ -3168,18 +3175,18 @@ load_generic_interfaces (void) ...@@ -3168,18 +3175,18 @@ load_generic_interfaces (void)
mio_internal_string (name); mio_internal_string (name);
mio_internal_string (module); mio_internal_string (module);
n = number_use_names (name); n = number_use_names (name, false);
n = n ? n : 1; n = n ? n : 1;
for (i = 1; i <= n; i++) for (i = 1; i <= n; i++)
{ {
/* Decide if we need to load this one or not. */ /* Decide if we need to load this one or not. */
p = find_use_name_n (name, &i); p = find_use_name_n (name, &i, false);
if (p == NULL || gfc_find_symbol (p, NULL, 0, &sym)) if (p == NULL || gfc_find_symbol (p, NULL, 0, &sym))
{ {
while (parse_atom () != ATOM_RPAREN); while (parse_atom () != ATOM_RPAREN);
continue; continue;
} }
if (sym == NULL) if (sym == NULL)
...@@ -3548,14 +3555,14 @@ read_module (void) ...@@ -3548,14 +3555,14 @@ read_module (void)
/* See how many use names there are. If none, go through the start /* See how many use names there are. If none, go through the start
of the loop at least once. */ of the loop at least once. */
nuse = number_use_names (name); nuse = number_use_names (name, false);
if (nuse == 0) if (nuse == 0)
nuse = 1; nuse = 1;
for (j = 1; j <= nuse; j++) for (j = 1; j <= nuse; j++)
{ {
/* Get the jth local name for this symbol. */ /* Get the jth local name for this symbol. */
p = find_use_name_n (name, &j); p = find_use_name_n (name, &j, false);
if (p == NULL && strcmp (name, module_name) == 0) if (p == NULL && strcmp (name, module_name) == 0)
p = name; p = name;
...@@ -3958,7 +3965,7 @@ write_generic (gfc_symbol *sym) ...@@ -3958,7 +3965,7 @@ write_generic (gfc_symbol *sym)
sym->module = gfc_get_string (module_name); sym->module = gfc_get_string (module_name);
/* See how many use names there are. If none, use the symbol name. */ /* See how many use names there are. If none, use the symbol name. */
nuse = number_use_names (sym->name); nuse = number_use_names (sym->name, false);
if (nuse == 0) if (nuse == 0)
{ {
mio_symbol_interface (&sym->name, &sym->module, &sym->generic); mio_symbol_interface (&sym->name, &sym->module, &sym->generic);
...@@ -3968,7 +3975,7 @@ write_generic (gfc_symbol *sym) ...@@ -3968,7 +3975,7 @@ write_generic (gfc_symbol *sym)
for (j = 1; j <= nuse; j++) for (j = 1; j <= nuse; j++)
{ {
/* Get the jth local name for this symbol. */ /* Get the jth local name for this symbol. */
p = find_use_name_n (sym->name, &j); p = find_use_name_n (sym->name, &j, false);
mio_symbol_interface (&p, &sym->module, &sym->generic); mio_symbol_interface (&p, &sym->module, &sym->generic);
} }
......
2007-08-16 Tobias Burnus <burnus@net-b.de>
PR fortran/33072
* gfortran.dg/use_9.f90: New.
2007-08-16 Seongbae Park <seongbae.park@gmail.com> 2007-08-16 Seongbae Park <seongbae.park@gmail.com>
* g++.dg/gcov/gcov-5.C: New test. * g++.dg/gcov/gcov-5.C: New test.
2007-08-16 Seongbae Park <seongbae.park@gmail.com> 2007-08-16 Seongbae Park <seongbae.park@gmail.com>
...@@ -64,7 +69,7 @@ ...@@ -64,7 +69,7 @@
* g++.dg/template/crash68.C: New. * g++.dg/template/crash68.C: New.
2007-08-15 Maxim Kuvyrkov <maxim@codesourcery.com> 2007-08-15 Maxim Kuvyrkov <maxim@codesourcery.com>
* gcc.dg/sibcall-3.c: Remove m68k from XFAIL list. * gcc.dg/sibcall-3.c: Remove m68k from XFAIL list.
* gcc.dg/sibcall-4.c: Ditto. * gcc.dg/sibcall-4.c: Ditto.
! { dg-do compile }
module test
interface operator(.bar.)
module procedure func
end interface
contains
function func(a)
integer,intent(in) :: a
integer :: funct
func = a+1
end function
end module test
use test, only: operator(.func.) ! { dg-error "not found in module 'test'" }
end
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment