This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[Patch, fortran] PR29975 - [meta-bugs] ICEs with CP2K
- From: Paul Thomas <paulthomas2 at wanadoo dot fr>
- To: Fortran List <fortran at gcc dot gnu dot org>, gcc-patches <gcc-patches at gcc dot gnu dot org>
- Date: Tue, 05 Dec 2006 20:14:12 +0100
- Subject: [Patch, fortran] PR29975 - [meta-bugs] ICEs with CP2K
:ADDPATCH fortran:
This, at the moment anyway, is a triple bug. A fourth, offshoot, has
become PR30068.
The first is an easy one. expr.c (find_array_section) failed if the
array had a lower bound that was not unity. This was simply an error in
the pointer arithmetic and was fixed by substituting 1 in the expression
for the pointer by the lower bound. array_initializer_2.f90 was
extended to fix this.
The second bug was slightly more complicated. generic interfaces can be
ambiguous if they do not contain ambiguous specific procedures. This
part of the patch is fixed in symbol.c by not raising the error if the
symbol is generic. Then the third part concerned the conditions in
which ambiguous interfaces can cause an error - in essence, they must be
referenced. This allows correct use of two modules for other things
than the ambiguous interfaces that they contain. Finally, other
compilers, a warning is omitted for an ambiguous interface, where only
one is use associated, even if they are not referenced. All this is
done in interface.c. Two new tests have been added and two were
corrected; one by adding a reference to the ambiguous interfaces and
another by changing an error to a warning.
Regtested on Cygwin_NT/amd64.
OK for trunk and, after a delay, 4.2?
Paul
2006-12-05 Paul Thomas <pault@gcc.gnu.org>
PR fortran/29975
* interface.c (check_interface1): Add referenced arg. It is an
error if the interfaces are ambiguous and referenced. For an
ambiguous, use associated interface in the scope of its
ambiguous partner emit an error.
(check_sym_interfaces): Add the referenced attribute to the
arguments of the call to check_interface1.
(check_uop_interfaces, gfc_check_interfaces): Likewise set the
referenced argument to 1.
* symbol.c (gfc_find_sym_tree, gfc_get_sym_tree): Ignore the
ambiguity if the symbol has the attribute generic.
* expr.c (find_array_section): Use array lower bound, rather
than unity, to work out the position in the array.
2006-12-05 Paul Thomas <pault@gcc.gnu.org>
PR fortran/29975
* gfortran.dg/interface_4.f90: New test.
* gfortran.dg/interface_5.f90: New test.
* gfortran.dg/generic_7.f90: Add a reference to the ambigous
interface and move the error there.
* gfortran.dg/array_initializer_2.f90: Add a test for an array
whose lbound is not unity.
Index: gcc/fortran/interface.c
===================================================================
*** gcc/fortran/interface.c (revision 119545)
--- gcc/fortran/interface.c (working copy)
*************** 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)
--- 965,972 ----
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,987 ****
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;
}
}
--- 980,997 ----
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);
! return 1;
! }
!
! 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);
}
}
*************** check_sym_interfaces (gfc_symbol * sym)
*** 1011,1017 ****
s2 = sym;
while (s2 != NULL)
{
! if (check_interface1 (sym->generic, s2->generic, 1, interface_name))
return;
if (s2->ns->parent == NULL)
--- 1021,1028 ----
s2 = sym;
while (s2 != NULL)
{
! if (check_interface1 (sym->generic, s2->generic, 1,
! interface_name, sym->attr.referenced))
return;
if (s2->ns->parent == NULL)
*************** check_uop_interfaces (gfc_user_op * uop)
*** 1040,1046 ****
if (uop2 == NULL)
continue;
! check_interface1 (uop->operator, uop2->operator, 0, interface_name);
}
}
--- 1051,1058 ----
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;
}
--- 1094,1100 ----
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 119545)
--- 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/expr.c
===================================================================
*** gcc/fortran/expr.c (revision 119545)
--- 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/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 ! bl_copy is not referenced
+ 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/generic_7.f90
===================================================================
*** gcc/testsuite/gfortran.dg/generic_7.f90 (revision 119545)
--- gcc/testsuite/gfortran.dg/generic_7.f90 (working copy)
***************
*** 7,13 ****
MODULE global
INTERFACE iface
MODULE PROCEDURE sub_a
! MODULE PROCEDURE sub_b ! { dg-error "Ambiguous interfaces" }
MODULE PROCEDURE sub_c
END INTERFACE
CONTAINS
--- 7,13 ----
MODULE global
INTERFACE iface
MODULE PROCEDURE sub_a
! MODULE PROCEDURE sub_b
MODULE PROCEDURE sub_c
END INTERFACE
CONTAINS
*************** CONTAINS
*** 24,27 ****
--- 24,31 ----
WRITE(*,*) x, y
END SUBROUTINE
END MODULE
+ use global ! { dg-error "Ambiguous interfaces" }
+ integer :: i
+ call iface (i)
+ end
! { dg-final { cleanup-modules "global" } }
Index: gcc/testsuite/gfortran.dg/array_initializer_2.f90
===================================================================
*** gcc/testsuite/gfortran.dg/array_initializer_2.f90 (revision 119545)
--- 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 119545)
--- 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