Skip to content

Commit 346852f

Browse files
jacobwilliamsjacobwilliams
committed
added some more unit tests.
update for the gfortran workaround for efficiency.
1 parent 94a59d3 commit 346852f

File tree

2 files changed

+73
-33
lines changed

2 files changed

+73
-33
lines changed

‎src/json_value_module.F90‎

Lines changed: 13 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -4933,10 +4933,20 @@ subroutine duplicate_key_func(json,p,finished)
49334933

49344934
#if defined __GFORTRAN__
49354935

4936-
character(kind=CK,len=:),allocatable :: tmp_name !! workaround for gfortran bugs
4937-
character(kind=CK,len=:),allocatable :: tmp_path !! workaround for gfortran bugs
4936+
! this is a workaround for a gfortran bug (6 and 7),
49384937

4939-
call json%check_children_for_duplicate_keys(p,has_duplicate,tmp_name,tmp_path)
4938+
character(kind=CK,len=:),allocatable :: tmp_name !! temp variable for `name` string
4939+
character(kind=CK,len=:),allocatable :: tmp_path !! temp variable for `path` string
4940+
4941+
if (present(name) .and. present(path)) then
4942+
call json%check_children_for_duplicate_keys(p,has_duplicate,name=tmp_name,path=tmp_path)
4943+
else if (present(name) .and. .not. present(path)) then
4944+
call json%check_children_for_duplicate_keys(p,has_duplicate,name=tmp_name)
4945+
else if (.not. present(name) .and. present(path)) then
4946+
call json%check_children_for_duplicate_keys(p,has_duplicate,path=tmp_path)
4947+
else
4948+
call json%check_children_for_duplicate_keys(p,has_duplicate)
4949+
end if
49404950

49414951
if (has_duplicate) then
49424952
if (present(name)) name = tmp_name

‎src/tests/jf_test_29.f90‎

Lines changed: 60 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -19,58 +19,88 @@ subroutine test_29(error_cnt)
1919

2020
integer,intent(out) :: error_cnt
2121

22-
type(json_value),pointer :: p
23-
type(json_core) :: json
24-
logical(LK) :: has_duplicate
25-
character(kind=CK,len=:),allocatable :: name
26-
character(kind=CK,len=:),allocatable :: path
27-
28-
character(kind=CK,len=*),parameter :: json_str = &
29-
'{"vars": {"a":1, "b":2, "a":3, "a":4, "c":5} }'
30-
3122
error_cnt = 0
32-
call json%initialize()
3323

3424
write(error_unit,'(A)') ''
3525
write(error_unit,'(A)') '================================='
3626
write(error_unit,'(A)') ' TEST 29'
3727
write(error_unit,'(A)') '================================='
3828
write(error_unit,'(A)') ''
3929

40-
write(error_unit,'(A)') ''
41-
write(error_unit,'(A)') 'JSON string: '//json_str
30+
call test(CK_'{"vars":{"a":1,"b":2,"a":3,"a":4,"c":5}}',.true.,CK_'a',CK_'vars.a')
31+
call test(CK_'{"vars":{"a":1,"a":3}}',.true.,CK_'a',CK_'vars.a')
32+
call test(CK_'{"vars":{"aaa":1,"b":2,"aaa":3,"a":4,"c":5}}',.true.,CK_'aaa',CK_'vars.aaa')
33+
call test(CK_'{"vars":{"aaaa":1,"aaaa":3}}',.true.,CK_'aaaa',CK_'vars.aaaa')
34+
call test(CK_'{"a":1,"b":2,"a":3,"a":4,"c":5}',.true.,CK_'a',CK_'a')
35+
call test(CK_'{"c":5}',.false.,CK_'',CK_'')
36+
call test(CK_'{"vars":{"c":5},"array":[1,2]}',.false.,CK_'',CK_'')
37+
call test(CK_'{}',.false.,CK_'',CK_'')
38+
39+
contains
40+
41+
subroutine test(json_str,correct_has_duplicate,correct_name,correct_path)
42+
43+
implicit none
44+
45+
character(kind=CK,len=*),intent(in) :: json_str !! JSON string to check
46+
logical(LK),intent(in) :: correct_has_duplicate !! expected result
47+
character(kind=CK,len=*),intent(in) :: correct_name !! expected result
48+
character(kind=CK,len=*),intent(in) :: correct_path !! expected result
49+
50+
type(json_value),pointer :: p
51+
type(json_core) :: json
52+
logical(LK) :: has_duplicate
53+
character(kind=CK,len=:),allocatable :: name
54+
character(kind=CK,len=:),allocatable :: path
4255

43-
call json%parse(p,json_str)
44-
if (json%failed()) then
45-
call json%print_error_message(error_unit)
46-
error_cnt = error_cnt + 1
47-
else
56+
call json%initialize(no_whitespace=.true.)
4857

4958
write(error_unit,'(A)') ''
50-
call json%check_for_duplicate_keys(p,has_duplicate,name,path)
59+
write(error_unit,'(A)') 'JSON string: '//json_str
60+
61+
call json%parse(p,json_str)
5162
if (json%failed()) then
5263
call json%print_error_message(error_unit)
5364
error_cnt = error_cnt + 1
5465
else
55-
if (has_duplicate) then
56-
write(output_unit,'(A)') 'Duplicate key found:'
57-
write(output_unit,'(A)') ' name: '//trim(name)
58-
write(output_unit,'(A)') ' path: '//trim(path)
59-
if (name /= CK_'a' .or. path /= CK_'vars.a') then
60-
write(error_unit,'(A)') 'Error: incorrect duplicate key name or path'
66+
67+
write(error_unit,'(A)') ''
68+
69+
! just test all options:
70+
call json%check_for_duplicate_keys(p,has_duplicate,name=name)
71+
call json%check_for_duplicate_keys(p,has_duplicate,path=path)
72+
call json%check_for_duplicate_keys(p,has_duplicate)
73+
call json%check_for_duplicate_keys(p,has_duplicate,name=name,path=path)
74+
if (json%failed()) then
75+
call json%print_error_message(error_unit)
76+
error_cnt = error_cnt + 1
77+
else
78+
if (correct_has_duplicate .neqv. has_duplicate) then
79+
write(error_unit,'(A)') ' Test failed.'
6180
error_cnt = error_cnt + 1
6281
else
63-
write(output_unit,'(A)') 'Test passed'
82+
if (has_duplicate) then
83+
write(output_unit,'(A)') ' Duplicate key found:'
84+
write(output_unit,'(A)') ' name: '//trim(name)
85+
write(output_unit,'(A)') ' path: '//trim(path)
86+
if (name/=correct_name .or. path/=correct_path) then
87+
write(error_unit,'(A)') ' Error: incorrect duplicate key name or path'
88+
error_cnt = error_cnt + 1
89+
else
90+
write(output_unit,'(A)') ' Test passed: correct duplicate found'
91+
end if
92+
else
93+
write(output_unit,'(A)') ' Test passed: no duplicates present'
94+
end if
6495
end if
65-
else
66-
write(error_unit,'(A)') 'Test failed. Duplicate keys not found'
67-
error_cnt = error_cnt + 1
6896
end if
97+
6998
end if
7099

71-
end if
100+
call json%destroy(p)
101+
call json%destroy()
72102

73-
call json%destroy(p)
103+
end subroutine test
74104

75105
end subroutine test_29
76106

0 commit comments

Comments
 (0)