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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@126000 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 6c9c382..5b697d1 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,15 @@
+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

diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c
index e00c285..ee376f5 100644 (file)
--- a/gcc/fortran/match.c
+++ b/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);

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 8b3b29e..bc6ba02 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/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;
 }
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 120704f..eb9251f 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+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.

diff --git a/gcc/testsuite/gfortran.dg/host_assoc_call_1.f90 b/gcc/testsuite/gfortran.dg/host_assoc_call_1.f90
new file mode 100644 (file)
index 0000000..8049290
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/host_assoc_call_1.f90
@@ -0,0 +1,17 @@
+! { 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" } }

diff --git a/gcc/testsuite/gfortran.dg/host_assoc_function_2.f90 b/gcc/testsuite/gfortran.dg/host_assoc_function_2.f90
new file mode 100644 (file)
index 0000000..5d63d7a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/host_assoc_function_2.f90
@@ -0,0 +1,48 @@
+! { 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" } }