1! { dg-do run } 2! This tests the fix for PR29315, in which array components of derived type arrays were 3! not correctly passed to procedures because of a fault in the function that detects 4! these references that do not have the span of a natural type. 5! 6! Contributed by Stephen Jeffrey <stephen.jeffrey@nrm.qld.gov.au> 7! 8program test_f90 9 10 integer, parameter :: N = 2 11 12 type test_type 13 integer a(N, N) 14 end type 15 16 type (test_type) s(N, N) 17 18 forall (l = 1:N, m = 1:N) & 19 s(l, m)%a(:, :) = reshape ([((i*l + 10*j*m +100, i = 1, N), j = 1, N)], [N, N]) 20 21 call test_sub(s%a(1, 1), 1000) ! Test the original problem. 22 23 if ( any (s(1, 1)%a(:, :) /= reshape ([1111, 112, 121, 122], [2, 2]))) call abort () 24 if ( any (s(1, 2)%a(:, :) /= reshape ([1121, 122, 141, 142], [2, 2]))) call abort () 25 if ( any (s(2, 1)%a(:, :) /= reshape ([1112, 114, 122, 124], [2, 2]))) call abort () 26 if ( any (s(2, 2)%a(:, :) /= reshape ([1122, 124, 142, 144], [2, 2]))) call abort () 27 28 call test_sub(s(1, 1)%a(:, :), 1000) ! Check "normal" references. 29 30 if ( any (s(1, 1)%a(:, :) /= reshape ([2111,1112,1121,1122], [2, 2]))) call abort () 31 if ( any (s(1, 2)%a(:, :) /= reshape ([1121, 122, 141, 142], [2, 2]))) call abort () 32 if ( any (s(2, 1)%a(:, :) /= reshape ([1112, 114, 122, 124], [2, 2]))) call abort () 33 if ( any (s(2, 2)%a(:, :) /= reshape ([1122, 124, 142, 144], [2, 2]))) call abort () 34contains 35 subroutine test_sub(array, offset) 36 integer array(:, :), offset 37 38 forall (i = 1:N, j = 1:N) & 39 array(i, j) = array(i, j) + offset 40 end subroutine 41end program 42 43