Skip to content

Commit 23755c9

Browse files
jacobwilliamsjacobwilliams
committed
bug fix and minor changes.
added unit tests.
1 parent fdfaf40 commit 23755c9

File tree

2 files changed

+140
-9
lines changed

2 files changed

+140
-9
lines changed

‎src/json_value_module.F90‎

Lines changed: 8 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -1139,7 +1139,7 @@ end subroutine json_info
11391139
!> author: Jacob Williams
11401140
! date: 12/18/2016
11411141
!
1142-
! Returns information about characters strings returned from a [[json_value]].
1142+
! Returns information about character strings returned from a [[json_value]].
11431143

11441144
subroutine json_string_info(json,p,ilen,max_str_len,found)
11451145

@@ -1167,15 +1167,14 @@ subroutine json_string_info(json,p,ilen,max_str_len,found)
11671167
logical(LK) :: initialized !! if the output array has been sized
11681168
logical(LK) :: get_max_len !! if we are returning the `max_str_len`
11691169
logical(LK) :: get_ilen !! if we are returning the `ilen` array
1170-
logical(LK) :: is_array !! if the variable is an array
11711170
integer(IK) :: var_type !! variable type
11721171

11731172
get_max_len = present(max_str_len)
11741173
get_ilen = present(ilen)
11751174

11761175
if (.not. json%exception_thrown) then
11771176

1178-
found = .true.
1177+
if (present(found)) found = .true.
11791178
initialized = .false.
11801179

11811180
if (get_max_len) max_str_len = 0
@@ -6433,7 +6432,7 @@ subroutine json_get_logical(json, me, value)
64336432

64346433
class(json_core),intent(inout) :: json
64356434
type(json_value),pointer,intent(in) :: me
6436-
logical(LK) :: value
6435+
logical(LK),intent(out) :: value
64376436

64386437
value = .false.
64396438
if ( json%exception_thrown ) return
@@ -6472,7 +6471,7 @@ subroutine json_get_logical_by_path(json, me, path, value, found)
64726471
class(json_core),intent(inout) :: json
64736472
type(json_value),pointer,intent(in) :: me
64746473
character(kind=CK,len=*),intent(in) :: path
6475-
logical(LK) :: value
6474+
logical(LK),intent(out) :: value
64766475
logical(LK),intent(out),optional :: found
64776476

64786477
type(json_value),pointer :: p
@@ -6522,7 +6521,7 @@ subroutine wrap_json_get_logical_by_path(json, me, path, value, found)
65226521
class(json_core),intent(inout) :: json
65236522
type(json_value),pointer,intent(in) :: me
65246523
character(kind=CDK,len=*),intent(in) :: path
6525-
logical(LK) :: value
6524+
logical(LK),intent(out) :: value
65266525
logical(LK),intent(out),optional :: found
65276526

65286527
call json%get(me,to_unicode(path),value,found)
@@ -6928,8 +6927,8 @@ subroutine json_get_alloc_string_vec(json, me, vec, ilen)
69286927

69296928
implicit none
69306929

6931-
class(json_core),intent(inout) :: json
6932-
type(json_value),pointer,intent(in) :: me
6930+
class(json_core),intent(inout) :: json
6931+
type(json_value),pointer,intent(in) :: me
69336932
character(kind=CK,len=:),dimension(:),allocatable,intent(out) :: vec
69346933
integer(IK),dimension(:),allocatable,intent(out) :: ilen !! the actual length
69356934
!! of each character
@@ -6965,7 +6964,7 @@ subroutine get_chars_from_array(json, element, i, count)
69656964
if (.not. initialized) then
69666965
! string length long enough to hold the longest one
69676966
allocate( character(kind=CK,len=max_len) :: vec(count) )
6968-
allocate( ilen(count) )
6967+
!allocate( ilen(count) )
69696968
initialized = .true.
69706969
end if
69716970

‎src/tests/jf_test_25.F90‎

Lines changed: 132 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,132 @@
1+
!*****************************************************************************************
2+
!>
3+
! Module for the 25th unit test.
4+
5+
module jf_test_25_mod
6+
7+
use json_module, rk => json_rk, lk => json_lk, ik => json_ik, ck => json_ck, cdk => json_cdk
8+
use, intrinsic :: iso_fortran_env , only: error_unit, output_unit
9+
10+
implicit none
11+
12+
contains
13+
14+
subroutine test_25(error_cnt)
15+
16+
!! Test the allocatable string vector routines.
17+
18+
implicit none
19+
20+
integer,intent(out) :: error_cnt
21+
22+
type(json_value),pointer :: p, tmp
23+
type(json_core) :: json
24+
logical(lk) :: found
25+
character(kind=CK,len=:),dimension(:),allocatable :: vec !! array of strings from JSON
26+
integer(ik),dimension(:),allocatable :: ilen !! array of string lengths
27+
28+
character(kind=CK,len=*),parameter :: json_str = &
29+
'{"str_array": ["1","22","333","55555"]}'
30+
31+
error_cnt = 0
32+
call json%initialize( verbose=.false. )
33+
if (json%failed()) then
34+
call json%print_error_message(error_unit)
35+
error_cnt = error_cnt + 1
36+
end if
37+
38+
write(error_unit,'(A)') ''
39+
write(error_unit,'(A)') '================================='
40+
write(error_unit,'(A)') ' TEST 25'
41+
write(error_unit,'(A)') '================================='
42+
write(error_unit,'(A)') ''
43+
44+
write(error_unit,'(A)') ''
45+
write(error_unit,'(A)') 'parsing...'
46+
call json%parse(p,json_str)
47+
if (json%failed()) then
48+
call json%print_error_message(error_unit)
49+
error_cnt = error_cnt + 1
50+
end if
51+
52+
write(error_unit,'(A)') ''
53+
write(error_unit,'(A)') 'printing...'
54+
call json%print(p,output_unit)
55+
56+
write(error_unit,'(A)') ''
57+
write(error_unit,'(A)') 'getting data...'
58+
59+
! get child, then array:
60+
call json%get_child(p,'str_array',tmp)
61+
if (json%failed()) then
62+
call json%print_error_message(error_unit)
63+
error_cnt = error_cnt + 1
64+
end if
65+
call json%get(tmp, vec, ilen)
66+
if (json%failed()) then
67+
call json%print_error_message(error_unit)
68+
error_cnt = error_cnt + 1
69+
end if
70+
if (allocated(vec) .and. allocated(ilen)) then
71+
if (all(ilen==[1,2,3,5])) then
72+
write(error_unit,'(A)') 'success!'
73+
else
74+
write(error_unit,'(A,1X,*(I5,1X))') 'failed: ', ilen
75+
error_cnt = error_cnt + 1
76+
end if
77+
else
78+
write(error_unit,'(A)') 'failed: vectors not allocated.'
79+
error_cnt = error_cnt + 1
80+
end if
81+
82+
! try get by path:
83+
call json%get(p, 'str_array', vec, ilen, found)
84+
if (json%failed()) then
85+
call json%print_error_message(error_unit)
86+
error_cnt = error_cnt + 1
87+
end if
88+
if (all(ilen==[1,2,3,5])) then
89+
write(error_unit,'(A)') 'success!'
90+
else
91+
write(error_unit,'(A,1X,*(I5,1X))') 'failed: ', ilen
92+
error_cnt = error_cnt + 1
93+
end if
94+
95+
#ifdef USE_UCS4
96+
! also try unicode versions:
97+
call json%get(p, CDK_'str_array', vec, ilen, found)
98+
call json%get(p, CK_'str_array', vec, ilen)
99+
if (json%failed()) then
100+
call json%print_error_message(error_unit)
101+
error_cnt = error_cnt + 1
102+
end if
103+
#endif
104+
105+
! clean up
106+
write(error_unit,'(A)') ''
107+
write(error_unit,'(A)') 'destroy...'
108+
call json%destroy(p)
109+
if (json%failed()) then
110+
call json%print_error_message(error_unit)
111+
error_cnt = error_cnt + 1
112+
end if
113+
114+
end subroutine test_25
115+
116+
end module jf_test_25_mod
117+
!*****************************************************************************************
118+
119+
!*****************************************************************************************
120+
program jf_test_25
121+
122+
!! 25th unit test.
123+
124+
use jf_test_25_mod , only: test_25
125+
implicit none
126+
integer :: n_errors
127+
n_errors = 0
128+
call test_25(n_errors)
129+
if (n_errors /= 0) stop 1
130+
131+
end program jf_test_25
132+
!*****************************************************************************************

0 commit comments

Comments
 (0)