Skip to content

Commit 61cbad1

Browse files
jacobwilliamsjacobwilliams
committed
updates and unit tests.
1 parent d77eaaa commit 61cbad1

File tree

4 files changed

+224
-4
lines changed

4 files changed

+224
-4
lines changed

‎src/json_file_module.F90

Lines changed: 6 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1835,16 +1835,17 @@ end subroutine wrap_json_file_get_string
18351835
!
18361836
! Get a string vector from a JSON file.
18371837

1838-
subroutine json_file_get_string_vec(me, path, vec, found)
1838+
subroutine json_file_get_string_vec(me, path, vec, found, default)
18391839

18401840
implicit none
18411841

18421842
class(json_file),intent(inout) :: me
18431843
character(kind=CK,len=*),intent(in) :: path !! the path to the variable
18441844
character(kind=CK,len=*),dimension(:),allocatable,intent(out) :: vec !! value vector
18451845
logical(LK),intent(out),optional :: found !! if it was really found
1846+
character(kind=CK,len=*),dimension(:),intent(in),optional :: default
18461847

1847-
call me%core%get(me%p, path, vec, found)
1848+
call me%core%get(me%p, path, vec, found, default)
18481849

18491850
end subroutine json_file_get_string_vec
18501851
!*****************************************************************************************
@@ -1853,16 +1854,17 @@ end subroutine json_file_get_string_vec
18531854
!>
18541855
! Alternate version of [[json_file_get_string_vec]], where "path" is kind=CDK.
18551856

1856-
subroutine wrap_json_file_get_string_vec(me, path, vec, found)
1857+
subroutine wrap_json_file_get_string_vec(me, path, vec, found, default)
18571858

18581859
implicit none
18591860

18601861
class(json_file),intent(inout) :: me
18611862
character(kind=CDK,len=*),intent(in) :: path !! the path to the variable
18621863
character(kind=CK,len=*),dimension(:),allocatable,intent(out) :: vec !! value vector
18631864
logical(LK),intent(out),optional :: found !! if it was really found
1865+
character(kind=CK,len=*),dimension(:),intent(in),optional :: default
18641866

1865-
call me%get(to_unicode(path), vec, found)
1867+
call me%get(to_unicode(path), vec, found, default)
18661868

18671869
end subroutine wrap_json_file_get_string_vec
18681870
!*****************************************************************************************

‎src/tests/jf_test_46.F90

Lines changed: 214 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,214 @@
1+
!*****************************************************************************************
2+
!>
3+
! Module for the 46th unit test
4+
5+
module jf_test_46_mod
6+
7+
use json_module, CK => json_CK, IK => json_IK, RK => json_RK, LK => json_LK
8+
use, intrinsic :: iso_fortran_env , only: error_unit, output_unit
9+
10+
implicit none
11+
12+
private
13+
public :: test_46
14+
15+
contains
16+
17+
subroutine test_46(error_cnt)
18+
19+
!! testing of default optional argument
20+
21+
implicit none
22+
23+
integer,intent(out) :: error_cnt !! error counter
24+
25+
character(kind=CK,len=*),parameter :: str = CK_'{"x": 1}'
26+
27+
type(json_core) :: json
28+
type(json_file) :: json_f
29+
type(json_value),pointer :: p
30+
logical(LK) :: found
31+
integer(IK) :: ival
32+
real(RK) :: rval
33+
logical(LK) :: lval
34+
character(kind=CK,len=:),allocatable :: cval
35+
character(kind=CK,len=1),dimension(:),allocatable :: cvec
36+
37+
character(kind=CK,len=1),dimension(1) :: cvec_default = [CK_'1']
38+
39+
write(error_unit,'(A)') ''
40+
write(error_unit,'(A)') '================================='
41+
write(error_unit,'(A)') ' TEST 46'
42+
write(error_unit,'(A)') '================================='
43+
write(error_unit,'(A)') ''
44+
45+
! note: don't have one for json_get_alloc_string_vec_by_path
46+
47+
error_cnt = 0
48+
49+
!---------------------------------
50+
! first core routines:
51+
!---------------------------------
52+
53+
call json%deserialize(p,str)
54+
55+
! unicode:
56+
call json%get(p, CK_'not_there', ival, found, default=99_IK)
57+
if (json%failed() .or. found .or. ival /= 99_IK) then
58+
write(error_unit,'(A)') 'Error using json_get_integer_by_path default'
59+
error_cnt = error_cnt + 1
60+
end if
61+
62+
call json%get(p, CK_'not_there', rval, found, default=99.0_RK)
63+
if (json%failed() .or. found .or. rval-99.0_RK>0.0_RK) then
64+
write(error_unit,'(A)') 'Error using json_get_real_by_path default'
65+
error_cnt = error_cnt + 1
66+
end if
67+
68+
call json%get(p, CK_'not_there', lval, found, default=.true.)
69+
if (json%failed() .or. found .or. lval .neqv. .true.) then
70+
write(error_unit,'(A)') 'Error using json_get_logical_by_path default'
71+
error_cnt = error_cnt + 1
72+
end if
73+
74+
call json%get(p, CK_'not_there', cval, found, default=CK_'default')
75+
if (json%failed() .or. found .or. cval /= CK_'default') then
76+
write(error_unit,'(A)') 'Error using json_get_string_by_path default'
77+
error_cnt = error_cnt + 1
78+
end if
79+
80+
call json%get(p, CK_'not_there', cvec, found, default=cvec_default)
81+
if (json%failed() .or. found .or. all(cvec /= cvec_default)) then
82+
write(error_unit,'(A)') 'Error using json_get_string_vec_by_path default'
83+
error_cnt = error_cnt + 1
84+
end if
85+
86+
! default:
87+
call json%get(p, 'not_there', ival, found, default=99_IK)
88+
if (json%failed() .or. found .or. ival /= 99_IK) then
89+
write(error_unit,'(A)') 'Error using json_get_integer_by_path default'
90+
error_cnt = error_cnt + 1
91+
end if
92+
93+
call json%get(p, 'not_there', rval, found, default=99.0_RK)
94+
if (json%failed() .or. found .or. rval-99.0_RK>0.0_RK) then
95+
write(error_unit,'(A)') 'Error using json_get_real_by_path default'
96+
error_cnt = error_cnt + 1
97+
end if
98+
99+
call json%get(p, 'not_there', lval, found, default=.true.)
100+
if (json%failed() .or. found .or. lval .neqv. .true.) then
101+
write(error_unit,'(A)') 'Error using json_get_logical_by_path default'
102+
error_cnt = error_cnt + 1
103+
end if
104+
105+
call json%get(p, 'not_there', cval, found, default=CK_'default')
106+
if (json%failed() .or. found .or. cval /= CK_'default') then
107+
write(error_unit,'(A)') 'Error using json_get_string_by_path default'
108+
error_cnt = error_cnt + 1
109+
end if
110+
111+
call json%get(p, 'not_there', cvec, found, default=[CK_'1'])
112+
if (json%failed() .or. found .or. all(cvec /= [CK_'1'])) then
113+
write(error_unit,'(A)') 'Error using json_get_string_vec_by_path default'
114+
error_cnt = error_cnt + 1
115+
end if
116+
117+
call json%destroy(p)
118+
119+
!---------------------------------
120+
! now, json_file routines:
121+
!---------------------------------
122+
123+
json_f = json_file(str)
124+
125+
! unicode:
126+
call json_f%get(CK_'not_there', ival, found, default=99_IK)
127+
if (json%failed() .or. found .or. ival /= 99_IK) then
128+
write(error_unit,'(A)') 'Error using json_get_integer_by_path default'
129+
error_cnt = error_cnt + 1
130+
end if
131+
132+
call json_f%get(CK_'not_there', rval, found, default=99.0_RK)
133+
if (json%failed() .or. found .or. rval-99.0_RK>0.0_RK) then
134+
write(error_unit,'(A)') 'Error using json_get_real_by_path default'
135+
error_cnt = error_cnt + 1
136+
end if
137+
138+
call json_f%get(CK_'not_there', lval, found, default=.true.)
139+
if (json%failed() .or. found .or. lval .neqv. .true.) then
140+
write(error_unit,'(A)') 'Error using json_get_logical_by_path default'
141+
error_cnt = error_cnt + 1
142+
end if
143+
144+
call json_f%get(CK_'not_there', cval, found, default=CK_'default')
145+
if (json%failed() .or. found .or. cval /= CK_'default') then
146+
write(error_unit,'(A)') 'Error using json_get_string_by_path default'
147+
error_cnt = error_cnt + 1
148+
end if
149+
150+
call json_f%get(CK_'not_there', cvec, found, default=cvec_default)
151+
if (json%failed() .or. found .or. all(cvec /= cvec_default)) then
152+
write(error_unit,'(A)') 'Error using json_get_string_vec_by_path default'
153+
error_cnt = error_cnt + 1
154+
end if
155+
156+
! default:
157+
call json_f%get('not_there', ival, found, default=99_IK)
158+
if (json%failed() .or. found .or. ival /= 99_IK) then
159+
write(error_unit,'(A)') 'Error using json_get_integer_by_path default'
160+
error_cnt = error_cnt + 1
161+
end if
162+
163+
call json_f%get('not_there', rval, found, default=99.0_RK)
164+
if (json%failed() .or. found .or. rval-99.0_RK>0.0_RK) then
165+
write(error_unit,'(A)') 'Error using json_get_real_by_path default'
166+
error_cnt = error_cnt + 1
167+
end if
168+
169+
call json_f%get('not_there', lval, found, default=.true.)
170+
if (json%failed() .or. found .or. lval .neqv. .true.) then
171+
write(error_unit,'(A)') 'Error using json_get_logical_by_path default'
172+
error_cnt = error_cnt + 1
173+
end if
174+
175+
call json_f%get('not_there', cval, found, default=CK_'default')
176+
if (json%failed() .or. found .or. cval /= CK_'default') then
177+
write(error_unit,'(A)') 'Error using json_get_string_by_path default'
178+
error_cnt = error_cnt + 1
179+
end if
180+
181+
call json_f%get('not_there', cvec, found, default=cvec_default)
182+
if (json%failed() .or. found .or. all(cvec /= cvec_default)) then
183+
write(error_unit,'(A)') 'Error using json_get_string_vec_by_path default'
184+
error_cnt = error_cnt + 1
185+
end if
186+
187+
if (error_cnt==0) then
188+
write(error_unit,'(A)') 'Success!'
189+
else
190+
write(error_unit,'(A)') 'Failed!'
191+
end if
192+
write(error_unit,'(A)') ''
193+
194+
end subroutine test_46
195+
196+
end module jf_test_46_mod
197+
!*****************************************************************************************
198+
199+
#ifndef INTEGRATED_TESTS
200+
!*****************************************************************************************
201+
program jf_test_46
202+
203+
!! 46th unit test.
204+
205+
use jf_test_46_mod , only: test_46
206+
implicit none
207+
integer :: n_errors
208+
n_errors = 0
209+
call test_46(n_errors)
210+
if (n_errors /= 0) stop 1
211+
212+
end program jf_test_46
213+
!*****************************************************************************************
214+
#endif

‎visual_studio/jsonfortrantest/jsonfortrantest.f90

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -100,6 +100,8 @@ program jsonfortrantest
100100
call test_42(n_errors); if (n_errors /= 0) stop 1
101101
call test_43(n_errors); if (n_errors /= 0) stop 1
102102
call test_44(n_errors); if (n_errors /= 0) stop 1
103+
call test_45(n_errors); if (n_errors /= 0) stop 1
104+
call test_46(n_errors); if (n_errors /= 0) stop 1
103105

104106
end program jsonfortrantest
105107
!*****************************************************************************************

‎visual_studio/jsonfortrantest/jsonfortrantest.vfproj

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -90,5 +90,7 @@
9090
<File RelativePath="..\..\src\tests\jf_test_42.F90"/>
9191
<File RelativePath="..\..\src\tests\jf_test_43.F90"/>
9292
<File RelativePath="..\..\src\tests\jf_test_44.F90"/>
93+
<File RelativePath="..\..\src\tests\jf_test_45.F90"/>
94+
<File RelativePath="..\..\src\tests\jf_test_46.F90"/>
9395
<File RelativePath=".\jsonfortrantest.f90"/></Filter></Files>
9496
<Globals/></VisualStudioProject>

0 commit comments

Comments
 (0)