! { dg-do run } ! ! Test the fix for PR88247 and more besides :-) ! ! Contributed by Gerhard Steinmetz ! program p type t character(:), allocatable :: c character(:), dimension(:), allocatable :: d end type type(t), allocatable :: x call foo ('abcdef','ghijkl') associate (y => [x%c(:)]) if (y(1) .ne. 'abcdef') stop 1 end associate call foo ('ghi','ghi') associate (y => [x%c(2:)]) if (y(1) .ne. 'hi') stop 2 end associate call foo ('lmnopq','ghijkl') associate (y => [x%c(:3)]) if (y(1) .ne. 'lmn') stop 3 end associate call foo ('abcdef','ghijkl') associate (y => [x%c(2:4)]) if (y(1) .ne. 'bcd') stop 4 end associate call foo ('lmnopqrst','ghijklmno') associate (y => x%d(:)) if (len(y) .ne. 9) stop 5 if (any (y .ne. ['lmnopqrst','ghijklmno'])) stop 5 y(1) = 'zqrtyd' end associate if (x%d(1) .ne. 'zqrtyd') stop 5 ! Substrings of arrays still do not work correctly. call foo ('lmnopqrst','ghijklmno') associate (y => x%d(:)(2:4)) ! if (any (y .ne. ['mno','hij'])) stop 6 end associate call foo ('abcdef','ghijkl') associate (y => [x%d(:)]) if (len(y) .ne. 6) stop 7 if (any (y .ne. ['abcdef','ghijkl'])) stop 7 end associate call foo ('lmnopqrst','ghijklmno') associate (y => [x%d(2:1:-1)]) if (len(y) .ne. 9) stop 8 if (any (y .ne. ['ghijklmno','lmnopqrst'])) stop 8 end associate deallocate (x) contains subroutine foo (c1, c2) character(*) :: c1, c2 if (allocated (x)) deallocate (x) allocate (x) x%c = c1 x%d = [c1, c2] end subroutine foo end