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
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
! { dg-do run }
!
! Tests fixes for various pr87477 dependencies
!
! Contributed by Gerhard Steinmetz <gscfq@t-online.de> except for pr102106:
! which was contributed by Brad Richardson <everythingfunctional@protonmail.com>
!
program associate_60
implicit none
character(20) :: buffer
call pr102106
call pr100948
call pr85686
call pr88247
call pr91941
call pr92779
call pr93339
call pr93813
contains
subroutine pr102106
type :: sub_class_t
integer :: i
end type
type :: with_polymorphic_component_t
class(sub_class_t), allocatable :: sub_obj_
end type
associate(obj => with_polymorphic_component_t(sub_class_t(42)))
if (obj%sub_obj_%i .ne. 42) stop 1
end associate
end
subroutine pr100948
type t
character(:), allocatable :: c(:)
end type
type(t), allocatable :: x
!
! Valid test in comment 1
!
x = t(['ab','cd'])
associate (y => x%c(:))
if (any (y .ne. x%c)) stop 2
if (any (y .ne. ['ab','cd'])) stop 3
end associate
deallocate (x)
!
! Allocation with source was found to only copy over one of the array elements
!
allocate (x, source = t(['ef','gh']))
associate (y => x%c(:))
if (any (y .ne. x%c)) stop 4
if (any (y .ne. ['ef','gh'])) stop 5
end associate
deallocate (x)
end
subroutine pr85686
call s85686([" g'day "," bye!! "])
if (trim (buffer) .ne. " a g'day a bye!!") stop 6
end
subroutine s85686(x)
character(*) :: x(:)
associate (y => 'a'//x)
write (buffer, *) y ! Used to segfault at the write statement.
end associate
end
subroutine pr88247
type t
character(:), dimension(:), allocatable :: d
end type t
type(t), allocatable :: x
character(5) :: buffer(3)
allocate (x, source = t (['ab','cd'])) ! Didn't work
write(buffer(1), *) x%d(2:1:-1) ! Was found to be broken
write(buffer(2), *) [x%d(2:1:-1)] ! Was OK
associate (y => [x%d(2:1:-1)])
write(buffer(3), *) y ! Bug in comment 7
end associate
if (any (buffer .ne. " cdab")) stop 7
end
subroutine pr91941
character(:), allocatable :: x(:), z(:)
x = [' abc', ' xyz']
z = adjustl(x)
associate (y => adjustl(x)) ! Wrong character length was passed
if (any(y .ne. ['abc ', 'xyz '])) stop 8
end associate
end
subroutine pr92779
character(3) :: a = 'abc'
associate (y => spread(trim(a),1,2) // 'd')
if (any (y .ne. ['abcd','abcd'])) stop 9
end associate
end
subroutine pr93339
type t
character(:), allocatable :: a(:)
end type
type(t) :: x
x = t(["abc "]) ! Didn't assign anything
! allocate (x%a(1), source = 'abc') ! Worked OK
associate (y => x%a)
if (any (y .ne. 'abc ')) stop 10
associate (z => x%a)
if (any (y .ne. z)) stop 11
end associate
end associate
end
subroutine pr93813
type t
end type
type, extends(t) :: t2
end type
class(t), allocatable :: x
integer :: i = 0
allocate (t :: x)
associate (y => (x)) ! The parentheses triggered an ICE in select type
select type (y)
type is (t2)
stop 12
type is (t)
i = 42
class default
stop 13
end select
end associate
if (i .ne. 42) stop 14
end
end
|
