2009-01-05 Paul Thomas <pault@gcc.gnu.org>

	PR fortran/38665
	* gfortran.h : Add bit to gfc_expr 'user_operator'
	* interface.c (gfc_extend_expr): Set the above if the operator
	is substituted by a function. 
	* resolve.c (check_host_association): Return if above is set.

2009-01-05  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/38665
	* gfortran.dg/host_assoc_function_5.f90: New test.


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

6 files changed, 76 insertions, 1 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 2bf2a0185a2..b8fdb3b101f 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2009-01-05  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/38665
+	* gfortran.h : Add bit to gfc_expr 'user_operator'
+	* interface.c (gfc_extend_expr): Set the above if the operator
+	is substituted by a function. 
+	* resolve.c (check_host_association): Return if above is set.
+
 2009-01-04  Mikael Morin  <mikael.morin@tele2.fr>
 
 	PR fortran/35681
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index bb2230df8d8..920fbd9bffe 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1553,6 +1553,10 @@ typedef struct gfc_expr
   /* Sometimes, when an error has been emitted, it is necessary to prevent
       it from recurring.  */
   unsigned int error : 1;
+  
+  /* Mark and expression where a user operator has been substituted by
+     a function call in interface.c(gfc_extend_expr).  */
+  unsigned int user_operator : 1;
 
   /* Used to quickly find a given constructor by its offset.  */
   splay_tree con_by_offset;
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 17f70331286..f779dfa04de 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -2670,6 +2670,7 @@ gfc_extend_expr (gfc_expr *e)
   e->value.function.esym = NULL;
   e->value.function.isym = NULL;
   e->value.function.name = NULL;
+  e->user_operator = 1;
 
   if (gfc_pure (NULL) && !gfc_pure (sym))
     {
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 27a4d997b7a..74f8fb05114 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -4300,7 +4300,12 @@ check_host_association (gfc_expr *e)
   int n;
   bool retval = e->expr_type == EXPR_FUNCTION;
 
-  if (e->symtree == NULL || e->symtree->n.sym == NULL)
+  /*  If the expression is the result of substitution in
+      interface.c(gfc_extend_expr) because there is no way in
+      which the host association can be wrong.  */
+  if (e->symtree == NULL
+	|| e->symtree->n.sym == NULL
+	|| e->user_operator)
     return retval;
 
   old_sym = e->symtree->n.sym;
@@ -4336,6 +4341,11 @@ check_host_association (gfc_expr *e)
 	      gfc_free (e->shape);
 	    }
 
+/* TODO - Replace this gfc_match_rvalue with a straight replacement of
+   actual arglists for function to function substitutions and with a
+   conversion of the reference list to an actual arglist in the case of
+   a variable to function replacement.  This should be quite easy since
+   only integers and vectors can be involved.  */	    
 	  gfc_match_rvalue (&expr);
 	  gfc_clear_error ();
 	  gfc_buffer_error (0);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index fde2ce2ad74..926a95db8cc 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2009-01-05  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/38665
+	* gfortran.dg/host_assoc_function_5.f90: New test.
+
 2009-01-04  Mikael Morin  <mikael.morin@tele2.fr>
 
 	PR fortran/38669
diff --git a/gcc/testsuite/gfortran.dg/host_assoc_function_5.f90 b/gcc/testsuite/gfortran.dg/host_assoc_function_5.f90
new file mode 100644
index 00000000000..c75202e445a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/host_assoc_function_5.f90
@@ -0,0 +1,47 @@
+! { dg-do compile }
+!
+! PR fortran/38665, in which checking for host association
+! was wrongly trying to substitute mod_symmon(mult) with
+! mod_sympoly(mult) in the user operator expression on line
+! 43.
+!
+! Contributed by Thomas Koenig <tkoenig@gcc.gnu.org>
+!
+module mod_symmon
+ implicit none
+
+ public :: t_symmon, operator(*)
+ private
+
+ type t_symmon
+   integer :: ierr = 0
+ end type t_symmon
+
+ interface operator(*)
+   module procedure mult
+ end interface
+
+contains
+ elemental function mult(m1,m2) result(m)
+  type(t_symmon), intent(in) :: m1, m2
+  type(t_symmon) :: m
+ end function mult
+end module mod_symmon
+
+module mod_sympoly
+ use mod_symmon
+ implicit none
+
+ type t_sympol
+   type(t_symmon), allocatable :: mons(:)
+ end type t_sympol
+contains
+
+ elemental function mult(p1,p2) result(p)
+  type(t_sympol), intent(in) :: p1,p2
+  type(t_sympol) :: p
+  type(t_symmon), allocatable :: mons(:)
+  mons(1) = p1%mons(1)*p2%mons(2)
+ end function
+end module
+! { dg-final { cleanup-modules "mod_symmon mod_sympoly" } }