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

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

Ha! Let's try again.....

I have taken up Tobias' version, which works just fine as long as you
take target->n.sym.  I have also, done some revision of the value
union of gfc_expr to ensure that like things in differnet members are
aligned.  It's not actually necessary but it does relieve the need to
remember that isym was lined up with tbp, so that NULLing one did a
job on the other.

Again, bootstrapped and regtested FC9/x86_64 - OK for trunk?

Cheers

Paul

2009-07-04  Paul Thomas  <pault@gcc.gnu.org>
	and Tobias Burnus <burnus@gcc.gnu.org>

	PR fortran/40646
	* gfortran.h : Change the compcall member of the 'value' union
	in the gfc_expr structure so that its fields overlap with the
	'function' member.
	* resolve.c (resolve_compcall): Set the function.esym.
	* trans-expr.c (gfc_trans_arrayfunc_assign): Use
	is_proc_ptr_comp in the condition.

2009-07-04  Paul Thomas  <pault@gcc.gnu.org>
	and Tobias Burnus <burnus@gcc.gnu.org>

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

Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c	(revision 149062)
+++ gcc/fortran/trans-expr.c	(working copy)
@@ -4054,7 +4054,6 @@
       /* Scalar pointers.  */
       lse.want_pointer = 1;
       gfc_conv_expr (&lse, expr1);
-      gcc_assert (rss == gfc_ss_terminator);
       gfc_init_se (&rse, NULL);
       rse.want_pointer = 1;
       gfc_conv_expr (&rse, expr2);
@@ -4365,11 +4364,11 @@
 
   /* 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/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 149061)
+++ gcc/fortran/resolve.c	(working copy)
@@ -4815,8 +4815,8 @@
 
   e->value.function.actual = newactual;
   e->value.function.name = e->value.compcall.name;
+  e->value.function.esym = target->n.sym;
   e->value.function.isym = NULL;
-  e->value.function.esym = NULL;
   e->symtree = target;
   e->ts = target->n.sym->ts;
   e->expr_type = EXPR_FUNCTION;
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h	(revision 149061)
+++ gcc/fortran/gfortran.h	(working copy)
@@ -1678,8 +1678,9 @@
     struct
     {
       gfc_actual_arglist* actual;
+      const char* name;
+      void* padding;  /* Overlap gfc_typebound_proc with esym.  */
       gfc_typebound_proc* tbp;
-      const char* name;
     }
     compcall;
 
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" } }