This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Patch, fortran] PR20896 and PR25135 - last two interface patches
- From: Paul Thomas <paulthomas2 at wanadoo dot fr>
- To: gcc-patches <gcc-patches at gcc dot gnu dot org>, Fortran List <fortran at gcc dot gnu dot org>
- Date: Tue, 26 Dec 2006 15:32:03 +0100
- Subject: [Patch, fortran] PR20896 and PR25135 - last two interface patches
:ADDPATCH fortran:
This double patch fixes the last two PRs in the interface meta-bug that
are immediately amenable to repair; PR27318 will have to await global
interface checking which I will be trying to develop in the coming months.
PR20896 results from ambiguity between nameless interfaces that
themeselves contained within the specific procedures of a generic
interface. The fix consists of promoting the enclosed interface
procedures to be global symbols, since they are neither contained or use
associated and cannot be host associated; ie. the procedures themselves
must be external to the scope being compiled. Completing this fix was
delayed for a little while by a redundant error in resolve.c, which
turns out to have been an own goal :-)
PR25135 is a case of undetected ambiguity between a module procedure and
a generic interface in another module. Whilst a check is made, in
reading generic interfaces, if a same name symbol exists, it is not
marked as being ambiguous if it is. Since generic interfaces can be
accumulated from more than one module, the symtree is only marked as
ambiguous if the symbol is not generic.
The new testcases are both those of the reporters. In addition a couple
of gfortran tests had to be modified; interface_7.f90 because a
previously undetected name clash now produces an error and
dummy_procedure_1.f90 because one of the calls was previously,
incorrectly allowed, when it should be an error.
Regtested on Cygwin_NT/amd64 - OK for trunk and, in a week or so, for 4.2?
Paul
2006-12-26 Paul Thomas <pault@gcc.gnu.org>
PR fortran/20896
* interface.c (check_sym_interfaces): Try to resolve interface
reference as a global symbol, if it is not a nodule procedure.
(compare_actual_formal): Remove call to gfc_find_symbol; if
the expression is already a variable it is locally declared
and this has precedence.
gfortran.h : Add prototype for resolve_global_procedure.
resolve.c (resolve_global_procedure): Remove static attribute
from function declaration.
(resolve_fl_procedure): Remove symtree declaration and the
redundant check for an ambiguous procedure.
PR fortran/25135
* module.c (load_generic_interfaces): If the symbol is present
and is not generic it is ambiguous.
2006-12-26 Paul Thomas <pault@gcc.gnu.org>
PR fortran/20896
* gfortran.dg/interface_10.f90: New test.
* gfortran.dg/dummy_procedure_1.f90: Add error for call s1(z),
since z is already, locally a variable.
PR fortran/25135
* gfortran.dg/generic_11.f90: New test.
* gfortran.dg/interface_7.f90: Remove name clash between module
name and procedure 'x' referenced in the interface.
Index: gcc/fortran/interface.c
===================================================================
*** gcc/fortran/interface.c (revision 120187)
--- gcc/fortran/interface.c (working copy)
*************** check_sym_interfaces (gfc_symbol * sym)
*** 1016,1021 ****
--- 1016,1026 ----
if (sym->ns != gfc_current_ns)
return;
+ if (sym->attr.if_source == IFSRC_IFBODY
+ && sym->attr.flavor == FL_PROCEDURE
+ && !sym->attr.mod_proc)
+ resolve_global_procedure (sym, &sym->declared_at, sym->attr.subroutine);
+
if (sym->generic != NULL)
{
sprintf (interface_name, "generic interface '%s'", sym->name);
*************** compare_actual_formal (gfc_actual_arglis
*** 1371,1386 ****
&& a->expr->expr_type == EXPR_VARIABLE
&& f->sym->attr.flavor == FL_PROCEDURE)
{
! gsym = gfc_find_gsymbol (gfc_gsym_root,
! a->expr->symtree->n.sym->name);
! if (gsym == NULL || (gsym->type != GSYM_FUNCTION
! && gsym->type != GSYM_SUBROUTINE))
! {
! if (where)
! gfc_error ("Expected a procedure for argument '%s' at %L",
! f->sym->name, &a->expr->where);
! return 0;
! }
}
if (f->sym->attr.flavor == FL_PROCEDURE
--- 1376,1385 ----
&& a->expr->expr_type == EXPR_VARIABLE
&& f->sym->attr.flavor == FL_PROCEDURE)
{
! if (where)
! gfc_error ("Expected a procedure for argument '%s' at %L",
! f->sym->name, &a->expr->where);
! return 0;
}
if (f->sym->attr.flavor == FL_PROCEDURE
Index: gcc/fortran/gfortran.h
===================================================================
*** gcc/fortran/gfortran.h (revision 120187)
--- gcc/fortran/gfortran.h (working copy)
*************** void gfc_free_statement (gfc_code *);
*** 2032,2037 ****
--- 2032,2038 ----
void gfc_free_statements (gfc_code *);
/* resolve.c */
+ void resolve_global_procedure (gfc_symbol *, locus *, int);
try gfc_resolve_expr (gfc_expr *);
void gfc_resolve (gfc_namespace *);
void gfc_resolve_blocks (gfc_code *, gfc_namespace *);
Index: gcc/fortran/module.c
===================================================================
*** gcc/fortran/module.c (revision 120187)
--- gcc/fortran/module.c (working copy)
*************** load_generic_interfaces (void)
*** 3090,3095 ****
--- 3090,3105 ----
sym->attr.generic = 1;
sym->attr.use_assoc = 1;
}
+ else
+ {
+ /* Unless sym is a generic interface, this reference
+ is ambiguous. */
+ gfc_symtree *st;
+ p = p ? p : name;
+ st = gfc_find_symtree (gfc_current_ns->sym_root, p);
+ st->ambiguous = sym->attr.generic ? 0 : 1;
+ }
+
if (i == 1)
{
mio_interface_rest (&sym->generic);
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c (revision 120187)
--- gcc/fortran/resolve.c (working copy)
*************** find_noncopying_intrinsics (gfc_symbol *
*** 1156,1162 ****
reference. The corresponding code that is called in creating
global entities is parse.c. */
! static void
resolve_global_procedure (gfc_symbol *sym, locus *where, int sub)
{
gfc_gsymbol * gsym;
--- 1156,1162 ----
reference. The corresponding code that is called in creating
global entities is parse.c. */
! void
resolve_global_procedure (gfc_symbol *sym, locus *where, int sub)
{
gfc_gsymbol * gsym;
*************** static try
*** 5560,5566 ****
resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
{
gfc_formal_arglist *arg;
- gfc_symtree *st;
if (sym->attr.ambiguous_interfaces && !sym->attr.referenced)
gfc_warning ("Although not referenced, '%s' at %L has ambiguous "
--- 5560,5565 ----
*************** resolve_fl_procedure (gfc_symbol *sym, i
*** 5570,5585 ****
&& resolve_fl_var_and_proc (sym, mp_flag) == FAILURE)
return FAILURE;
- st = gfc_find_symtree (gfc_current_ns->sym_root, sym->name);
- if (st && st->ambiguous
- && sym->attr.referenced
- && !sym->attr.generic)
- {
- gfc_error ("Procedure %s at %L is ambiguous",
- sym->name, &sym->declared_at);
- return FAILURE;
- }
-
if (sym->ts.type == BT_CHARACTER)
{
gfc_charlen *cl = sym->ts.cl;
--- 5569,5574 ----
Index: gcc/testsuite/gfortran.dg/generic_11.f90
===================================================================
*** gcc/testsuite/gfortran.dg/generic_11.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/generic_11.f90 (revision 0)
***************
*** 0 ****
--- 1,31 ----
+ ! { dg-do compile }
+ ! Test the fix for PR25135 in which the ambiguity between subroutine
+ ! foo in m_foo and interface foo in m_bar was not recognised.
+ !
+ !Contributed by Yusuke IGUCHI <iguchi@coral.t.u-tokyo.ac.jp>
+ !
+ module m_foo
+ contains
+ subroutine foo
+ print *, "foo"
+ end subroutine
+ end module
+
+ module m_bar
+ interface foo
+ module procedure bar
+ end interface
+ contains
+ subroutine bar
+ print *, "bar"
+ end subroutine
+ end module
+
+ use m_foo
+ use m_bar
+
+ call foo ! { dg-error "is an ambiguous reference" }
+ end
+ ! { dg-final { cleanup-modules "m_foo m_bar" } }
+
+
Index: gcc/testsuite/gfortran.dg/dummy_procedure_1.f90
===================================================================
*** gcc/testsuite/gfortran.dg/dummy_procedure_1.f90 (revision 120187)
--- gcc/testsuite/gfortran.dg/dummy_procedure_1.f90 (working copy)
*************** end module m1
*** 37,43 ****
call s1(w) ! { dg-error "not allowed as an actual argument" }
call s1(x) ! explicit interface
call s1(y) ! declared external
! call s1(z) ! already compiled
contains
integer function w()
w = 1
--- 37,43 ----
call s1(w) ! { dg-error "not allowed as an actual argument" }
call s1(x) ! explicit interface
call s1(y) ! declared external
! call s1(z) ! { dg-error "Expected a procedure for argument" }
contains
integer function w()
w = 1
Index: gcc/testsuite/gfortran.dg/interface_7.f90
===================================================================
*** gcc/testsuite/gfortran.dg/interface_7.f90 (revision 120187)
--- gcc/testsuite/gfortran.dg/interface_7.f90 (working copy)
***************
*** 6,12 ****
! standard explicitly does not require recursion into the formal
! arguments of procedures that themselves are interface arguments.
!
! module x
INTERFACE BAD9
SUBROUTINE S9A(X)
REAL :: X
--- 6,12 ----
! standard explicitly does not require recursion into the formal
! arguments of procedures that themselves are interface arguments.
!
! module xx
INTERFACE BAD9
SUBROUTINE S9A(X)
REAL :: X
*************** module x
*** 27,32 ****
END INTERFACE
END SUBROUTINE S9C ! { dg-error "Ambiguous interfaces" }
END INTERFACE BAD9
! end module x
! ! { dg-final { cleanup-modules "x" } }
--- 27,32 ----
END INTERFACE
END SUBROUTINE S9C ! { dg-error "Ambiguous interfaces" }
END INTERFACE BAD9
! end module xx
! ! { dg-final { cleanup-modules "xx" } }
Index: gcc/testsuite/gfortran.dg/interface_10.f90
===================================================================
*** gcc/testsuite/gfortran.dg/interface_10.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/interface_10.f90 (revision 0)
***************
*** 0 ****
--- 1,33 ----
+ ! { dg-do compile }
+ ! Test the fix for PR20896 in which the ambiguous use
+ ! of p was not detected.
+ !
+ ! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+ !
+ INTERFACE g
+ SUBROUTINE s1(p) ! { dg-error "is already being used" }
+ INTERFACE
+ SUBROUTINE p
+ END
+ END INTERFACE
+ END
+ SUBROUTINE s2(p) ! { dg-error "Global name" }
+ INTERFACE
+ REAL FUNCTION p()
+ END
+ END INTERFACE
+ END
+ END INTERFACE
+
+ INTERFACE
+ REAL FUNCTION x()
+ END
+ END INTERFACE
+ INTERFACE
+ SUBROUTINE y
+ END
+ END INTERFACE
+ call g (x)
+ call g (y)
+ END
+