1! { dg-do run } 2! { dg-options "-std=legacy" } 3! 4! This tests the fix for PR24276, which originated from the Loren P. Meissner example, 5! Array_List. The PR concerns dummy argument aliassing of components of arrays of derived 6! types as arrays of the type of the component. gfortran would compile and run this 7! example but the stride used did not match the actual argument. This test case exercises 8! a procedure call (to foo2, below) that is identical to Array_List's. 9! 10! Contributed by Paul Thomas <pault@gcc.gnu.org> 11 12program test_lex 13 type :: dtype 14 integer :: n 15 character*5 :: word 16 end type dtype 17 18 type :: list 19 type(dtype), dimension(4) :: list 20 integer :: l = 4 21 end type list 22 23 type(list) :: table 24 type(dtype) :: elist(2,2) 25 26 table%list = (/dtype (1 , "one "), dtype (2 , "two "), dtype (3 , "three"), dtype (4 , "four ")/) 27 28! Test 1D with assumed shape (original bug) and assumed size. 29 call bar (table, 2, 4) 30 if (any (table%list%word.ne.(/"one ","i= 2","three","i= 4"/))) call abort () 31 32 elist = reshape (table%list, (/2,2/)) 33 34! Check 2D is OK with assumed shape and assumed size. 35 call foo3 (elist%word, 1) 36 call foo1 (elist%word, 3) 37 if (any (elist%word.ne.reshape ((/"i= 1","i= 2","i= 3","i= 4"/), (/2,2/)))) call abort () 38 39contains 40 41 subroutine bar (table, n, m) 42 type(list) :: table 43 integer n, m 44 call foo1 (table%list(:table%l)%word, n) 45 call foo2 (table%list(:table%l)%word, m) 46 end subroutine bar 47 48 subroutine foo1 (slist, i) 49 character(*), dimension(*) :: slist 50 integer i 51 write (slist(i), '(2hi=,i3)') i 52 end subroutine foo1 53 54 subroutine foo2 (slist, i) 55 character(5), dimension(:) :: slist 56 integer i 57 write (slist(i), '(2hi=,i3)') i 58 end subroutine foo2 59 60 subroutine foo3 (slist, i) 61 character(5), dimension(:,:) :: slist 62 integer i 63 write (slist(1,1), '(2hi=,i3)') i 64 end subroutine foo3 65 66end program test_lex 67 68