Skip to content

Commit 2c59757

Browse files
rousonrouson
authored
Merge pull request #17 from wyphan/wyphan/more-final-tests
Add more finalization test cases
2 parents 424c510 + bc4a5fc commit 2c59757

File tree

1 file changed

+150
-42
lines changed

1 file changed

+150
-42
lines changed

‎test/compiler_test.f90‎

Lines changed: 150 additions & 42 deletions
Original file line numberDiff line numberDiff line change
@@ -6,63 +6,126 @@ module compiler_test
66
public :: test_ref_reference
77

88
type object_t
9-
private
109
integer dummy
1110
contains
1211
final :: count_finalizations
1312
end type
1413

1514
type wrapper_t
1615
private
17-
type(object_t), allocatable :: object
18-
end type
19-
20-
interface object_t
21-
module procedure construct
22-
end interface
16+
type(object_t), allocatable :: object
17+
end type
2318

2419
integer :: finalizations = 0
2520
integer, parameter :: avoid_unused_variable_warning = 1
2621

2722
contains
2823

2924
function test_ref_reference() result(tests)
30-
type(test_item_t) :: tests
25+
type(test_item_t) tests
3126

32-
tests = &
27+
tests = &
3328
describe( &
3429
"The compiler", &
35-
[ it("finalizes an intent(out) derived type dummy argument", check_intent_out_finalization) &
30+
[ it("finalizes a non-allocatable object on the LHS of an intrinsic assignment", check_lhs_object) &
31+
,it("finalizes an allocated allocatable LHS of an intrinsic assignment", check_allocated_allocatable_lhs) &
32+
,it("finalizes a target when the associated pointer is deallocated", check_target_deallocation) &
3633
,it("finalizes an object upon explicit deallocation", check_finalize_on_deallocate) &
34+
,it("finalizes a non-pointer non-allocatable array object at the END statement", check_finalize_on_end) &
35+
,it("finalizes a non-pointer non-allocatable object at the end of a block construct", check_block_finalization) &
3736
,it("finalizes a function reference on the RHS of an intrinsic assignment", check_rhs_function_reference) &
37+
,it("finalizes a specification expression function result", check_specification_expression) &
38+
,it("finalizes an intent(out) derived type dummy argument", check_intent_out_finalization) &
3839
,it("finalizes an allocatable component object", check_allocatable_component_finalization) &
39-
])
40+
])
4041
end function
4142

42-
function construct() result(object)
43+
function construct_object() result(object)
44+
!! Constructor for object_t
4345
type(object_t) object
44-
object%dummy = avoid_unused_variable_warning
46+
object % dummy = avoid_unused_variable_warning
4547
end function
4648

4749
subroutine count_finalizations(self)
50+
!! Destructor for object_t
4851
type(object_t), intent(inout) :: self
49-
finalizations = finalizations + 1
50-
self%dummy = avoid_unused_variable_warning
52+
finalizations = finalizations + 1
53+
self % dummy = avoid_unused_variable_warning
5154
end subroutine
5255

53-
function check_rhs_function_reference() result(result_)
54-
type(object_t), allocatable :: object
56+
function check_lhs_object() result(result_)
57+
!! Verify Fortran 2018 clause 7.5.6.3, paragraph 1 behavior: "not an unallocated allocatable variable"
58+
type(object_t) lhs, rhs
5559
type(result_t) result_
56-
integer initial_tally, delta
60+
integer initial_tally
5761

62+
rhs%dummy = avoid_unused_variable_warning
5863
initial_tally = finalizations
59-
object = object_t() ! finalizes object_t result
60-
delta = finalizations - initial_tally
61-
result_ = assert_equals(1, delta)
64+
lhs = rhs ! finalizes lhs
65+
associate(delta => finalizations - initial_tally)
66+
result_ = assert_equals(1, delta)
67+
end associate
68+
end function
69+
70+
function check_allocated_allocatable_lhs() result(result_)
71+
!! Verify Fortran 2018 clause 7.5.6.3, paragraph 1 behavior: "allocated allocatable variable"
72+
type(object_t), allocatable :: lhs
73+
type(object_t) rhs
74+
type(result_t) result_
75+
integer initial_tally
76+
77+
rhs%dummy = avoid_unused_variable_warning
78+
initial_tally = finalizations
79+
allocate(lhs)
80+
lhs = rhs ! finalizes lhs
81+
associate(delta => finalizations - initial_tally)
82+
result_ = assert_equals(1, delta)
83+
end associate
84+
end function
85+
86+
function check_target_deallocation() result(result_)
87+
!! Verify Fortran 2018 clause 7.5.6.3, paragraph 2 behavior: "pointer is deallocated"
88+
type(object_t), pointer :: object_ptr => null()
89+
type(result_t) result_
90+
integer initial_tally
91+
92+
allocate(object_ptr, source=object_t(dummy=0))
93+
initial_tally = finalizations
94+
deallocate(object_ptr) ! finalizes object
95+
associate(delta => finalizations - initial_tally)
96+
result_ = assert_equals(1, delta)
97+
end associate
98+
end function
99+
100+
function check_allocatable_component_finalization() result(result_)
101+
!! Tests 7.5.6.3, para. 2 ("allocatable entity is deallocated")
102+
!! + 9.7.3.2, para. 6 ("INTENT(OUT) allocatable dummy argument is deallocated")
103+
type(wrapper_t), allocatable :: wrapper
104+
type(result_t) result_
105+
integer initial_tally
106+
107+
initial_tally = finalizations
108+
109+
allocate(wrapper)
110+
allocate(wrapper%object)
111+
call finalize_intent_out_component(wrapper)
112+
associate(delta => finalizations - initial_tally)
113+
result_ = assert_equals(1, delta)
114+
end associate
115+
116+
contains
117+
118+
subroutine finalize_intent_out_component(output)
119+
type(wrapper_t), intent(out) :: output ! finalizes object component
120+
allocate(output%object)
121+
output%object%dummy = avoid_unused_variable_warning
122+
end subroutine
123+
62124
end function
63125

64126
function check_finalize_on_deallocate() result(result_)
65-
type(object_t), allocatable :: object
127+
!! Tests 7.5.6.3, paragraph 2: "allocatable entity is deallocated"
128+
type(object_t), allocatable :: object
66129
type(result_t) result_
67130
integer initial_tally
68131

@@ -75,45 +138,90 @@ function check_finalize_on_deallocate() result(result_)
75138
end associate
76139
end function
77140

78-
function check_intent_out_finalization() result(result_)
141+
function check_finalize_on_end() result(result_)
142+
!! Tests 7.5.6.3, paragraph 3: "before return or END statement"
79143
type(result_t) result_
80-
type(object_t) object
81144
integer initial_tally
82145

83146
initial_tally = finalizations
84-
call finalize_intent_out_arg(object)
85-
result_ = assert_equals(initial_tally+1, finalizations)
147+
call finalize_on_end_subroutine() ! Finalizes local_obj
148+
associate(final_tally => finalizations - initial_tally)
149+
result_ = assert_equals(1, final_tally)
150+
end associate
86151

87152
contains
88153

89-
subroutine finalize_intent_out_arg(output)
90-
type(object_t), intent(out) :: output ! finalizes output
91-
output%dummy = avoid_unused_variable_warning
154+
subroutine finalize_on_end_subroutine()
155+
type(object_t) local_obj
156+
local_obj % dummy = avoid_unused_variable_warning
92157
end subroutine
93158

94159
end function
95160

96-
function check_allocatable_component_finalization() result(result_)
97-
type(wrapper_t), allocatable :: wrapper
161+
function check_block_finalization() result(result_)
162+
!! Tests 7.5.6.3, paragraph 4: "termination of the BLOCK construct"
98163
type(result_t) result_
99-
integer initial_tally, delta
164+
integer initial_tally
100165

101166
initial_tally = finalizations
167+
block
168+
type(object_t) object
169+
object % dummy = avoid_unused_variable_warning
170+
end block ! Finalizes object
171+
associate(delta => finalizations - initial_tally)
172+
result_ = assert_equals(1, delta)
173+
end associate
174+
end function
102175

103-
allocate(wrapper)
104-
allocate(wrapper%object)
105-
call finalize_intent_out_component(wrapper)
106-
delta = finalizations - initial_tally
107-
result_ = assert_equals(1, delta)
176+
function check_rhs_function_reference() result(result_)
177+
!! Verify Fortran 2018 clause 7.5.6.3, paragraph 5 behavior: "nonpointer function result"
178+
type(object_t), allocatable :: object
179+
type(result_t) result_
180+
integer initial_tally
181+
182+
initial_tally = finalizations
183+
object = construct_object() ! finalizes object_t result
184+
associate(delta => finalizations - initial_tally)
185+
result_ = assert_equals(1, delta)
186+
end associate
187+
end function
188+
189+
function check_specification_expression() result(result_)
190+
!! Tests 7.5.6.3, paragraph 6: "specification expression function result"
191+
type(result_t) result_
192+
integer initial_tally
193+
194+
initial_tally = finalizations
195+
call finalize_specification_expression
196+
associate(delta => finalizations - initial_tally)
197+
result_ = assert_equals(1, delta)
198+
end associate
108199

109200
contains
110201

111-
subroutine finalize_intent_out_component(output)
112-
type(wrapper_t), intent(out) :: output ! finalizes object component
113-
allocate(output%object)
114-
output%object%dummy = avoid_unused_variable_warning
202+
subroutine finalize_specification_expression
203+
type(object_t) :: object = object_t(dummy=0) ! Finalizes RHS function reference
204+
object%dummy = avoid_unused_variable_warning
115205
end subroutine
116206

117207
end function
118-
208+
209+
function check_intent_out_finalization() result(result_)
210+
!! Tests 7.5.6.3, paragraph 7: "nonpointer, nonallocatable, INTENT (OUT) dummy argument"
211+
type(result_t) result_
212+
type(object_t) object
213+
integer initial_tally
214+
215+
initial_tally = finalizations
216+
call finalize_intent_out_arg(object)
217+
associate(delta => finalizations - initial_tally)
218+
result_ = assert_equals(1, delta)
219+
end associate
220+
contains
221+
subroutine finalize_intent_out_arg(output)
222+
type(object_t), intent(out) :: output ! finalizes output
223+
output%dummy = avoid_unused_variable_warning
224+
end subroutine
225+
end function
226+
119227
end module compiler_test

0 commit comments

Comments
 (0)