re PR fortran/29315 (error passing an array derived from type element)

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

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

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

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

From-SVN: r118659

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d756df333372e49b7e6ab134e91fe77232a73cbf..25ed17ea1c749b9c47196923484b4474d323ffe9 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2006-11-10 Paul Thomas <pault@gcc.gnu.org>
+
+       PR fortran/29315
+       * trans-expr.c (is_aliased_array): Treat correctly the case where the
+       component is itself and array or array reference.
+
 2006-11-09  Brooks Moses  <brooks.moses@codesourcery.com>
 
        * check.c (same_type_check): Typo fix in comment.

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 9e44bfd34352241906710d99463a57e903c0fbc1..6f1e163d46a6f5d8a7c4125a5880f4629b927b4a 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1838,7 +1838,8 @@ gfc_conv_aliased_arg (gfc_se * parmse, gfc_expr * expr,
   return;
 }
 
-/* Is true if the last array reference is followed by a component reference.  */
+/* Is true if an array reference is followed by a component or substring
+   reference.  */
 
 static bool
 is_aliased_array (gfc_expr * e)
@@ -1849,10 +1850,11 @@ is_aliased_array (gfc_expr * e)
   seen_array = false;  
   for (ref = e->ref; ref; ref = ref->next)
     {
-      if (ref->type == REF_ARRAY)
+      if (ref->type == REF_ARRAY
+           && ref->u.ar.type != AR_ELEMENT)
        seen_array = true;
 
-      if (ref->next == NULL
+      if (seen_array
            && ref->type != REF_ARRAY)
        return seen_array;
     }

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index ec8b83d9eaa3bb01ae34282f834d5eb609f29a72..4189bb08d7e5de86c3622fb454685aa82142c1da 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2006-11-10 Paul Thomas <pault@gcc.gnu.org>
+
+       PR fortran/29315
+       * gfortran.dg/aliasing_dummy_4.f90: New test.
+
 2006-11-10  Uros Bizjak  <ubizjak@gmail.com>
 
        PR target/29777

diff --git a/gcc/testsuite/gfortran.dg/aliasing_dummy_4.f90 b/gcc/testsuite/gfortran.dg/aliasing_dummy_4.f90
new file mode 100644 (file)
index 0000000..826ada1
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/aliasing_dummy_4.f90
@@ -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
+