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

gcc/fortran/ChangeLog

 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

gcc/fortran/expr.c

@@ -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);
 

gcc/fortran/gfortran.h

@@ -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.  */

gcc/fortran/interface.c

@@ -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))
 	  {
+	    if (referenced)
+	      {
 		gfc_error ("Ambiguous interfaces '%s' and '%s' in %s at %L",
-		       p->sym->name, q->sym->name, interface_name, &p->where);
+			   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;
     }
 

gcc/fortran/module.c

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

gcc/fortran/resolve.c

@@ -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;

gcc/fortran/symbol.c

@@ -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;

gcc/testsuite/ChangeLog

 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.

gcc/testsuite/gfortran.dg/array_initializer_2.f90

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

gcc/testsuite/gfortran.dg/generic_7.f90

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

gcc/testsuite/gfortran.dg/interface_1.f90

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

gcc/testsuite/gfortran.dg/interface_4.f90

+! { 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" } }

gcc/testsuite/gfortran.dg/interface_5.f90

+! { 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" } }

gcc/testsuite/gfortran.dg/interface_6.f90

+! { 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

gcc/testsuite/gfortran.dg/interface_7.f90

+! { 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" } }

gcc/testsuite/gfortran.dg/interface_8.f90

+! { 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" } }

gcc/testsuite/gfortran.dg/interface_9.f90

+! { 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" } }
+