This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[patch, fortran] PR30096 - Fixes for entity ambiguity and interfaces (PR29975, PR30068)
- From: Paul Thomas <paulthomas2 at wanadoo dot fr>
- To: Tobias Burnus <burnus at net-b dot de>
- Cc: "'fortran at gcc dot gnu dot org'" <fortran at gcc dot gnu dot org>, gcc-patches <gcc-patches at gcc dot gnu dot org>
- Date: Sat, 09 Dec 2006 10:57:01 +0100
- Subject: [patch, fortran] PR30096 - Fixes for entity ambiguity and interfaces (PR29975, PR30068)
- References: <4579C0EE.6010403@net-b.de>
Tobias,
:ADDPATCH fortran:
Thank you truly for the help on (i) the standards issues - your thread
on comp.lang.fortran was extremely helpful in getting the advice of
Richard Maine and Malcolm Cohen; and (ii) for doing the ChangeLogs. I
hope that this latter has given you some familiarity with the inner
workings. In addition, I enjoyed the collaboration and hope that we can
do it again.
Just in case that I have screwed up this thread completely by modifying
the title, here is the link to Tobias' submission.
http://gcc.gnu.org/ml/fortran/2006-12/msg00124.html
In the course of a meeting yesterday, I realised how to fix PR30096, in
which there was confusion between local and host-associated interfaces.
The fix is a small extension of that for PR30068, so I have combined them.
Generally(always?), a local symbol has precedence over a host associated
symbol, whether local to the host or use associated. Thus, it is
incorrect to compare host associated with the local version because they
can never be ambiguous. The fix was very simple and consisted of
preventing interface.c(check_sym_interfaces) from checking host
associated interfaces with the same name - in this case, less is more
:-) The tescase, interface_9.f90 is heavily based on the reporter's
test. It has been made dg-run because the first version of the patch
silenced the error but yielded the wrong procedure call. *sigh*
Regtested on Cygwin_NT/amd64 - OK for trunk and 4.2?
Paul
2006-12-09 Paul Thomas <pault@gcc.gnu.org>
PR fortran/29975
PR fortran/30068
PR fortran/30096
* interface.c (compare_type_rank_if): Reject invalid generic
interfaces.
(check_interface1): Give a warning for nonreferred to ambiguous
interfaces.
(check_sym_interfaces): Check whether an ambiguous interface is
referred to. Do not check host associated interfaces since these
cannot be ambiguous with the local versions.
(check_uop_interface, gfc_check_interfaces): Update call to
check_interface1.
* symbol.c (gfc_get_sym_tree, gfc_get_sym_tree): Allow adding
unambiguous procedures to generic interfaces.
* gfortran.h (symbol_attribute): Added use_only and
ambiguous_interfaces.
* module.c (load_need): Set the use_only flag, if needed.
* resolve.c (resolve_fl_procedure): Warn for nonreferred
interfaces.
* expr.c (find_array_section): Fix initializer array contructor.
2006-12-09 Paul Thomas <pault@gcc.gnu.org>
Tobias Burnus <burnus@gcc.gnu.org>
PR fortran/29975
PR fortran/30068
* gfortran.dg/interface_4.f90: Test adding procedure to generic
interface.
* gfortran.dg/interface_5.f90: Test warning for not-referenced-to
ambiguous interfaces.
* gfortran.dg/interface_6.f90: Test invalid, ambiguous interface.
* gfortran.dg/interface_7.f90: Test invalid, ambiguous interface.
* gfortran.dg/interface_8.f90: Test warning for not-referenced-to
ambiguous interfaces.
* gfortran.dg/interface_1.f90: Change dg-error into a dg-warning.
* gfortran.dg/array_initializer_2.f90: Add initializer array
constructor test.
PR fortran/30096
* gfortran.dg/interface_9.f90: Test that host interfaces are
not checked for ambiguity with the local version.
Index: gcc/fortran/interface.c
===================================================================
*** gcc/fortran/interface.c (revision 119554)
--- gcc/fortran/interface.c (working copy)
*************** compare_type_rank_if (gfc_symbol * s1, g
*** 462,468 ****
if (s1->attr.function && compare_type_rank (s1, s2) == 0)
return 0;
! return compare_interfaces (s1, s2, 0); /* Recurse! */
}
--- 462,470 ----
if (s1->attr.function && compare_type_rank (s1, s2) == 0)
return 0;
! /* Originally, gfortran recursed here to check the interfaces of passed
! procedures. This is explicitly not required by the standard. */
! return 1;
}
*************** check_interface0 (gfc_interface * p, con
*** 965,971 ****
static int
check_interface1 (gfc_interface * p, gfc_interface * q0,
! int generic_flag, const char *interface_name)
{
gfc_interface * q;
for (; p; p = p->next)
--- 967,974 ----
static int
check_interface1 (gfc_interface * p, gfc_interface * q0,
! int generic_flag, const char *interface_name,
! int referenced)
{
gfc_interface * q;
for (; p; p = p->next)
*************** check_interface1 (gfc_interface * p, gfc
*** 979,990 ****
if (compare_interfaces (p->sym, q->sym, generic_flag))
{
! gfc_error ("Ambiguous interfaces '%s' and '%s' in %s at %L",
! p->sym->name, q->sym->name, interface_name, &p->where);
return 1;
}
}
-
return 0;
}
--- 982,1001 ----
if (compare_interfaces (p->sym, q->sym, generic_flag))
{
! if (referenced)
! {
! gfc_error ("Ambiguous interfaces '%s' and '%s' in %s at %L",
! p->sym->name, q->sym->name, interface_name,
! &p->where);
! }
!
! if (!p->sym->attr.use_assoc && q->sym->attr.use_assoc)
! gfc_warning ("Ambiguous interfaces '%s' and '%s' in %s at %L",
! p->sym->name, q->sym->name, interface_name,
! &p->where);
return 1;
}
}
return 0;
}
*************** static void
*** 997,1003 ****
check_sym_interfaces (gfc_symbol * sym)
{
char interface_name[100];
! gfc_symbol *s2;
if (sym->ns != gfc_current_ns)
return;
--- 1008,1014 ----
check_sym_interfaces (gfc_symbol * sym)
{
char interface_name[100];
! int k;
if (sym->ns != gfc_current_ns)
return;
*************** check_sym_interfaces (gfc_symbol * sym)
*** 1008,1024 ****
if (check_interface0 (sym->generic, interface_name))
return;
! s2 = sym;
! while (s2 != NULL)
! {
! if (check_interface1 (sym->generic, s2->generic, 1, interface_name))
! return;
!
! if (s2->ns->parent == NULL)
! break;
! if (gfc_find_symbol (sym->name, s2->ns->parent, 1, &s2))
! break;
! }
}
}
--- 1019,1031 ----
if (check_interface0 (sym->generic, interface_name))
return;
! /* Originally, this test was aplied to host interfaces too;
! this is incorrect since host associated symbols, from any
! source, cannot be ambiguous with local symbols. */
! k = sym->attr.referenced || !sym->attr.use_assoc;
! if (check_interface1 (sym->generic, sym->generic, 1,
! interface_name, k))
! sym->attr.ambiguous_interfaces = 1;
}
}
*************** check_uop_interfaces (gfc_user_op * uop)
*** 1040,1046 ****
if (uop2 == NULL)
continue;
! check_interface1 (uop->operator, uop2->operator, 0, interface_name);
}
}
--- 1047,1054 ----
if (uop2 == NULL)
continue;
! check_interface1 (uop->operator, uop2->operator, 0,
! interface_name, 1);
}
}
*************** gfc_check_interfaces (gfc_namespace * ns
*** 1082,1088 ****
for (ns2 = ns->parent; ns2; ns2 = ns2->parent)
if (check_interface1 (ns->operator[i], ns2->operator[i], 0,
! interface_name))
break;
}
--- 1090,1096 ----
for (ns2 = ns->parent; ns2; ns2 = ns2->parent)
if (check_interface1 (ns->operator[i], ns2->operator[i], 0,
! interface_name, 1))
break;
}
Index: gcc/fortran/symbol.c
===================================================================
*** gcc/fortran/symbol.c (revision 119554)
--- gcc/fortran/symbol.c (working copy)
*************** gfc_find_sym_tree (const char *name, gfc
*** 2036,2042 ****
if (st != NULL)
{
*result = st;
! if (st->ambiguous)
{
ambiguous_symbol (name, st);
return 1;
--- 2036,2044 ----
if (st != NULL)
{
*result = st;
! /* Ambiguous generic interfaces are permitted, as long
! as the specific interfaces are different. */
! if (st->ambiguous && !st->n.sym->attr.generic)
{
ambiguous_symbol (name, st);
return 1;
*************** gfc_get_sym_tree (const char *name, gfc_
*** 2137,2144 ****
}
else
{
! /* Make sure the existing symbol is OK. */
! if (st->ambiguous)
{
ambiguous_symbol (name, st);
return 1;
--- 2139,2148 ----
}
else
{
! /* Make sure the existing symbol is OK. Ambiguous
! generic interfaces are permitted, as long as the
! specific interfaces are different. */
! if (st->ambiguous && !st->n.sym->attr.generic)
{
ambiguous_symbol (name, st);
return 1;
Index: gcc/fortran/gfortran.h
===================================================================
*** gcc/fortran/gfortran.h (revision 119554)
--- gcc/fortran/gfortran.h (working copy)
*************** typedef struct
*** 483,489 ****
dummy:1, result:1, assign:1, threadprivate:1;
unsigned data:1, /* Symbol is named in a DATA statement. */
! use_assoc:1; /* Symbol has been use-associated. */
unsigned in_namelist:1, in_common:1, in_equivalence:1;
unsigned function:1, subroutine:1, generic:1;
--- 483,490 ----
dummy:1, result:1, assign:1, threadprivate:1;
unsigned data:1, /* Symbol is named in a DATA statement. */
! use_assoc:1, /* Symbol has been use-associated. */
! use_only:1; /* Symbol has been use-associated, with ONLY. */
unsigned in_namelist:1, in_common:1, in_equivalence:1;
unsigned function:1, subroutine:1, generic:1;
*************** typedef struct
*** 518,523 ****
--- 519,527 ----
modification of type or type parameters is permitted. */
unsigned referenced:1;
+ /* Set if the symbol has ambiguous interfaces. */
+ unsigned ambiguous_interfaces:1;
+
/* Set if the is the symbol for the main program. This is the least
cumbersome way to communicate this function property without
strcmp'ing with __MAIN everywhere. */
Index: gcc/fortran/expr.c
===================================================================
*** gcc/fortran/expr.c (revision 119554)
--- gcc/fortran/expr.c (working copy)
*************** find_array_section (gfc_expr *expr, gfc_
*** 1189,1195 ****
for (d = 0; d < rank; d++)
{
mpz_set (tmp_mpz, ctr[d]);
! mpz_sub_ui (tmp_mpz, tmp_mpz, one);
mpz_mul (tmp_mpz, tmp_mpz, delta[d]);
mpz_add (ptr, ptr, tmp_mpz);
--- 1189,1196 ----
for (d = 0; d < rank; d++)
{
mpz_set (tmp_mpz, ctr[d]);
! mpz_sub (tmp_mpz, tmp_mpz,
! ref->u.ar.as->lower[d]->value.integer);
mpz_mul (tmp_mpz, tmp_mpz, delta[d]);
mpz_add (ptr, ptr, tmp_mpz);
Index: gcc/fortran/module.c
===================================================================
*** gcc/fortran/module.c (revision 119554)
--- gcc/fortran/module.c (working copy)
*************** load_needed (pointer_info * p)
*** 3212,3217 ****
--- 3212,3219 ----
mio_symbol (sym);
sym->attr.use_assoc = 1;
+ if (only_flag)
+ sym->attr.use_only = 1;
return 1;
}
Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c (revision 119554)
--- gcc/fortran/resolve.c (working copy)
*************** resolve_fl_procedure (gfc_symbol *sym, i
*** 5525,5530 ****
--- 5525,5534 ----
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 "
+ "interfaces", sym->name, &sym->declared_at);
+
if (sym->attr.function
&& resolve_fl_var_and_proc (sym, mp_flag) == FAILURE)
return FAILURE;
Index: gcc/testsuite/gfortran.dg/interface_4.f90
===================================================================
*** gcc/testsuite/gfortran.dg/interface_4.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/interface_4.f90 (revision 0)
***************
*** 0 ****
--- 1,46 ----
+ ! { dg-do run }
+ ! Tests the fix for the interface bit of PR29975, in which the
+ ! interfaces bl_copy were rejected as ambiguous, even though
+ ! they import different specific interfaces.
+ !
+ ! Contributed by Joost VandeVondele <jv244@cam.ac.uk> and
+ ! simplified by Tobias Burnus <burnus@gcc.gnu.org>
+ !
+ SUBROUTINE RECOPY(N, c)
+ real, INTENT(IN) :: N
+ character(6) :: c
+ c = "recopy"
+ END SUBROUTINE RECOPY
+
+ MODULE f77_blas_extra
+ PUBLIC :: BL_COPY
+ INTERFACE BL_COPY
+ MODULE PROCEDURE SDCOPY
+ END INTERFACE BL_COPY
+ CONTAINS
+ SUBROUTINE SDCOPY(N, c)
+ INTEGER, INTENT(IN) :: N
+ character(6) :: c
+ c = "sdcopy"
+ END SUBROUTINE SDCOPY
+ END MODULE f77_blas_extra
+
+ MODULE f77_blas_generic
+ INTERFACE BL_COPY
+ SUBROUTINE RECOPY(N, c)
+ real, INTENT(IN) :: N
+ character(6) :: c
+ END SUBROUTINE RECOPY
+ END INTERFACE BL_COPY
+ END MODULE f77_blas_generic
+
+ program main
+ USE f77_blas_extra
+ USE f77_blas_generic
+ character(6) :: chr
+ call bl_copy(1, chr)
+ if (chr /= "sdcopy") call abort ()
+ call bl_copy(1.0, chr)
+ if (chr /= "recopy") call abort ()
+ end program main
+ ! { dg-final { cleanup-modules "f77_blas_generic f77_blas_extra" } }
Index: gcc/testsuite/gfortran.dg/interface_5.f90
===================================================================
*** gcc/testsuite/gfortran.dg/interface_5.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/interface_5.f90 (revision 0)
***************
*** 0 ****
--- 1,56 ----
+ ! { dg-do compile }
+ ! Tests the fix for the interface bit of PR29975, in which the
+ ! interfaces bl_copy were rejected as ambiguous, even though
+ ! they import different specific interfaces. In this testcase,
+ ! it is verified that ambiguous specific interfaces are caught.
+ !
+ ! Contributed by Joost VandeVondele <jv244@cam.ac.uk> and
+ ! simplified by Tobias Burnus <burnus@gcc.gnu.org>
+ !
+ SUBROUTINE RECOPY(N, c)
+ real, INTENT(IN) :: N
+ character(6) :: c
+ print *, n
+ c = "recopy"
+ END SUBROUTINE RECOPY
+
+ MODULE f77_blas_extra
+ PUBLIC :: BL_COPY
+ INTERFACE BL_COPY
+ MODULE PROCEDURE SDCOPY
+ END INTERFACE BL_COPY
+ CONTAINS
+ SUBROUTINE SDCOPY(N, c)
+ REAL, INTENT(IN) :: N
+ character(6) :: c
+ print *, n
+ c = "sdcopy"
+ END SUBROUTINE SDCOPY
+ END MODULE f77_blas_extra
+
+ MODULE f77_blas_generic
+ INTERFACE BL_COPY
+ SUBROUTINE RECOPY(N, c)
+ real, INTENT(IN) :: N
+ character(6) :: c
+ END SUBROUTINE RECOPY
+ END INTERFACE BL_COPY
+ END MODULE f77_blas_generic
+
+ subroutine i_am_ok
+ USE f77_blas_extra ! { dg-warning "ambiguous interfaces" }
+ USE f77_blas_generic
+ character(6) :: chr
+ chr = ""
+ if (chr /= "recopy") call abort ()
+ end subroutine i_am_ok
+
+ program main
+ USE f77_blas_extra ! { dg-error "Ambiguous interfaces" }
+ USE f77_blas_generic
+ character(6) :: chr
+ chr = ""
+ call bl_copy(1.0, chr)
+ if (chr /= "recopy") call abort ()
+ end program main
+ ! { dg-final { cleanup-modules "f77_blas_generic f77_blas_extra" } }
Index: gcc/testsuite/gfortran.dg/interface_6.f90
===================================================================
*** gcc/testsuite/gfortran.dg/interface_6.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/interface_6.f90 (revision 0)
***************
*** 0 ****
--- 1,24 ----
+ ! { dg-do compile }
+ ! One of the tests of the patch for PR30068.
+ ! Taken from the fortran standard.
+ !
+ ! The standard specifies that the optional arguments should be
+ ! ignored in the counting of like type/kind, so the specific
+ ! procedures below are invalid, even though actually unambiguous.
+ !
+ INTERFACE BAD8
+ SUBROUTINE S8A(X,Y,Z)
+ REAL,OPTIONAL :: X
+ INTEGER :: Y
+ REAL :: Z
+ END SUBROUTINE S8A
+ SUBROUTINE S8B(X,Z,Y)
+ INTEGER,OPTIONAL :: X
+ INTEGER :: Z
+ REAL :: Y
+ END SUBROUTINE S8B ! { dg-error "Ambiguous interfaces" }
+ END INTERFACE BAD8
+ real :: a, b
+ integer :: i, j
+ call bad8(x,i,b)
+ end
Index: gcc/testsuite/gfortran.dg/generic_7.f90
===================================================================
*** gcc/testsuite/gfortran.dg/generic_7.f90 (revision 119554)
--- gcc/testsuite/gfortran.dg/generic_7.f90 (working copy)
*************** CONTAINS
*** 24,27 ****
--- 24,28 ----
WRITE(*,*) x, y
END SUBROUTINE
END MODULE
+
! { dg-final { cleanup-modules "global" } }
Index: gcc/testsuite/gfortran.dg/interface_7.f90
===================================================================
*** gcc/testsuite/gfortran.dg/interface_7.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/interface_7.f90 (revision 0)
***************
*** 0 ****
--- 1,32 ----
+ ! { dg-do compile }
+ ! One of the tests of the patch for PR30068.
+ ! Taken from the fortran standard.
+ !
+ ! The interface is invalid although it is unambiguous because the
+ ! 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
+ END SUBROUTINE S9A
+ SUBROUTINE S9B(X)
+ INTERFACE
+ FUNCTION X(A)
+ REAL :: X,A
+ END FUNCTION X
+ END INTERFACE
+ END SUBROUTINE S9B
+ SUBROUTINE S9C(X)
+ INTERFACE
+ FUNCTION X(A)
+ REAL :: X
+ INTEGER :: A
+ END FUNCTION X
+ END INTERFACE
+ END SUBROUTINE S9C ! { dg-error "Ambiguous interfaces" }
+ END INTERFACE BAD9
+ end module x
+
+ ! { dg-final { cleanup-modules "x" } }
Index: gcc/testsuite/gfortran.dg/interface_8.f90
===================================================================
*** gcc/testsuite/gfortran.dg/interface_8.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/interface_8.f90 (revision 0)
***************
*** 0 ****
--- 1,30 ----
+ ! { dg-do compile }
+ ! One of the tests of the patch for PR30068.
+ ! Taken from the fortran standard.
+ !
+ ! Although the generic procedure is not referenced and it would
+ ! normally be permissible for it to be ambiguous, the USE, ONLY
+ ! statement is effectively a reference and is invalid.
+ !
+ module mod1
+ interface generic
+ subroutine foo(a)
+ real :: a
+ end subroutine
+ end interface generic
+ end module mod1
+
+ module mod2
+ interface generic
+ subroutine bar(a)
+ real :: a
+ end subroutine
+ end interface generic
+ end module mod2
+
+ program main
+ use mod1, only: generic ! { dg-warning "has ambiguous interfaces" }
+ use mod2
+ end program main
+
+ ! { dg-final { cleanup-modules "mod1 mod2" } }
Index: gcc/testsuite/gfortran.dg/array_initializer_2.f90
===================================================================
*** gcc/testsuite/gfortran.dg/array_initializer_2.f90 (revision 119554)
--- gcc/testsuite/gfortran.dg/array_initializer_2.f90 (working copy)
***************
*** 2,7 ****
--- 2,11 ----
! Tests the fix for PR28496 in which initializer array constructors with
! a missing initial array index would cause an ICE.
!
+ ! Test for the fix of the initializer array constructor part of PR29975
+ ! was added later. Here, the indexing would get in a mess if the array
+ ! specification had a lower bound other than unity.
+ !
! Contributed by Paul Thomas <pault@gcc.gnu.org>
! Based on original test case from Samir Nordin <snordin_ng@yahoo.fr>
!
***************
*** 11,17 ****
--- 15,31 ----
integer, dimension(2,3), parameter :: d=reshape ((/c(3:2:-1,:)/),(/2,3/))
integer, dimension(3,3), parameter :: e=reshape ((/a(:),a(:)+3,a(:)+6/),(/3,3/))
integer, dimension(2,3), parameter :: f=reshape ((/c(2:1:-1,:)/),(/2,3/))
+ CHARACTER (LEN=1), DIMENSION(3:7), PARAMETER :: g = &
+ (/ '+', '-', '*', '/', '^' /)
+ CHARACTER (LEN=3) :: h = "A+C"
+ !
+ ! PR28496
+ !
if (any (b .ne. (/1,2,3/))) call abort ()
if (any (reshape(d,(/6/)) .ne. (/3, 2, 6, 5, 9, 8/))) call abort ()
if (any (reshape(f,(/6/)) .ne. (/2, 1, 5, 4, 8, 7/))) call abort ()
+ !
+ ! PR29975
+ !
+ IF (all(h(2:2) /= g(3:4))) call abort ()
end
Index: gcc/testsuite/gfortran.dg/interface_1.f90
===================================================================
*** gcc/testsuite/gfortran.dg/interface_1.f90 (revision 119554)
--- gcc/testsuite/gfortran.dg/interface_1.f90 (working copy)
*************** module z
*** 27,33 ****
use y
interface ambiguous
! module procedure f ! { dg-error "in generic interface" "" }
end interface
contains
--- 27,33 ----
use y
interface ambiguous
! module procedure f ! { dg-warning "in generic interface" "" }
end interface
contains
Index: gcc/testsuite/gfortran.dg/interface_9.f90
===================================================================
*** gcc/testsuite/gfortran.dg/interface_9.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/interface_9.f90 (revision 0)
***************
*** 0 ****
--- 1,47 ----
+ ! { dg-do compile }
+ ! Test of the patch for PR30096, in which gfortran incorrectly.
+ ! compared local with host associated interfaces.
+ !
+ ! Based on contribution by Harald Anlauf <anlauf@gmx.de>
+ !
+ module module1
+ interface inverse
+ module procedure A, B
+ end interface
+ contains
+ function A (X) result (Y)
+ real :: X, Y
+ Y = 1.0
+ end function A
+ function B (X) result (Y)
+ integer :: X, Y
+ Y = 3
+ end function B
+ end module module1
+
+ module module2
+ interface inverse
+ module procedure C
+ end interface
+ contains
+ function C (X) result (Y)
+ real :: X, Y
+ Y = 2.0
+ end function C
+ end module module2
+
+ program gfcbug48
+ use module1, only : inverse
+ call sub ()
+ if (inverse(1.0_4) /= 1.0_4) call abort ()
+ if (inverse(1_4) /= 3_4) call abort ()
+ contains
+ subroutine sub ()
+ use module2, only : inverse
+ if (inverse(1.0_4) /= 2.0_4) call abort ()
+ if (inverse(1_4) /= 3_4) call abort ()
+ end subroutine sub
+ end program gfcbug48
+
+ ! { dg-final { cleanup-modules "module1 module2" } }
+