re PR fortran/38665 (ICE in check_host_association)

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.

From-SVN: r143064

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

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;

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))
     {

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

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

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" } }