re PR fortran/32464 (ICE: USE in contained subroutine)

2007-06-25  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/32464
	* resolve.c (check_host_association): Return if the old symbol
	is use associated.  Introduce retval to reduce the number of
	evaluations of the first-order return value.

	PR fortran/31494
	* match.c (gfc_match_call): If a host associated symbol is not
	a subroutine, build a new symtree/symbol in the current name
	space.


2007-06-25  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/32464
	* gfortran.dg/host_assoc_function_2.f90: New test.

	PR fortran/31494
	* gfortran.dg/host_assoc_call_1.f90: New test.

From-SVN: r126000

gcc/fortran/ChangeLog

+2007-06-25  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/32464
+	* resolve.c (check_host_association): Return if the old symbol
+	is use associated.  Introduce retval to reduce the number of
+	evaluations of the first-order return value.
+
+	PR fortran/31494
+	* match.c (gfc_match_call): If a host associated symbol is not
+	a subroutine, build a new symtree/symbol in the current name
+	space.
+
 2007-06-24  Tobias Burnus  <burnus@net-de>
 
 	PR fortran/32460

gcc/fortran/match.c

@@ -2170,13 +2170,20 @@ gfc_match_call (void)
     return MATCH_ERROR;
 
   sym = st->n.sym;
-  gfc_set_sym_referenced (sym);
 
-  if (!sym->attr.generic
-      && !sym->attr.subroutine
-      && gfc_add_subroutine (&sym->attr, sym->name, NULL) == FAILURE)
+  if (sym->ns != gfc_current_ns
+	&& !sym->attr.generic
+	&& !sym->attr.subroutine
+        && gfc_get_sym_tree (name, NULL, &st) == 1)
     return MATCH_ERROR;
 
+  sym = st->n.sym;
+
+  if (gfc_add_subroutine (&sym->attr, sym->name, NULL) == FAILURE)
+    return MATCH_ERROR;
+
+  gfc_set_sym_referenced (sym);
+
   if (gfc_match_eos () != MATCH_YES)
     {
       m = gfc_match_actual_arglist (1, &arglist);

gcc/fortran/resolve.c

@@ -3224,11 +3224,16 @@ check_host_association (gfc_expr *e)
   locus temp_locus;
   gfc_expr *expr;
   int n;
+  bool retval = e->expr_type == EXPR_FUNCTION;
 
   if (e->symtree == NULL || e->symtree->n.sym == NULL)
-    return e->expr_type == EXPR_FUNCTION;
+    return retval;
 
   old_sym = e->symtree->n.sym;
+
+  if (old_sym->attr.use_assoc)
+    return retval;
+
   if (gfc_current_ns->parent
 	&& gfc_current_ns->parent->parent
 	&& old_sym->ns != gfc_current_ns)
@@ -3244,7 +3249,7 @@ check_host_association (gfc_expr *e)
 	  gfc_free_ref_list (e->ref);
 	  e->ref = NULL;
 
-	  if (e->expr_type == EXPR_FUNCTION)
+	  if (retval)
 	    {
 	      gfc_free_actual_arglist (e->value.function.actual);
 	      e->value.function.actual = NULL;
@@ -3271,7 +3276,7 @@ check_host_association (gfc_expr *e)
 	  gfc_current_locus = temp_locus;
 	}
     }
-
+  /* This might have changed!  */
   return e->expr_type == EXPR_FUNCTION;
 }
 

gcc/testsuite/ChangeLog

+2007-06-25  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/32464
+	* gfortran.dg/host_assoc_function_2.f90: New test.
+
+	PR fortran/31494
+	* gfortran.dg/host_assoc_call_1.f90: New test.
+
 2007-06-24  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
 	* gfortran.dg/secnds-1.f: Revise test to reduce random errors.

gcc/testsuite/gfortran.dg/host_assoc_call_1.f90

+! { dg-do compile }
+! Tests the fix for PR31494, where the call of sub2 would reference
+! the variable, rather than the contained subroutine.
+!
+! Contributed by Michael Richmond <michael.a.richmond@nasa.gov>
+!
+MODULE ksbin2_aux_mod
+REAL, DIMENSION(1) :: sub2
+CONTAINS
+  SUBROUTINE sub1
+    CALL sub2
+    CONTAINS 
+      SUBROUTINE sub2
+      END SUBROUTINE sub2
+  END SUBROUTINE sub1
+END MODULE ksbin2_aux_mod
+! { dg-final { cleanup-modules "ksbin2_aux_mod" } }

gcc/testsuite/gfortran.dg/host_assoc_function_2.f90

+! { dg-do compile }
+! Tests the fix for PR32464, where the use associated procedure would
+! mess up the check for "grandparent" host association.
+!
+! Contributed by Harald Anlauf <anlauf@gmx.de>
+!
+
+module gfcbug64_mod1
+  implicit none
+
+  public :: inverse
+
+  interface inverse
+     module procedure copy
+  end interface
+
+contains
+
+  function copy (d) result (y)
+    real, intent(in) :: d(:)
+    real             :: y(size (d))     ! <- this version kills gfortran
+!    real, intent(in) :: d
+!    real             :: y
+    y = d
+  end function copy
+
+end module gfcbug64_mod1
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+module gfcbug64_mod2
+  implicit none
+contains
+
+  subroutine foo (x_o)
+    real, intent(in) :: x_o(:)
+
+    integer          :: s(size (x_o))           ! <- this line kills gfortran
+
+  contains
+
+    subroutine bar ()
+      use gfcbug64_mod1, only: inverse          ! <- this line kills gfortran
+    end subroutine bar
+
+  end subroutine foo
+end module gfcbug64_mod2
+! { dg-final { cleanup-modules "gfcbug64_mod1 gfcbug64_mod2" } }