Skip to content

Added a character=json_file assignment operator. #411

New issue

Have a question about this project? # for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “#”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? # to your account

Merged
merged 1 commit into from
Jul 10, 2019
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
45 changes: 43 additions & 2 deletions src/json_file_module.F90
Original file line number Diff line number Diff line change
Expand Up @@ -244,8 +244,10 @@ module json_file_module
generic,public :: operator(.in.) => MAYBEWRAP(json_file_valid_path_op)
procedure,pass(me) :: MAYBEWRAP(json_file_valid_path_op)

generic,public :: assignment(=) => assign_json_file
generic,public :: assignment(=) => assign_json_file,&
assign_json_file_to_string
procedure :: assign_json_file
procedure,pass(me) :: assign_json_file_to_string

! ***************************************************
! private routines
Expand Down Expand Up @@ -1126,7 +1128,7 @@ end subroutine json_file_get_root
!*****************************************************************************************
!> author: Jacob Williams
!
! Assignment operator for [[json_core(type)]].
! Assignment operator for [[json_core(type)]] = [[json_core(type)]].
! This will duplicate the [[json_core(type)]] and also
! perform a deep copy of the [[json_value(type)]] data structure.

Expand All @@ -1143,6 +1145,45 @@ subroutine assign_json_file(me,f)
end subroutine assign_json_file
!*****************************************************************************************

!*****************************************************************************************
!> author: Jacob Williams
!
! Assignment operator for character = [[json_core(type)]].
! This is just a wrapper for the [[json_value_to_string]] routine.
!
!### Note
! * If an exception is raised or the file contains no data,
! this will return an empty string.

subroutine assign_json_file_to_string(str,me)

implicit none

character(kind=CK,len=:),allocatable,intent(out) :: str
class(json_file),intent(in) :: me

type(json_core) :: core_copy !! a copy of `core` from `me`

if (me%core%failed() .or. .not. associated(me%p)) then
str = ''
else

! This is sort of a hack. Since `me` has to have `intent(in)`
! for the assignment to work, we need to make a copy of `me%core`
! so we can call the low level routine (since it needs it to
! be `intent(inout)`) because it's possible for this
! function to raise an exception.

core_copy = me%core ! copy the parser settings

call core_copy%serialize(me%p,str)
if (me%core%failed()) str = ''

end if

end subroutine assign_json_file_to_string
!*****************************************************************************************

!*****************************************************************************************
!> author: Jacob Williams
!
Expand Down
42 changes: 40 additions & 2 deletions src/tests/jf_test_41.F90
Original file line number Diff line number Diff line change
Expand Up @@ -24,10 +24,11 @@ subroutine test_41(error_cnt)

type(json_value),pointer :: p, p2
type(json_core) :: json
type(json_file) :: f, f2
type(json_file) :: f, f2, f3, f4
character(kind=CK,len=:),allocatable :: str

character(kind=CK,len=*),parameter :: json_str = &
'{"str_array": ["1","22","333","55555"]}'
'{"str_array": ["1","22","333"]}'

error_cnt = 0

Expand All @@ -37,6 +38,8 @@ subroutine test_41(error_cnt)
write(error_unit,'(A)') '================================='
write(error_unit,'(A)') ''

call json%initialize(no_whitespace=.true.)

write(error_unit,'(A)') 'parsing...'
call json%deserialize(p,json_str)
call json%deserialize(p2,json_str)
Expand All @@ -50,6 +53,7 @@ subroutine test_41(error_cnt)
write(error_unit,'(A)') 'printing...'
call json%print(p,int(output_unit,IK))

write(error_unit,'(A)') ''
write(error_unit,'(A)') ''
write(error_unit,'(A)') 'copying to json_file...'

Expand All @@ -64,10 +68,44 @@ subroutine test_41(error_cnt)
else
write(error_unit,'(A)') ''
write(error_unit,'(A)') 'printing...'
call f%initialize(no_whitespace=.true.)
call f%print() ! print to console
if (f%failed()) then
call f%print_error_message(error_unit)
error_cnt = error_cnt + 1
else

write(error_unit,'(A)') ''
write(error_unit,'(A)') ''
write(error_unit,'(A)') 'make two deep copies and print...'

f3 = f
f4 = f

call f%print()
call f3%print()
call f4%print()

write(error_unit,'(A)') ''
write(error_unit,'(A)') ''
write(error_unit,'(A)') 'string assignment...'

str = f3
write(error_unit,'(A)') str

if (f%failed()) then
call f%print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
if (f3%failed()) then
call f3%print_error_message(error_unit)
error_cnt = error_cnt + 1
end if
if (f4%failed()) then
call f4%print_error_message(error_unit)
error_cnt = error_cnt + 1
end if

end if
end if

Expand Down