Merge pull request #162 from jacobwilliams/clone

Clone

Author: jacobwilliams

src/json_module.F90

@@ -1004,11 +1004,12 @@ recursive subroutine json_value_clone_func(from,to,parent,previous,next,children
         allocate(to)
 
         !copy over the data variables:
-        
-        if (allocated(from%name))      allocate(to%name,     source=from%name)
+        ! [note: the allocate() statements don't work here for the 
+        !  deferred-length characters in gfortran-4.9]
+        if (allocated(from%name))      to%name = from%name
         if (allocated(from%dbl_value)) allocate(to%dbl_value,source=from%dbl_value)
         if (allocated(from%log_value)) allocate(to%log_value,source=from%log_value)
-        if (allocated(from%str_value)) allocate(to%str_value,source=from%str_value)
+        if (allocated(from%str_value)) to%str_value = from%str_value
         if (allocated(from%int_value)) allocate(to%int_value,source=from%int_value)
         to%var_type   = from%var_type
         to%n_children = from%n_children

src/tests/jf_test_2.f90

@@ -28,7 +28,7 @@ subroutine test_2(error_cnt)
     type(json_value),pointer :: p, inp, traj, p_tmp, p_integer_array, p_clone
 
     integer :: iunit
-    character(len=:),allocatable :: name
+    character(kind=CK,len=:),allocatable :: name
     integer :: ival,ival_clone
     logical :: found
 
@@ -152,6 +152,18 @@ subroutine test_2(error_cnt)
 
     write(error_unit,'(A)') 'json_clone test'
     call json_clone(p,p_clone)
+    
+    write(error_unit,'(A)') ''
+    write(error_unit,'(A)') '============='
+    write(error_unit,'(A)') ' p_clone'
+    write(error_unit,'(A)') '============='
+    call json_print(p_clone,error_unit)
+    write(error_unit,'(A)') '============='
+    write(error_unit,'(A)') ''
+    
+    if (.not. associated(p)) write(error_unit,'(A)') 'ERROR: p has become unassociated'
+    if (.not. associated(p_clone)) write(error_unit,'(A)') 'ERROR: p_clone is not associated'
+    
     if (json_failed()) then
         call json_print_error_message(error_unit)
         error_cnt = error_cnt + 1