! { dg-do run }
|
! { dg-do run }
|
! This tests the fix for PR29315, in which array components of derived type arrays were
|
! 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
|
! 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.
|
! these references that do not have the span of a natural type.
|
!
|
!
|
! Contributed by Stephen Jeffrey
|
! Contributed by Stephen Jeffrey
|
!
|
!
|
program test_f90
|
program test_f90
|
|
|
integer, parameter :: N = 2
|
integer, parameter :: N = 2
|
|
|
type test_type
|
type test_type
|
integer a(N, N)
|
integer a(N, N)
|
end type
|
end type
|
|
|
type (test_type) s(N, N)
|
type (test_type) s(N, N)
|
|
|
forall (l = 1:N, m = 1: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])
|
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.
|
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, 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(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, 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 ()
|
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.
|
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, 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(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, 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 ()
|
if ( any (s(2, 2)%a(:, :) /= reshape ([1122, 124, 142, 144], [2, 2]))) call abort ()
|
contains
|
contains
|
subroutine test_sub(array, offset)
|
subroutine test_sub(array, offset)
|
integer array(:, :), offset
|
integer array(:, :), offset
|
|
|
forall (i = 1:N, j = 1:N) &
|
forall (i = 1:N, j = 1:N) &
|
array(i, j) = array(i, j) + offset
|
array(i, j) = array(i, j) + offset
|
end subroutine
|
end subroutine
|
end program
|
end program
|
|
|
|
|