1! { dg-do run } 2! 3! Test the fix for PR88247 and more besides :-) 4! 5! Contributed by Gerhard Steinmetz <gscfq@t-online.de> 6! 7program p 8 type t 9 character(:), allocatable :: c 10 character(:), dimension(:), allocatable :: d 11 end type 12 type(t), allocatable :: x 13 14 call foo ('abcdef','ghijkl') 15 associate (y => [x%c(:)]) 16 if (y(1) .ne. 'abcdef') stop 1 17 end associate 18 19 call foo ('ghi','ghi') 20 associate (y => [x%c(2:)]) 21 if (y(1) .ne. 'hi') stop 2 22 end associate 23 24 call foo ('lmnopq','ghijkl') 25 associate (y => [x%c(:3)]) 26 if (y(1) .ne. 'lmn') stop 3 27 end associate 28 29 call foo ('abcdef','ghijkl') 30 associate (y => [x%c(2:4)]) 31 if (y(1) .ne. 'bcd') stop 4 32 end associate 33 34 call foo ('lmnopqrst','ghijklmno') 35 associate (y => x%d(:)) 36 if (len(y) .ne. 9) stop 5 37 if (any (y .ne. ['lmnopqrst','ghijklmno'])) stop 5 38 y(1) = 'zqrtyd' 39 end associate 40 if (x%d(1) .ne. 'zqrtyd') stop 5 41 42! Substrings of arrays still do not work correctly. 43 call foo ('lmnopqrst','ghijklmno') 44 associate (y => x%d(:)(2:4)) 45! if (any (y .ne. ['mno','hij'])) stop 6 46 end associate 47 48 call foo ('abcdef','ghijkl') 49 associate (y => [x%d(:)]) 50 if (len(y) .ne. 6) stop 7 51 if (any (y .ne. ['abcdef','ghijkl'])) stop 7 52 end associate 53 54 call foo ('lmnopqrst','ghijklmno') 55 associate (y => [x%d(2:1:-1)]) 56 if (len(y) .ne. 9) stop 8 57 if (any (y .ne. ['ghijklmno','lmnopqrst'])) stop 8 58 end associate 59 60 deallocate (x) 61contains 62 subroutine foo (c1, c2) 63 character(*) :: c1, c2 64 if (allocated (x)) deallocate (x) 65 allocate (x) 66 x%c = c1 67 x%d = [c1, c2] 68 end subroutine foo 69end 70