[Patch, fortran] PR40646 - ICE assigning array return value from type-bound procedure

[Paul Richard Thomas <paul dot richard dot thomas at gmail dot com>]

The attached is verging on obvious.

Bootstrapped and regtested on FC9/x86_64 - OK for trunk?

Cheers

Paul

2009-07-04  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/40646
	* trans-expr.c (gfc_trans_arrayfunc_assign): Make sure that the
	esym field of the expression is filled and use is_proc_ptr_comp
	in the condition.

2009-07-04  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/40646
	* gfortran.dg/func_assign_3.f90 : New test.

-- 
The knack of flying is learning how to throw yourself at the ground and miss.
       --Hitchhikers Guide to the Galaxy

Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c	(revision 149062)
+++ gcc/fortran/trans-expr.c	(working copy)
@@ -4356,6 +4356,11 @@
 	return NULL;
     }
 
+  if (!expr2->value.function.isym
+      && !expr2->value.function.esym
+      && expr2->symtree->n.sym->attr.flavor == FL_PROCEDURE)
+    expr2->value.function.esym = expr2->symtree->n.sym;
+
   /* Check for a dependency.  */
   if (gfc_check_fncall_dependency (expr1, INTENT_OUT,
 				   expr2->value.function.esym,
@@ -4365,11 +4370,10 @@
 
   /* The frontend doesn't seem to bother filling in expr->symtree for intrinsic
      functions.  */
-  is_proc_ptr_comp(expr2, &comp);
   gcc_assert (expr2->value.function.isym
-	      || (comp && comp->attr.dimension)
+	      || (is_proc_ptr_comp(expr2, &comp) && comp && comp->attr.dimension)
 	      || (!comp && gfc_return_by_reference (expr2->value.function.esym)
-	      && expr2->value.function.esym->result->attr.dimension));
+		  && expr2->value.function.esym->result->attr.dimension));
 
   ss = gfc_walk_expr (expr1);
   gcc_assert (ss != gfc_ss_terminator);
Index: gcc/testsuite/gfortran.dg/func_assign_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/func_assign_3.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/func_assign_3.f90	(revision 0)
@@ -0,0 +1,32 @@
+! { dg-do run }
+! Tests the fix for PR40646 in which the assignment would cause an ICE.
+!
+! Contributed by Charlie Sharpsteen  <chuck@sharpsteen.net>
+! http://gcc.gnu.org/ml/fortran/2009-07/msg00010.html
+! and reported by Tobias Burnus  <burnus@gcc,gnu.org>
+!
+module bugTestMod
+  implicit none
+  type:: boundTest
+  contains
+    procedure, nopass:: test => returnMat
+  end type boundTest
+contains
+  function returnMat( a, b ) result( mat )
+    integer:: a, b, i
+    double precision, dimension(a,b):: mat
+    mat = dble (reshape ([(i, i = 1, a * b)],[a,b])) 
+    return
+  end function returnMat
+end module bugTestMod
+
+program bugTest
+  use bugTestMod
+  implicit none
+  integer i
+  double precision, dimension(2,2):: testCatch
+  type( boundTest ):: testObj
+  testCatch = testObj%test(2,2)  ! This would cause an ICE
+  if (any (testCatch .ne. dble (reshape ([(i, i = 1, 4)],[2,2])))) call abort
+end program bugTest
+! { dg-final { cleanup-modules "bugTestMod" } }