re PR other/29975 ([meta-bugs] ICEs with CP2K)

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.

Co-Authored-By: Tobias Burnus <burnus@gcc.gnu.org>

From-SVN: r119697
This commit is contained in:
Paul Thomas 2006-12-09 21:13:29 +00:00
parent 1027275d2e
commit 993ef28f82
17 changed files with 342 additions and 25 deletions

View File

@ -1,3 +1,26 @@
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

View File

@ -1189,7 +1189,8 @@ find_array_section (gfc_expr *expr, gfc_ref *ref)
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);

View File

@ -483,7 +483,8 @@ typedef struct
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;
@ -518,6 +519,9 @@ typedef struct
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. */

View File

@ -462,7 +462,9 @@ compare_type_rank_if (gfc_symbol * s1, gfc_symbol * s2)
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;
}
@ -965,7 +967,8 @@ check_interface0 (gfc_interface * p, const char *interface_name)
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)
@ -979,12 +982,20 @@ check_interface1 (gfc_interface * p, gfc_interface * q0,
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;
}
@ -997,7 +1008,7 @@ static void
check_sym_interfaces (gfc_symbol * sym)
{
char interface_name[100];
gfc_symbol *s2;
int k;
if (sym->ns != gfc_current_ns)
return;
@ -1008,17 +1019,13 @@ check_sym_interfaces (gfc_symbol * sym)
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;
}
}
@ -1040,7 +1047,8 @@ check_uop_interfaces (gfc_user_op * uop)
if (uop2 == NULL)
continue;
check_interface1 (uop->operator, uop2->operator, 0, interface_name);
check_interface1 (uop->operator, uop2->operator, 0,
interface_name, 1);
}
}
@ -1082,7 +1090,7 @@ gfc_check_interfaces (gfc_namespace * ns)
for (ns2 = ns->parent; ns2; ns2 = ns2->parent)
if (check_interface1 (ns->operator[i], ns2->operator[i], 0,
interface_name))
interface_name, 1))
break;
}

View File

@ -3228,6 +3228,8 @@ load_needed (pointer_info * p)
mio_symbol (sym);
sym->attr.use_assoc = 1;
if (only_flag)
sym->attr.use_only = 1;
return 1;
}

View File

@ -5528,6 +5528,10 @@ 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 "
"interfaces", sym->name, &sym->declared_at);
if (sym->attr.function
&& resolve_fl_var_and_proc (sym, mp_flag) == FAILURE)
return FAILURE;

View File

@ -2037,7 +2037,9 @@ gfc_find_sym_tree (const char *name, gfc_namespace * ns, int parent_flag,
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;
@ -2138,8 +2140,10 @@ gfc_get_sym_tree (const char *name, gfc_namespace * ns, gfc_symtree ** result)
}
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;

View File

@ -1,3 +1,24 @@
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

View File

@ -2,6 +2,10 @@
! 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,7 +15,17 @@
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

View File

@ -24,4 +24,5 @@ CONTAINS
WRITE(*,*) x, y
END SUBROUTINE
END MODULE
! { dg-final { cleanup-modules "global" } }

View File

@ -27,7 +27,7 @@ module z
use y
interface ambiguous
module procedure f ! { dg-error "in generic interface" "" }
module procedure f ! { dg-warning "in generic interface" "" }
end interface
contains

View File

@ -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" } }

View File

@ -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" } }

View File

@ -0,0 +1,24 @@
! { 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

View File

@ -0,0 +1,32 @@
! { 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" } }

View File

@ -0,0 +1,30 @@
! { 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" } }

View File

@ -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" } }