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

7 files changed, 70 insertions, 24 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index f360206..c2a3464 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,28 @@
 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
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index f806497..78cb9f0 100644
--- a/gcc/fortran/expr.c
+++ b/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);
 
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 5e4b322..8665ec9 100644
--- a/gcc/fortran/gfortran.h
+++ b/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.  */
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 80a773e..bcf95f5 100644
--- a/gcc/fortran/interface.c
+++ b/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))
 	  {
-	    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;
     }
 
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 7c9c2b1..ca4e091 100644
--- a/gcc/fortran/module.c
+++ b/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;
 }
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 863e831..0690dca 100644
--- a/gcc/fortran/resolve.c
+++ b/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;
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 7cb5e76..a809082 100644
--- a/gcc/fortran/symbol.c
+++ b/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;