Skip to content

Commit b4f3e9a

Browse files
jacobwilliamsjacobwilliams
committed
added tests for new info routines.
1 parent 06b5f64 commit b4f3e9a

File tree

4 files changed

+182
-3
lines changed

4 files changed

+182
-3
lines changed

‎src/json_value_module.F90

Lines changed: 13 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1110,9 +1110,21 @@ subroutine json_matrix_info(json,p,is_matrix,var_type,n_sets,set_size,name)
11101110
integer(IK) :: icount !! number of elements in a set
11111111
integer :: i !! counter
11121112
integer :: j !! counter
1113+
#if defined __GFORTRAN__
1114+
character(kind=CK,len=:),allocatable :: p_name !! for getting the name
1115+
#endif
11131116

11141117
!get info about the variable:
1115-
call json%info(p,vartype,nr,name) !name is set here if present
1118+
#if defined __GFORTRAN__
1119+
! [note: passing name directory to this routine seems
1120+
! to have a bug on gfortran 6.1.0, so we use a
1121+
! temp variable]
1122+
call json%info(p,vartype,nr,p_name)
1123+
if (present(name)) name = p_name
1124+
if (allocated(p_name)) deallocate(p_name)
1125+
#else
1126+
call json%info(p,vartype,nr,name)
1127+
#endif
11161128

11171129
is_matrix = (vartype==json_array)
11181130

‎src/tests/jf_test_10.f90

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -87,7 +87,7 @@ subroutine test_10(error_cnt)
8787
end if
8888

8989
write(error_unit,'(A)') 'json_file_variable_info...'
90-
call f%info('blah',found,var_type,n_children)
90+
call f%info('blah',found,var_type,n_children,name)
9191
if (f%failed()) then
9292
call f%print_error_message(error_unit)
9393
error_cnt = error_cnt + 1

‎src/tests/jf_test_19.f90

Lines changed: 143 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,143 @@
1+
!*****************************************************************************************
2+
!> author: Jacob Williams
3+
! date: 6/25/2016
4+
!
5+
! Test the matrix info routines.
6+
7+
module jf_test_19_mod
8+
9+
use json_module, lk => json_lk, rk => json_rk, ik => json_ik, ck => json_ck
10+
use, intrinsic :: iso_fortran_env , only: error_unit,output_unit
11+
12+
implicit none
13+
14+
contains
15+
16+
subroutine test_19(error_cnt)
17+
18+
implicit none
19+
20+
integer,intent(out) :: error_cnt !! report number of errors to caller
21+
22+
type(json_core) :: json
23+
type(json_value),pointer :: p,p_matrix
24+
logical(lk) :: is_matrix,found
25+
integer(ik) :: var_type,n_sets,set_size
26+
character(kind=CK,len=:),allocatable :: name
27+
28+
!>
29+
! Example JSON matrix data
30+
character(kind=CK,len=*),parameter :: json_example = &
31+
'{'//&
32+
' "matrix": ['//&
33+
' [1,2,3,4],'//&
34+
' [1,2,3,4],'//&
35+
' [1,2,3,4]'//&
36+
' ]'//&
37+
'}'
38+
39+
write(error_unit,'(A)') ''
40+
write(error_unit,'(A)') '================================='
41+
write(error_unit,'(A)') ' TEST 19'
42+
write(error_unit,'(A)') '================================='
43+
write(error_unit,'(A)') ''
44+
45+
error_cnt = 0
46+
47+
write(error_unit,'(A)') ''
48+
write(error_unit,'(A)') '-------------'
49+
write(error_unit,'(A)') 'JSON data:'
50+
write(error_unit,'(A)') '-------------'
51+
write(error_unit,'(A)') ''
52+
call json%parse(p,json_example)
53+
call json%print(p,error_unit)
54+
55+
!get some info:
56+
call json%get(p,'matrix',p_matrix)
57+
call json%matrix_info(p_matrix,is_matrix,var_type,n_sets,set_size,name)
58+
59+
if (json%failed()) then
60+
call json%print_error_message(error_unit)
61+
error_cnt = error_cnt + 1
62+
else
63+
if (is_matrix .and. &
64+
var_type==json_integer .and. &
65+
n_sets==3 .and. &
66+
set_size==4 .and. &
67+
name=='matrix') then
68+
write(error_unit,'(A)') '...success'
69+
else
70+
write(error_unit,'(A)') 'Error getting matrix info:'
71+
write(error_unit,*) 'is_matrix:',is_matrix
72+
write(error_unit,*) 'var_type :',var_type
73+
write(error_unit,*) 'n_sets :',n_sets
74+
write(error_unit,*) 'set_size :',set_size
75+
write(error_unit,*) 'name :'//name
76+
error_cnt = error_cnt + 1
77+
end if
78+
end if
79+
80+
! now, test by path:
81+
call json%matrix_info(p,'matrix',is_matrix,&
82+
var_type=var_type,n_sets=n_sets,&
83+
set_size=set_size,name=name)
84+
85+
if (json%failed()) then
86+
call json%print_error_message(error_unit)
87+
error_cnt = error_cnt + 1
88+
else
89+
if (is_matrix .and. &
90+
var_type==json_integer .and. &
91+
n_sets==3 .and. &
92+
set_size==4 .and. &
93+
name=='matrix') then
94+
write(error_unit,'(A)') '...success'
95+
else
96+
write(error_unit,'(A)') 'Error getting matrix info by path:'
97+
write(error_unit,*) 'is_matrix:',is_matrix
98+
write(error_unit,*) 'var_type :',var_type
99+
write(error_unit,*) 'n_sets :',n_sets
100+
write(error_unit,*) 'set_size :',set_size
101+
write(error_unit,*) 'name :'//name
102+
error_cnt = error_cnt + 1
103+
end if
104+
end if
105+
106+
!also test with "found" input:
107+
call json%matrix_info(p,'matrix',is_matrix,found=found,&
108+
var_type=var_type,n_sets=n_sets,&
109+
set_size=set_size,name=name)
110+
if (found) then
111+
write(error_unit,'(A)') '...success'
112+
else
113+
write(error_unit,*) 'error calling json_matrix_info_by_path with found input'
114+
error_cnt = error_cnt + 1
115+
end if
116+
117+
! cleanup:
118+
call json%destroy(p)
119+
120+
write(error_unit,'(A)') ''
121+
write(error_unit,'(A)') '================================='
122+
write(error_unit,'(A)') ''
123+
124+
end subroutine test_19
125+
126+
end module jf_test_19_mod
127+
!*****************************************************************************************
128+
129+
!*****************************************************************************************
130+
program jf_test_19
131+
132+
!! 19th unit test.
133+
134+
use jf_test_19_mod, only: test_19
135+
136+
implicit none
137+
138+
integer :: n_errors
139+
call test_19(n_errors)
140+
if ( n_errors /= 0) stop 1
141+
142+
end program jf_test_19
143+
!*****************************************************************************************

‎src/tests/jf_test_4.f90

Lines changed: 25 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -34,7 +34,9 @@ subroutine test_4(error_cnt)
3434

3535
integer :: i
3636
character(kind=json_CK,len=10) :: istr
37-
character(kind=json_CK,len=:),allocatable :: string
37+
character(kind=json_CK,len=:),allocatable :: string,name
38+
logical(json_LK) :: found
39+
integer(json_IK) :: var_type,n_children
3840

3941
error_cnt = 0
4042
call core%initialize()
@@ -104,6 +106,28 @@ subroutine test_4(error_cnt)
104106
write(output_unit,'(A)') string
105107
deallocate(string) !cleanup
106108

109+
write(error_unit,'(A)') ''
110+
write(error_unit,'(A)') 'json_info_by_path'
111+
write(error_unit,'(A)') ''
112+
!get some info:
113+
call core%info(p,'INPUTS',found,var_type,n_children,name)
114+
if (.not. found) then
115+
write(error_unit,'(A)') 'Error getting info on INPUT'
116+
error_cnt = error_cnt + 1
117+
end if
118+
!test without found:
119+
call core%info(p,'INPUTS',var_type=var_type,n_children=n_children,name=name)
120+
if (core%failed()) then
121+
call core%print_error_message(error_unit)
122+
error_cnt = error_cnt + 1
123+
end if
124+
!get with a variable that we know if not present:
125+
call core%info(p,'BLAHBLAH',found,var_type,n_children,name)
126+
if (found) then !should not be found
127+
write(error_unit,'(A)') 'Error: BLAHBLAH should not be there'
128+
error_cnt = error_cnt + 1
129+
end if
130+
107131
!cleanup:
108132
call core%destroy(p)
109133
if (core%failed()) then

0 commit comments

Comments
 (0)