1! { dg-do run } 2! Test FORALL and WHERE with derived types with allocatable components (PR 20541). 3! 4! Contributed by Erik Edelmann <eedelmann@gcc.gnu.org> 5! and Paul Thomas <pault@gcc.gnu.org> 6! 7 type :: a 8 integer, allocatable :: i(:) 9 end type a 10 11 type :: b 12 type (a), allocatable :: at(:) 13 end type b 14 15 type(a) :: x(2) 16 type(b) :: y(2), z(2) 17 integer i, m(4) 18 19! Start with scalar and array element assignments in FORALL. 20 21 x(1) = a ((/1, 2, 3, 4/)) 22 x(2) = a ((/1, 2, 3, 4/) + 10) 23 forall (j = 1:2, i = 1:4, x(j)%i(i) > 2 + (j-1)*10) x(j)%i(i) = j*4-i 24 if (any ((/((x(i)%i(j), j = 1,4), i = 1,2)/) .ne. & 25 (/1, 2, 1, 0, 11, 12, 5, 4/))) call abort () 26 27 y(1) = b ((/x(1),x(2)/)) 28 y(2) = b ((/x(2),x(1)/)) 29 forall (k = 1:2, j=1:2, i = 1:4, y(k)%at(j)%i(i) <= 10) 30 y(k)%at(j)%i(i) = j*4-i+k 31 end forall 32 if (any ((/(((y(k)%at(i)%i(j), j = 1,4), i = 1,2), k = 1,2)/) .ne. & 33 (/4,3,2,1,11,12,6,5,11,12,3,2,9,8,7,6/))) call abort () 34 35! Now simple assignments in WHERE. 36 37 where (y(1)%at(1)%i > 2) y(1)%at(1)%i = 0 38 if (any( (/(((y(k)%at(i)%i(j), j = 1,4), i = 1,2), k = 1,2)/) .ne. & 39 (/0,0,2,1,11,12,6,5,11,12,3,2,9,8,7,6/))) call abort () 40 41! Check that temporaries and full array alloctable component assignments 42! are correctly handled in FORALL. 43 44 x = (/a ((/1,2,3,4/)),a ((/5,6,7,8/))/) 45 forall (i=1:2) y(i) = b ((/x(i)/)) 46 forall (i=1:2) y(i) = y(3-i) ! This needs a temporary. 47 forall (i=1:2) z(i) = y(i) 48 if (any ((/(((z(k)%at(i)%i(j), j = 1,4), i = 1,1), k = 1,2)/) .ne. & 49 (/(/5,6,7,8/),(/1,2,3,4/)/))) call abort () 50 51end 52