1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
|
! { dg-do run }
!
! Test the fix for PR88247 and more besides :-)
!
! Contributed by Gerhard Steinmetz <gscfq@t-online.de>
!
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
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
|
