Skip to content

Commit 611bbfc

Browse files
committed
added exception checks in new routines.
addition to unit test.
1 parent e0577fc commit 611bbfc

File tree

2 files changed

+47
-23
lines changed

2 files changed

+47
-23
lines changed

src/json_value_module.F90

Lines changed: 38 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -4157,13 +4157,21 @@ subroutine json_get_by_path(json, me, path, p, found)
41574157
!! specify by `path`
41584158
logical(LK),intent(out),optional :: found !! true if it was found
41594159

4160-
! note: it can only be 1 or 2 (which was checked in initialize)
4161-
select case (json%path_mode)
4162-
case(1_IK)
4163-
call json%json_get_by_path_default(me, path, p, found)
4164-
case(2_IK)
4165-
call json%json_get_by_path_rfc6901(me, path, p, found)
4166-
end select
4160+
nullify(p)
4161+
4162+
if (.not. json%exception_thrown) then
4163+
4164+
! note: it can only be 1 or 2 (which was checked in initialize)
4165+
select case (json%path_mode)
4166+
case(1_IK)
4167+
call json%json_get_by_path_default(me, path, p, found)
4168+
case(2_IK)
4169+
call json%json_get_by_path_rfc6901(me, path, p, found)
4170+
end select
4171+
4172+
else
4173+
if (present(found)) found = .false.
4174+
end if
41674175

41684176
end subroutine json_get_by_path
41694177
!*****************************************************************************************
@@ -4200,23 +4208,30 @@ subroutine json_create_by_path(json,me,path,p,found,was_created)
42004208

42014209
if (present(p)) nullify(p)
42024210

4203-
! note: path_mode can only be 1 or 2 (which was checked in initialize)
4204-
select case (json%path_mode)
4205-
case(1_IK)
4206-
call json%json_get_by_path_default(me,path,tmp,found,&
4207-
create_it=.true.,&
4208-
was_created=was_created)
4209-
if (present(p)) p => tmp
4210-
case(2_IK)
4211-
! the problem here is there isn't really a way to disambiguate
4212-
! the array elements, so '/a/0' could be 'a(1)' or 'a.0'.
4213-
call json%throw_exception('Create by path not supported in RFC 6901 path mode.')
4214-
if (present(found)) then
4215-
call json%clear_exceptions()
4216-
found = .false.
4217-
end if
4211+
if (.not. json%exception_thrown) then
4212+
4213+
! note: path_mode can only be 1 or 2 (which was checked in initialize)
4214+
select case (json%path_mode)
4215+
case(1_IK)
4216+
call json%json_get_by_path_default(me,path,tmp,found,&
4217+
create_it=.true.,&
4218+
was_created=was_created)
4219+
if (present(p)) p => tmp
4220+
case(2_IK)
4221+
! the problem here is there isn't really a way to disambiguate
4222+
! the array elements, so '/a/0' could be 'a(1)' or 'a.0'.
4223+
call json%throw_exception('Create by path not supported in RFC 6901 path mode.')
4224+
if (present(found)) then
4225+
call json%clear_exceptions()
4226+
found = .false.
4227+
end if
4228+
if (present(was_created)) was_created = .false.
4229+
end select
4230+
4231+
else
42184232
if (present(was_created)) was_created = .false.
4219-
end select
4233+
if (present(found)) found = .false.
4234+
end if
42204235

42214236
end subroutine json_create_by_path
42224237
!*****************************************************************************************

src/tests/jf_test_1.f90

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -133,6 +133,15 @@ subroutine test_1(error_cnt)
133133
write(error_unit,'(A)') 'files(1) = '//trim(cval)
134134
end if
135135

136+
write(error_unit,'(A)') ''
137+
call json%get('@(1)(1)', cval) ! this is version.major = 2
138+
if (json%failed()) then
139+
call json%print_error_message(error_unit)
140+
error_cnt = error_cnt + 1
141+
else
142+
write(error_unit,'(A)') '@(1)(1) = '//trim(cval)
143+
end if
144+
136145
write(error_unit,'(A)') ''
137146
call json%get('files(2)', cval)
138147
if (json%failed()) then

0 commit comments

Comments
 (0)