[Patch, fortran] PR18022 - assignments of the kind x(:)%i = f(y(:))

[Paul Thomas <paulthomas2 at wanadoo dot fr>]

:ADDPATCH fortran:

This PR involved assignments of the for y = f(x), where the lvalue is a 
component of an array of derived types and the function outputs an array 
of the same type as the component.  This kind of assignment evades the 
scalarizer by going to gfc_trans_arrayfunc_assign.  This would be fine 
if the description of arrays was up to any arbitrary spacing between 
elements.  In the absence of this greatly required feature, such 
assignments produce nonsense.

The patch functions by skipping past the call to 
gfc_trans_arrayfunc_assign, if the lvalue expression has any component 
references after an array reference has been seen.  That is to say, the 
likes of x(:)%i = f(y(:)) will go to the scalarizer.  This is a much 
improved version of the original proposed patch:  
http://gcc.gnu.org/ml/fortran/2005-07/msg00098.html

Bubblestrapped and regtested on FC3/i686:  OK for mainline and 4.0?

Paul
2005-10-12  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/18022
	* trans-expr.c (gfc_trans_assignment): Prevent call
	to gfc_trans_arrayfunc_assign if there are any array
	refs before the last component ref.

2005-10-12  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/18022
	gfortran.dg/assign_func_dtcomp_1.f90: New test.


Index: gcc/gcc/fortran/trans-expr.c
===================================================================
RCS file: /cvs/gcc/gcc/gcc/fortran/trans-expr.c,v
retrieving revision 1.65
diff -c -p -r1.65 trans-expr.c
*** gcc/gcc/fortran/trans-expr.c	3 Oct 2005 07:22:18 -0000	1.65
--- gcc/gcc/fortran/trans-expr.c	12 Oct 2005 22:00:55 -0000
*************** gfc_trans_assignment (gfc_expr * expr1, 
*** 2648,2653 ****
--- 2648,2668 ----
    tree tmp;
    stmtblock_t block;
    stmtblock_t body;
+   gfc_ref * ref;
+   int seen_array_ref;
+ 
+   /* Before even thinking about calling gfc_trans_arrayfunc_assign,
+      check that no component references appear after any array
+      references.  This is needed because we do not have the means to
+      span any arbitrary stride with an array descriptor.  */
+   seen_array_ref = 0;
+   for (ref = expr1->ref; ref; ref = ref->next)
+     {
+       if (ref->type == REF_ARRAY)
+ 	seen_array_ref= 1;
+       else if (ref->type == REF_COMPONENT && seen_array_ref)
+ 	goto scalarize;
+     }
  
    /* Special case a single function returning an array.  */
    if (expr2->expr_type == EXPR_FUNCTION && expr2->rank > 0)
*************** gfc_trans_assignment (gfc_expr * expr1, 
*** 2657,2662 ****
--- 2672,2679 ----
  	return tmp;
      }
  
+ scalarize:
+ 
    /* Assignment of the form lhs = rhs.  */
    gfc_start_block (&block);
  


------------------------assign_func_dtcomp_1.f90-------------------------
! { dg-do run }
! { dg-options "-O0" }
!
! Test fix for PR18022.
!
! Contributed by Paul Thomas <pault@gcc.gnu.org>
!
program assign_func_dtcomp
 implicit none
 type                         ::  mytype
   real                       ::  x
   real                       ::  y
 end type mytype
 type (mytype), dimension (4) ::  z

 type                         ::  thytype
   real                       ::  x(4)
 end type thytype
 type (thytype)               ::  w
 real, dimension (4)          ::  a = (/1.,2.,3.,4./)
 real, dimension (4)          ::  b = (/5.,6.,7.,8./)


! Test the original problem is fixed.
 z(:)%x = foo (a)
 z(:)%y = foo (b)


 if (any(z%x.ne.a).or.any(z%y.ne.b)) call abort ()

! Make sure we did not break anything on the way.
 w%x(:) = foo (b)
 a = foo (b)

 if (any(w%x.ne.b).or.any(a.ne.b)) call abort ()

contains

 function foo (v) result (ans)
   real, dimension (:), intent(in)   ::  v
   real, dimension (size(v))  ::  ans
   ans = v
 end function foo


end program assign_func_dtcomp