Merge pull request #411 from jacobwilliams/410-character-json-file-assignment

Added a character=json_file assignment operator.

Author: jacobwilliams

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
 !

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