Skip to content

Commit b2c0b17

Browse files
jacobwilliamsjacobwilliams
authored
Merge pull request #419 from jacobwilliams/416-get-vec-exceptions
deallocate output array if an exception occurs during a get_vec call.…
2 parents 91ed2e6 + c863c9d commit b2c0b17

File tree

3 files changed

+206
-64
lines changed

3 files changed

+206
-64
lines changed

‎src/json_file_module.F90‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -447,7 +447,7 @@ subroutine json_file_check_for_errors(me,status_ok,error_msg)
447447
#if defined __GFORTRAN__
448448
character(kind=CK,len=:),allocatable :: tmp !! workaround for gfortran bugs
449449
call me%core%check_for_errors(status_ok,tmp)
450-
error_msg = tmp
450+
if (present(error_msg)) error_msg = tmp
451451
#else
452452
call me%core%check_for_errors(status_ok,error_msg)
453453
#endif

‎src/json_value_module.F90‎

Lines changed: 23 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -8152,6 +8152,8 @@ subroutine json_get_integer_vec(json, me, vec)
81528152

81538153
logical(LK) :: initialized
81548154

8155+
if ( json%exception_thrown ) return
8156+
81558157
! check for 0-length arrays first:
81568158
select case (me%var_type)
81578159
case (json_array)
@@ -8166,6 +8168,8 @@ subroutine json_get_integer_vec(json, me, vec)
81668168
!the callback function is called for each element of the array:
81678169
call json%get(me, array_callback=get_int_from_array)
81688170

8171+
if (json%exception_thrown .and. allocated(vec)) deallocate(vec)
8172+
81698173
contains
81708174

81718175
subroutine get_int_from_array(json, element, i, count)
@@ -8400,6 +8404,8 @@ subroutine json_get_real_vec(json, me, vec)
84008404

84018405
logical(LK) :: initialized
84028406

8407+
if ( json%exception_thrown ) return
8408+
84038409
! check for 0-length arrays first:
84048410
select case (me%var_type)
84058411
case (json_array)
@@ -8414,6 +8420,8 @@ subroutine json_get_real_vec(json, me, vec)
84148420
!the callback function is called for each element of the array:
84158421
call json%get(me, array_callback=get_real_from_array)
84168422

8423+
if (json%exception_thrown .and. allocated(vec)) deallocate(vec)
8424+
84178425
contains
84188426

84198427
subroutine get_real_from_array(json, element, i, count)
@@ -8876,6 +8884,8 @@ subroutine json_get_logical_vec(json, me, vec)
88768884

88778885
logical(LK) :: initialized
88788886

8887+
if ( json%exception_thrown ) return
8888+
88798889
! check for 0-length arrays first:
88808890
select case (me%var_type)
88818891
case (json_array)
@@ -8890,6 +8900,8 @@ subroutine json_get_logical_vec(json, me, vec)
88908900
!the callback function is called for each element of the array:
88918901
call json%get(me, array_callback=get_logical_from_array)
88928902

8903+
if (json%exception_thrown .and. allocated(vec)) deallocate(vec)
8904+
88938905
contains
88948906

88958907
subroutine get_logical_from_array(json, element, i, count)
@@ -9153,6 +9165,8 @@ subroutine json_get_string_vec(json, me, vec)
91539165

91549166
logical(LK) :: initialized
91559167

9168+
if ( json%exception_thrown ) return
9169+
91569170
! check for 0-length arrays first:
91579171
select case (me%var_type)
91589172
case (json_array)
@@ -9167,6 +9181,8 @@ subroutine json_get_string_vec(json, me, vec)
91679181
!the callback function is called for each element of the array:
91689182
call json%get(me, array_callback=get_chars_from_array)
91699183

9184+
if (json%exception_thrown .and. allocated(vec)) deallocate(vec)
9185+
91709186
contains
91719187

91729188
subroutine get_chars_from_array(json, element, i, count)
@@ -9285,6 +9301,8 @@ subroutine json_get_alloc_string_vec(json, me, vec, ilen)
92859301
logical(LK) :: initialized !! if the output array has been sized
92869302
integer(IK) :: max_len !! the length of the longest string in the array
92879303

9304+
if ( json%exception_thrown ) return
9305+
92889306
! check for 0-length arrays first:
92899307
select case (me%var_type)
92909308
case (json_array)
@@ -9303,6 +9321,11 @@ subroutine json_get_alloc_string_vec(json, me, vec, ilen)
93039321
call json%get(me, array_callback=get_chars_from_array)
93049322
end if
93059323

9324+
if (json%exception_thrown) then
9325+
if (allocated(vec)) deallocate(vec)
9326+
if (allocated(ilen)) deallocate(ilen)
9327+
end if
9328+
93069329
contains
93079330

93089331
subroutine get_chars_from_array(json, element, i, count)
@@ -9434,8 +9457,6 @@ subroutine json_get_array(json, me, array_callback)
94349457

94359458
if ( json%exception_thrown ) return
94369459

9437-
nullify(element)
9438-
94399460
select case (me%var_type)
94409461
case (json_array)
94419462
count = json%count(me)
@@ -9451,15 +9472,10 @@ subroutine json_get_array(json, me, array_callback)
94519472
element => element%next
94529473
end do
94539474
case default
9454-
94559475
call json%throw_exception('Error in json_get_array:'//&
94569476
' Resolved value is not an array ')
9457-
94589477
end select
94599478

9460-
!cleanup:
9461-
if (associated(element)) nullify(element)
9462-
94639479
end subroutine json_get_array
94649480
!*****************************************************************************************
94659481

‎src/tests/jf_test_15.F90‎

Lines changed: 182 additions & 56 deletions
Original file line numberDiff line numberDiff line change
@@ -33,6 +33,9 @@ subroutine test_15(error_cnt)
3333
real(wp) :: d
3434
logical(LK) :: tf
3535
character(kind=CK,len=:),allocatable :: error_msg
36+
integer(IK),dimension(:),allocatable :: ivec
37+
real(wp),dimension(:),allocatable :: rvec
38+
logical(LK),dimension(:),allocatable :: lvec
3639

3740
write(error_unit,'(A)') ''
3841
write(error_unit,'(A)') '================================='
@@ -45,62 +48,185 @@ subroutine test_15(error_cnt)
4548
nullify(p2)
4649
nullify(p)
4750

48-
call json%deserialize(p2, '{"int": 1, "real": 2.0, "logical": true}')
49-
call json%get(p2,'real', i)
50-
call json%get(p2,'logical',i)
51-
call json%get(p2,'integer',d)
52-
call json%get(p2,'logical',d)
53-
call json%get(p2,'integer',tf)
54-
call json%get(p2,'real', tf)
55-
56-
call json%check_for_errors(status_ok, error_msg) !error condition true
57-
call json%check_for_errors(status_ok) !error condition true
58-
call json%check_for_errors(error_msg=error_msg) !error condition true
59-
60-
call json%initialize(print_signs=.true.) !print signs flag
61-
62-
call json%check_for_errors(status_ok, error_msg) !error condition false
63-
call json%check_for_errors(status_ok) !error condition false
64-
call json%check_for_errors(error_msg=error_msg) !error condition false - not allocated
65-
66-
call file1%move(file2) !should throw an exception since pointers are not associated
67-
call file1%initialize()
68-
69-
call file1%print(-1_IK) !invalid input
70-
call file1%initialize()
71-
72-
call file1%print(filename='') !invalid filename
73-
call file1%initialize()
74-
75-
call file1%info('this path does not exist',found,var_type,n_children)
76-
call file1%initialize()
77-
78-
call file1%check_for_errors(status_ok,error_msg)
79-
call file1%clear_exceptions()
80-
call file1%destroy()
81-
file1 = json_file(p2,json) !constructor
82-
call file1%destroy(destroy_core=.true.)
83-
84-
call json%initialize( verbose=.false.,&
85-
compact_reals=.true.,&
86-
print_signs=.false.,&
87-
real_format='E',&
88-
spaces_per_tab=4_IK,&
89-
strict_type_checking=.true.,&
90-
trailing_spaces_significant=.false.,&
91-
case_sensitive_keys=.true.)
92-
93-
call json%get_child(p2,-99_IK,p) !invalid index
94-
call json%initialize() !clear exceptions
95-
96-
call json%get_child(p2,'this child does not exist',p) !invalid index
97-
call json%initialize() !clear exceptions
98-
99-
call json%print(p2,-1_IK) !invalid input
100-
call json%initialize() !clear exceptions
101-
102-
call json%print(p2,filename='') !invalid input
103-
call json%initialize() !clear exceptions
51+
call json%initialize(strict_type_checking=.true.)
52+
call json%deserialize(p2, '{"int": 1, "real": 2.0, "logical": true, "vec": [1, 1.0, "1.0", false]}')
53+
if (json%failed()) then
54+
error_cnt=error_cnt+1
55+
call json%print_error_message(error_unit)
56+
else
57+
58+
! these should all raise exceptions:
59+
call json%get(p2,'real', i)
60+
call json%check_for_errors(status_ok)
61+
if (status_ok) then
62+
error_cnt=error_cnt+1
63+
write(error_unit,'(A)') 'Error: real'
64+
end if
65+
call json%initialize()
66+
67+
call json%get(p2,'logical',i)
68+
call json%check_for_errors(status_ok)
69+
if (status_ok) then
70+
error_cnt=error_cnt+1
71+
write(error_unit,'(A)') 'Error: logical'
72+
end if
73+
call json%initialize()
74+
75+
call json%get(p2,'integer',d)
76+
call json%check_for_errors(status_ok)
77+
if (status_ok) then
78+
error_cnt=error_cnt+1
79+
write(error_unit,'(A)') 'Error: integer'
80+
end if
81+
call json%initialize()
82+
83+
call json%get(p2,'logical',d)
84+
call json%check_for_errors(status_ok)
85+
if (status_ok) then
86+
error_cnt=error_cnt+1
87+
write(error_unit,'(A)') 'Error: logical'
88+
end if
89+
call json%initialize()
90+
91+
call json%get(p2,'integer',tf)
92+
call json%check_for_errors(status_ok)
93+
if (status_ok) then
94+
error_cnt=error_cnt+1
95+
write(error_unit,'(A)') 'Error: integer'
96+
end if
97+
call json%initialize()
98+
99+
call json%get(p2,'real', tf)
100+
call json%check_for_errors(status_ok)
101+
if (status_ok) then
102+
error_cnt=error_cnt+1
103+
write(error_unit,'(A)') 'Error: real'
104+
end if
105+
106+
!****************************************
107+
! test exceptions when trying to get a vector:
108+
call json%get(p2,'vec',ivec)
109+
call json%check_for_errors(status_ok)
110+
if (status_ok) then
111+
error_cnt=error_cnt+1
112+
write(error_unit,'(A)') 'Error: ivec'
113+
end if
114+
call json%initialize()
115+
116+
call json%get(p2,'vec',rvec)
117+
call json%check_for_errors(status_ok)
118+
if (status_ok) then
119+
error_cnt=error_cnt+1
120+
write(error_unit,'(A)') 'Error: rvec'
121+
end if
122+
call json%initialize()
123+
124+
call json%get(p2,'vec',lvec)
125+
call json%check_for_errors(status_ok)
126+
if (status_ok) then
127+
error_cnt=error_cnt+1
128+
write(error_unit,'(A)') 'Error: lvec'
129+
end if
130+
call json%initialize()
131+
132+
call json%check_for_errors(status_ok, error_msg) !error condition true
133+
call json%check_for_errors(error_msg=error_msg) !error condition true
134+
call json%initialize(print_signs=.true.) !print signs flag
135+
136+
call json%check_for_errors(status_ok, error_msg) !error condition false
137+
call json%check_for_errors(status_ok) !error condition false
138+
call json%check_for_errors(error_msg=error_msg) !error condition false - not allocated
139+
140+
call file1%move(file2) !should throw an exception since pointers are not associated
141+
call file1%check_for_errors(status_ok)
142+
if (status_ok) then
143+
error_cnt=error_cnt+1
144+
write(error_unit,'(A)') 'Error: move'
145+
end if
146+
call file1%initialize()
147+
148+
call file1%print(-1_IK) !invalid input
149+
call file1%check_for_errors(status_ok)
150+
if (status_ok) then
151+
error_cnt=error_cnt+1
152+
write(error_unit,'(A)') 'Error: print to invalid unit'
153+
end if
154+
call file1%initialize()
155+
156+
call file1%print(filename='') !invalid filename
157+
call file1%check_for_errors(status_ok)
158+
if (status_ok) then
159+
error_cnt=error_cnt+1
160+
write(error_unit,'(A)') 'Error: print to invalid filename'
161+
end if
162+
call file1%initialize()
163+
164+
call file1%info('this path does not exist',var_type=var_type,n_children=n_children)
165+
call file1%check_for_errors(status_ok)
166+
if (status_ok) then
167+
error_cnt=error_cnt+1
168+
write(error_unit,'(A)') 'Error: path that does not exist'
169+
end if
170+
171+
call file1%check_for_errors(status_ok,error_msg)
172+
call file1%clear_exceptions()
173+
call file1%destroy()
174+
175+
call json%initialize( verbose = .false., &
176+
compact_reals = .true., &
177+
print_signs = .false., &
178+
real_format = 'E', &
179+
spaces_per_tab = 4_IK, &
180+
strict_type_checking = .true., &
181+
trailing_spaces_significant = .false., &
182+
case_sensitive_keys = .true. )
183+
184+
call json%get_child(p2,-99_IK,p) !invalid index
185+
call json%check_for_errors(status_ok)
186+
if (status_ok) then
187+
error_cnt=error_cnt+1
188+
write(error_unit,'(A)') 'Error: invalid index'
189+
end if
190+
call json%initialize()
191+
192+
call json%get_child(p2,'this child does not exist',p) !invalid index
193+
call json%check_for_errors(status_ok)
194+
if (status_ok) then
195+
error_cnt=error_cnt+1
196+
write(error_unit,'(A)') 'Error: invalid index'
197+
end if
198+
call json%initialize()
199+
200+
call json%print(p2,-1_IK) !invalid input
201+
call json%check_for_errors(status_ok)
202+
if (status_ok) then
203+
error_cnt=error_cnt+1
204+
write(error_unit,'(A)') 'Error: invalid input'
205+
end if
206+
call json%initialize()
207+
208+
call json%print(p2,filename='') !invalid input
209+
call json%check_for_errors(status_ok)
210+
if (status_ok) then
211+
error_cnt=error_cnt+1
212+
write(error_unit,'(A)') 'Error: invalid input'
213+
end if
214+
call json%initialize()
215+
216+
!****************************************
217+
218+
file1 = json_file(p2,json) !constructor
219+
call file1%destroy(destroy_core=.true.)
220+
221+
!****************************************
222+
223+
end if
224+
225+
if (error_cnt>0) then
226+
write(error_unit,'(A)') ' FAILED!'
227+
else
228+
write(error_unit,'(A)') ' Success!'
229+
end if
104230

105231
end subroutine test_15
106232

0 commit comments

Comments
 (0)