Skip to content

Commit b599c1a

Browse files
rousonrouson
authored
Merge pull request #22 from sourceryinstitute/restart-cray-workaround
Work around Cray Compiler Environment (CCE) 17.0.0 bugs
2 parents ae9a068 + ccd567f commit b599c1a

File tree

2 files changed

+83
-76
lines changed

2 files changed

+83
-76
lines changed

‎example/derived_type_diagnostic.f90 renamed to ‎example/derived_type_diagnostic.F90

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -137,9 +137,17 @@ program diagnostic_data_pattern
137137

138138
type(stuff_t) stuff
139139

140+
#ifndef _CRAYFTN
140141
associate (i => stuff_t(z=(0.,1.)))
141142
call assert(i%defined(), "main: i%defined()", characterizable_stuff_t(i))!Passes: constructor postcondition ensures defined data
142143
end associate
144+
#else
145+
block
146+
type(stuff_t) stuff
147+
stuff = stuff_t(z=(0.,1.))
148+
call assert(stuff%defined(), "main: i%defined()", characterizable_stuff_t(stuff))
149+
end block
150+
#endif
143151

144152
print *, stuff%z() ! Fails: accessor precondition catches use of undefined data
145153

‎src/assert/intrinsic_array_s.F90

Lines changed: 75 additions & 76 deletions
Original file line numberDiff line numberDiff line change
@@ -60,83 +60,7 @@
6060

6161
end procedure
6262

63-
pure function one_allocated_component(self) result(one_allocated)
64-
type(intrinsic_array_t), intent(in) :: self
65-
logical one_allocated
66-
one_allocated = count( &
67-
[ allocated(self%complex_1D), allocated(self%complex_double_1D), allocated(self%integer_1D), allocated(self%logical_1D), &
68-
allocated(self%real_1D), allocated(self%complex_2D), allocated(self%complex_double_2D), allocated(self%integer_2D), &
69-
allocated(self%logical_2D), allocated(self%real_2D), allocated(self%complex_3D), allocated(self%complex_double_3D), &
70-
allocated(self%integer_3D), allocated(self%logical_3D), allocated(self%real_3D) &
71-
])
72-
end function
73-
74-
module procedure as_character
75-
integer, parameter :: single_number_width=32
76-
77-
if (.not. one_allocated_component(self)) error stop "intrinsic_array_s(as_character): invalid number of allocated components"
78-
79-
if (allocated(self%complex_1D)) then
80-
character_self = repeat(" ", ncopies = single_number_width*size(self%complex_1D))
81-
write(character_self, *) self%complex_1D
82-
else if (allocated(self%complex_double_1D)) then
83-
character_self = repeat(" ", ncopies = single_number_width*size(self%complex_double_1D))
84-
write(character_self, *) self%complex_double_1D
85-
else if (allocated(self%integer_1D)) then
86-
character_self = repeat(" ", ncopies = single_number_width*size(self%integer_1D))
87-
write(character_self, *) self%integer_1D
88-
else if (allocated(self%logical_1D)) then
89-
character_self = repeat(" ", ncopies = single_number_width*size(self%logical_1D))
90-
write(character_self, *) self%logical_1D
91-
else if (allocated(self%real_1D)) then
92-
character_self = repeat(" ", ncopies = single_number_width*size(self%real_1D))
93-
write(character_self, *) self%real_1D
94-
else if (allocated(self%double_precision_1D)) then
95-
character_self = repeat(" ", ncopies = single_number_width*size(self%double_precision_1D))
96-
write(character_self, *) self%double_precision_1D
97-
else if (allocated(self%complex_2D)) then
98-
character_self = repeat(" ", ncopies = single_number_width*size(self%complex_2D))
99-
write(character_self, *) self%complex_2D
100-
else if (allocated(self%complex_double_2D)) then
101-
character_self = repeat(" ", ncopies = single_number_width*size(self%complex_double_2D))
102-
write(character_self, *) self%complex_double_2D
103-
else if (allocated(self%integer_2D)) then
104-
character_self = repeat(" ", ncopies = single_number_width*size(self%integer_2D))
105-
write(character_self, *) self%integer_2D
106-
else if (allocated(self%logical_2D)) then
107-
character_self = repeat(" ", ncopies = single_number_width*size(self%logical_1D))
108-
write(character_self, *) self%logical_2D
109-
else if (allocated(self%real_2D)) then
110-
character_self = repeat(" ", ncopies = single_number_width*size(self%real_2D))
111-
write(character_self, *) self%real_2D
112-
else if (allocated(self%double_precision_2D)) then
113-
character_self = repeat(" ", ncopies = single_number_width*size(self%double_precision_2D))
114-
write(character_self, *) self%double_precision_2D
115-
else if (allocated(self%complex_3D)) then
116-
character_self = repeat(" ", ncopies = single_number_width*size(self%complex_3D))
117-
write(character_self, *) self%complex_3D
118-
else if (allocated(self%complex_double_3D)) then
119-
character_self = repeat(" ", ncopies = single_number_width*size(self%complex_double_3D))
120-
write(character_self, *) self%complex_double_3D
121-
else if (allocated(self%integer_3D)) then
122-
character_self = repeat(" ", ncopies = single_number_width*size(self%integer_3D))
123-
write(character_self, *) self%integer_3D
124-
else if (allocated(self%logical_3D)) then
125-
character_self = repeat(" ", ncopies = single_number_width*size(self%logical_1D))
126-
write(character_self, *) self%logical_3D
127-
else if (allocated(self%real_3D)) then
128-
character_self = repeat(" ", ncopies = single_number_width*size(self%real_3D))
129-
write(character_self, *) self%real_3D
130-
else if (allocated(self%double_precision_3D)) then
131-
character_self = repeat(" ", ncopies = single_number_width*size(self%double_precision_3D))
132-
write(character_self, *) self%double_precision_3D
133-
end if
134-
135-
character_self = trim(adjustl(character_self))
136-
end procedure
137-
13863
#else
139-
14064
module procedure complex_array
14165

14266
select rank(array)
@@ -214,4 +138,79 @@ pure function one_allocated_component(self) result(one_allocated)
214138

215139
#endif
216140

141+
pure function one_allocated_component(self) result(one_allocated)
142+
type(intrinsic_array_t), intent(in) :: self
143+
logical one_allocated
144+
one_allocated = 1 == count( &
145+
[ allocated(self%complex_1D), allocated(self%complex_double_1D), allocated(self%integer_1D), allocated(self%logical_1D), &
146+
allocated(self%real_1D), allocated(self%complex_2D), allocated(self%complex_double_2D), allocated(self%integer_2D), &
147+
allocated(self%logical_2D), allocated(self%real_2D), allocated(self%complex_3D), allocated(self%complex_double_3D), &
148+
allocated(self%integer_3D), allocated(self%logical_3D), allocated(self%real_3D) &
149+
])
150+
end function
151+
152+
module procedure as_character
153+
integer, parameter :: single_number_width=32
154+
155+
if (.not. one_allocated_component(self)) error stop "intrinsic_array_s(as_character): invalid number of allocated components"
156+
157+
if (allocated(self%complex_1D)) then
158+
character_self = repeat(" ", ncopies = single_number_width*size(self%complex_1D))
159+
write(character_self, *) self%complex_1D
160+
else if (allocated(self%complex_double_1D)) then
161+
character_self = repeat(" ", ncopies = single_number_width*size(self%complex_double_1D))
162+
write(character_self, *) self%complex_double_1D
163+
else if (allocated(self%integer_1D)) then
164+
character_self = repeat(" ", ncopies = single_number_width*size(self%integer_1D))
165+
write(character_self, *) self%integer_1D
166+
else if (allocated(self%logical_1D)) then
167+
character_self = repeat(" ", ncopies = single_number_width*size(self%logical_1D))
168+
write(character_self, *) self%logical_1D
169+
else if (allocated(self%real_1D)) then
170+
character_self = repeat(" ", ncopies = single_number_width*size(self%real_1D))
171+
write(character_self, *) self%real_1D
172+
else if (allocated(self%double_precision_1D)) then
173+
character_self = repeat(" ", ncopies = single_number_width*size(self%double_precision_1D))
174+
write(character_self, *) self%double_precision_1D
175+
else if (allocated(self%complex_2D)) then
176+
character_self = repeat(" ", ncopies = single_number_width*size(self%complex_2D))
177+
write(character_self, *) self%complex_2D
178+
else if (allocated(self%complex_double_2D)) then
179+
character_self = repeat(" ", ncopies = single_number_width*size(self%complex_double_2D))
180+
write(character_self, *) self%complex_double_2D
181+
else if (allocated(self%integer_2D)) then
182+
character_self = repeat(" ", ncopies = single_number_width*size(self%integer_2D))
183+
write(character_self, *) self%integer_2D
184+
else if (allocated(self%logical_2D)) then
185+
character_self = repeat(" ", ncopies = single_number_width*size(self%logical_1D))
186+
write(character_self, *) self%logical_2D
187+
else if (allocated(self%real_2D)) then
188+
character_self = repeat(" ", ncopies = single_number_width*size(self%real_2D))
189+
write(character_self, *) self%real_2D
190+
else if (allocated(self%double_precision_2D)) then
191+
character_self = repeat(" ", ncopies = single_number_width*size(self%double_precision_2D))
192+
write(character_self, *) self%double_precision_2D
193+
else if (allocated(self%complex_3D)) then
194+
character_self = repeat(" ", ncopies = single_number_width*size(self%complex_3D))
195+
write(character_self, *) self%complex_3D
196+
else if (allocated(self%complex_double_3D)) then
197+
character_self = repeat(" ", ncopies = single_number_width*size(self%complex_double_3D))
198+
write(character_self, *) self%complex_double_3D
199+
else if (allocated(self%integer_3D)) then
200+
character_self = repeat(" ", ncopies = single_number_width*size(self%integer_3D))
201+
write(character_self, *) self%integer_3D
202+
else if (allocated(self%logical_3D)) then
203+
character_self = repeat(" ", ncopies = single_number_width*size(self%logical_1D))
204+
write(character_self, *) self%logical_3D
205+
else if (allocated(self%real_3D)) then
206+
character_self = repeat(" ", ncopies = single_number_width*size(self%real_3D))
207+
write(character_self, *) self%real_3D
208+
else if (allocated(self%double_precision_3D)) then
209+
character_self = repeat(" ", ncopies = single_number_width*size(self%double_precision_3D))
210+
write(character_self, *) self%double_precision_3D
211+
end if
212+
213+
character_self = trim(adjustl(character_self))
214+
end procedure
215+
217216
end submodule intrinsic_array_s

0 commit comments

Comments
 (0)