[Patch, fortran] PR29315 - error passing an array derived from type element

[Paul Thomas <paulthomas2 at wanadoo dot fr>]

:ADDPATCH fortran:

This PR comes about because passing of components of arrays of derived 
types, where the component itself is and array, was not working.  The 
frontend limits what can be done here to:

element_of_dt_array%components_array              or
dt_array%element_of_component_array.

It is this latter that fails.  The problem is with the logic in 
trans-expr.c(is_aliased_array).  The patch and the testcase are 
self-explanatory.

Regtested on suse10.1/amd64  - OK for trunk, 4.2 and 4.1?

Paul

2006-11-09 Paul Thomas <pault@gcc.gnu.org>

	PR fortran/29744
	* trans-expr.c (is_aliased_array): Treat correctly the case where the
	component is itself and array or array reference.

2006-11-09 Paul Thomas <pault@gcc.gnu.org>

	PR fortran/29744
	* gfortran.dg/aliasing_dummy_4.f90: New test.


Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c	(revision 118621)
--- gcc/fortran/trans-expr.c	(working copy)
*************** gfc_conv_aliased_arg (gfc_se * parmse, g
*** 1838,1844 ****
    return;
  }
  
! /* Is true if the last array reference is followed by a component reference.  */
  
  static bool
  is_aliased_array (gfc_expr * e)
--- 1838,1845 ----
    return;
  }
  
! /* Is true if an array reference is followed by a component or substring
!    reference.  */
  
  static bool
  is_aliased_array (gfc_expr * e)
*************** is_aliased_array (gfc_expr * e)
*** 1849,1858 ****
    seen_array = false;	
    for (ref = e->ref; ref; ref = ref->next)
      {
!       if (ref->type == REF_ARRAY)
  	seen_array = true;
  
!       if (ref->next == NULL
  	    && ref->type != REF_ARRAY)
  	return seen_array;
      }
--- 1850,1860 ----
    seen_array = false;	
    for (ref = e->ref; ref; ref = ref->next)
      {
!       if (ref->type == REF_ARRAY
! 	    && ref->u.ar.type != AR_ELEMENT)
  	seen_array = true;
  
!       if (seen_array
  	    && ref->type != REF_ARRAY)
  	return seen_array;
      }
Index: gcc/testsuite/gfortran.dg/aliasing_dummy_4.f90
===================================================================
*** gcc/testsuite/gfortran.dg/aliasing_dummy_4.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/aliasing_dummy_4.f90	(revision 0)
***************
*** 0 ****
--- 1,42 ----
+ ! { dg-do run }
+ ! This tests the fix for PR29315, in which array components of derived type arrays were
+ ! not correctly passed to procedures because of a fault in the function that detects
+ ! these references that do not have the span of a natural type.
+ !
+ ! Contributed by Stephen Jeffrey  <stephen.jeffrey@nrm.qld.gov.au>
+ !
+ program  test_f90
+ 
+     integer, parameter :: N = 2
+ 
+     type test_type
+         integer a(N, N)
+     end type
+ 
+     type (test_type) s(N, N)
+ 
+     forall (l = 1:N, m = 1:N) &
+         s(l, m)%a(:, :) = reshape ([((i*l + 10*j*m +100, i = 1, N), j = 1, N)], [N, N])
+ 
+     call test_sub(s%a(1, 1), 1000) ! Test the original problem.
+ 
+     if ( any (s(1, 1)%a(:, :) /= reshape ([1111, 112, 121, 122], [2, 2]))) call abort ()
+     if ( any (s(1, 2)%a(:, :) /= reshape ([1121, 122, 141, 142], [2, 2]))) call abort ()
+     if ( any (s(2, 1)%a(:, :) /= reshape ([1112, 114, 122, 124], [2, 2]))) call abort ()
+     if ( any (s(2, 2)%a(:, :) /= reshape ([1122, 124, 142, 144], [2, 2]))) call abort ()
+ 
+     call test_sub(s(1, 1)%a(:, :), 1000)  ! Check "normal" references.
+ 
+     if ( any (s(1, 1)%a(:, :) /= reshape ([2111,1112,1121,1122], [2, 2]))) call abort ()
+     if ( any (s(1, 2)%a(:, :) /= reshape ([1121, 122, 141, 142], [2, 2]))) call abort ()
+     if ( any (s(2, 1)%a(:, :) /= reshape ([1112, 114, 122, 124], [2, 2]))) call abort ()
+     if ( any (s(2, 2)%a(:, :) /= reshape ([1122, 124, 142, 144], [2, 2]))) call abort ()
+ contains
+   subroutine test_sub(array, offset)
+     integer array(:, :), offset
+ 
+     forall (i = 1:N, j = 1:N) &
+         array(i, j) = array(i, j) + offset
+   end subroutine
+ end program
+