This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[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

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]