diff --git a/src/json_file_module.F90 b/src/json_file_module.F90 index f288afacb2..0eb1b8292f 100644 --- a/src/json_file_module.F90 +++ b/src/json_file_module.F90 @@ -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 @@ -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. @@ -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 ! diff --git a/src/tests/jf_test_41.F90 b/src/tests/jf_test_41.F90 index d3fb6665d5..8fde9975bd 100644 --- a/src/tests/jf_test_41.F90 +++ b/src/tests/jf_test_41.F90 @@ -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 @@ -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) @@ -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...' @@ -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