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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@119697
138bc75d-0d04-0410-961f-
82ee72b054a4
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>
+
PR fortran/29464
* module.c (load_generic_interfaces): Add symbols for all the
local names of an interface. Share the interface amongst the
for (d = 0; d < rank; d++)
{
mpz_set (tmp_mpz, ctr[d]);
- mpz_sub_ui (tmp_mpz, tmp_mpz, one);
+ 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);
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_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, generic_copy:1;
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. */
if (s1->attr.function && compare_type_rank (s1, s2) == 0)
return 0;
- return compare_interfaces (s1, s2, 0); /* Recurse! */
+ /* Originally, gfortran recursed here to check the interfaces of passed
+ procedures. This is explicitly not required by the standard. */
+ return 1;
}
static int
check_interface1 (gfc_interface * p, gfc_interface * q0,
- int generic_flag, const char *interface_name)
+ int generic_flag, const char *interface_name,
+ int referenced)
{
gfc_interface * q;
for (; p; p = p->next)
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);
+ 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;
}
check_sym_interfaces (gfc_symbol * sym)
{
char interface_name[100];
- gfc_symbol *s2;
+ int k;
if (sym->ns != gfc_current_ns)
return;
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;
- }
+ /* 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;
}
}
if (uop2 == NULL)
continue;
- check_interface1 (uop->operator, uop2->operator, 0, interface_name);
+ check_interface1 (uop->operator, uop2->operator, 0,
+ interface_name, 1);
}
}
for (ns2 = ns->parent; ns2; ns2 = ns2->parent)
if (check_interface1 (ns->operator[i], ns2->operator[i], 0,
- interface_name))
+ interface_name, 1))
break;
}
mio_symbol (sym);
sym->attr.use_assoc = 1;
+ if (only_flag)
+ sym->attr.use_only = 1;
return 1;
}
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;
if (st != NULL)
{
*result = st;
- if (st->ambiguous)
+ /* 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;
}
else
{
- /* Make sure the existing symbol is OK. */
- if (st->ambiguous)
+ /* 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;
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.
+
+2006-12-09 Paul Thomas <pault@gcc.gnu.org>
PR fortran/29464
* gfortran.dg/module_interface_2.f90: New test.
! 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>
!
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
WRITE(*,*) x, y
END SUBROUTINE
END MODULE
+
! { dg-final { cleanup-modules "global" } }
use y
interface ambiguous
- module procedure f ! { dg-error "in generic interface" "" }
+ module procedure f ! { dg-warning "in generic interface" "" }
end interface
contains
--- /dev/null
+! { 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" } }
--- /dev/null
+! { 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" } }
--- /dev/null
+! { dg-do compile }
+! One of the tests of the patch for PR30068.
+! Taken from the fortran 2003 standard C11.2.
+!
+! 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
--- /dev/null
+! { dg-do compile }
+! One of the tests of the patch for PR30068.
+! Taken from the fortran 2003 standard C11.2.
+!
+! 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" } }
--- /dev/null
+! { dg-do compile }
+! One of the tests of the patch for PR30068.
+! Taken from comp.lang.fortran 3rd December 2006.
+!
+! 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" } }
--- /dev/null
+! { 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" } }
+
projects / platform / upstream / linaro-gcc.git / commitdiff