updated alloc string api for default args

jacobwilliams · jacobwilliams · commit 91ff2b5dfac2 · 2020-06-21T10:47:09.000-05:00
diff --git a/src/json_file_module.F90 b/src/json_file_module.F90
@@ -1876,7 +1876,7 @@ end subroutine wrap_json_file_get_string_vec
 !  Get an (allocatable length) string vector from a JSON file.
 !  This is just a wrapper for [[json_get_alloc_string_vec_by_path]].
 
-    subroutine json_file_get_alloc_string_vec(me, path, vec, ilen, found)
+    subroutine json_file_get_alloc_string_vec(me, path, vec, ilen, found, default, default_ilen)
 
     implicit none
 
@@ -1887,8 +1887,11 @@ subroutine json_file_get_alloc_string_vec(me, path, vec, ilen, found)
                                                              !! of each character
                                                              !! string in the array
     logical(LK),intent(out),optional :: found
+    character(kind=CK,len=*),dimension(:),intent(in),optional :: default
+    integer(IK),dimension(:),intent(in),optional :: default_ilen !! the actual
+                                                                 !! length of `default`
 
-    call me%core%get(me%p, path, vec, ilen, found)
+    call me%core%get(me%p, path, vec, ilen, found, default, default_ilen)
 
     end subroutine json_file_get_alloc_string_vec
 !*****************************************************************************************
@@ -1898,7 +1901,7 @@ end subroutine json_file_get_alloc_string_vec
 !  Alternate version of [[json_file_get_alloc_string_vec]], where "path" is kind=CDK.
 !  This is just a wrapper for [[wrap_json_get_alloc_string_vec_by_path]].
 
-    subroutine wrap_json_file_get_alloc_string_vec(me, path, vec, ilen, found)
+    subroutine wrap_json_file_get_alloc_string_vec(me, path, vec, ilen, found, default, default_ilen)
 
     implicit none
 
@@ -1909,8 +1912,11 @@ subroutine wrap_json_file_get_alloc_string_vec(me, path, vec, ilen, found)
                                                              !! of each character
                                                              !! string in the array
     logical(LK),intent(out),optional :: found
+    character(kind=CK,len=*),dimension(:),intent(in),optional :: default
+    integer(IK),dimension(:),intent(in),optional :: default_ilen !! the actual
+                                                                 !! length of `default`
 
-    call me%get(to_unicode(path), vec, ilen, found)
+    call me%get(to_unicode(path), vec, ilen, found, default, default_ilen)
 
     end subroutine wrap_json_file_get_alloc_string_vec
 !*****************************************************************************************
diff --git a/src/json_get_vec_by_path_alloc.inc b/src/json_get_vec_by_path_alloc.inc
@@ -0,0 +1,43 @@
+    type(json_value),pointer :: p
+
+    if ( json%exception_thrown ) then
+        if (present(default)) then
+            vec = default
+            if (present(default_ilen)) then
+                ilen = default_ilen
+            else
+                allocate(ilen(size(default)))
+                ilen = len(default)
+            end if
+        end if
+        call flag_not_found(found)
+        return
+    end if
+
+    nullify(p)
+    call json%get(me=me, path=path, p=p)
+
+    if (.not. associated(p)) then
+        call json%throw_exception('Error in '//routine//':'//&
+                                  ' Unable to resolve path: '// trim(path),found)
+    else
+        call json%get(p,vec,ilen)
+    end if
+
+    if ( json%exception_thrown ) then
+        if ( present(found) .or. present(default)) then
+            call flag_not_found(found)
+            if (present(default)) then
+                vec = default
+                if (present(default_ilen)) then
+                    ilen = default_ilen
+                else
+                    allocate(ilen(size(default)))
+                    ilen = len(default)
+                end if
+            end if
+            call json%clear_exceptions()
+        end if
+    else
+        if ( present(found) ) found = .true.
+    end if
diff --git a/src/json_value_module.F90 b/src/json_value_module.F90
@@ -9353,8 +9353,12 @@ end subroutine json_get_alloc_string_vec
 !@note An alternative to using this routine is to use [[json_get_array]] with
 !      a callback function that gets the string from each element and populates
 !      a user-defined string type.
+!
+!@note If the `default` argument is used, and `default_ilen` is not present,
+!      then `ilen` will just be returned as the length of the `default` dummy
+!      argument (all elements with the same length).
 
-    subroutine json_get_alloc_string_vec_by_path(json, me, path, vec, ilen, found)
+    subroutine json_get_alloc_string_vec_by_path(json,me,path,vec,ilen,found,default,default_ilen)
 
     implicit none
 
@@ -9366,23 +9370,13 @@ subroutine json_get_alloc_string_vec_by_path(json, me, path, vec, ilen, found)
                                                              !! of each character
                                                              !! string in the array
     logical(LK),intent(out),optional :: found
+    character(kind=CK,len=*),dimension(:),intent(in),optional :: default
+    integer(IK),dimension(:),intent(in),optional :: default_ilen !! the actual
+                                                                 !! length of `default`
 
-    type(json_value),pointer :: p
-
-    call json%get(me, path, p, found)
+    character(kind=CK,len=*),parameter :: routine = CK_'json_get_alloc_string_vec_by_path'
 
-    if (present(found)) then
-        if (.not. found) return
-    else
-        if (json%exception_thrown) return
-    end if
-
-    call json%get(p, vec, ilen)
-
-    if (present(found) .and. json%exception_thrown) then
-        call json%clear_exceptions()
-        found = .false.
-    end if
+#include "json_get_vec_by_path_alloc.inc"
 
     end subroutine json_get_alloc_string_vec_by_path
 !*****************************************************************************************
@@ -9391,7 +9385,7 @@ end subroutine json_get_alloc_string_vec_by_path
 !>
 !  Alternate version of [[json_get_alloc_string_vec_by_path]], where "path" is kind=CDK
 
-    subroutine wrap_json_get_alloc_string_vec_by_path(json,me,path,vec,ilen,found)
+    subroutine wrap_json_get_alloc_string_vec_by_path(json,me,path,vec,ilen,found,default,default_ilen)
 
     implicit none
 
@@ -9403,8 +9397,11 @@ subroutine wrap_json_get_alloc_string_vec_by_path(json,me,path,vec,ilen,found)
                                                              !! of each character
                                                              !! string in the array
     logical(LK),intent(out),optional :: found
+    character(kind=CK,len=*),dimension(:),intent(in),optional :: default
+    integer(IK),dimension(:),intent(in),optional :: default_ilen !! the actual
+                                                                 !! length of `default`
 
-    call json%get(me,to_unicode(path),vec,ilen,found)
+    call json%get(me,to_unicode(path),vec,ilen,found,default,default_ilen)
 
     end subroutine wrap_json_get_alloc_string_vec_by_path
 !*****************************************************************************************
diff --git a/src/tests/jf_test_46.F90 b/src/tests/jf_test_46.F90
@@ -34,8 +34,11 @@ subroutine test_46(error_cnt)
     logical(LK) :: lval
     character(kind=CK,len=:),allocatable :: cval
     character(kind=CK,len=1),dimension(:),allocatable :: cvec
+    character(kind=CK,len=:),dimension(:),allocatable :: cvec2
+    integer(IK),dimension(:),allocatable :: ilen
 
     character(kind=CK,len=1),dimension(1) :: cvec_default = [CK_'1']
+    integer(IK),dimension(1) :: ilen_default = [1]
 
     write(error_unit,'(A)') ''
     write(error_unit,'(A)') '================================='
@@ -89,6 +92,16 @@ subroutine test_46(error_cnt)
         write(error_unit,'(A)') 'Error using json_get_string_vec_by_path default'
         error_cnt = error_cnt + 1
     end if
+    call json%get(p, CK_'not_there', cvec2, ilen, found, default=cvec_default)
+    if (json%failed() .or. found .or. all(cvec2 /= cvec_default) .or. all(ilen/=1_IK)) then
+        write(error_unit,'(A)') 'Error using json_get_alloc_string_vec_by_path default'
+        error_cnt = error_cnt + 1
+    end if
+    call json%get(p, CK_'not_there', cvec2, ilen, found, default=cvec_default, default_ilen=ilen_default)
+    if (json%failed() .or. found .or. all(cvec2 /= cvec_default) .or. all(ilen/=1_IK)) then
+        write(error_unit,'(A)') 'Error using json_get_alloc_string_vec_by_path default'
+        error_cnt = error_cnt + 1
+    end if
 
     ! default:
     call json%get(p, 'not_there', ival, found, default=99_IK)
@@ -120,6 +133,16 @@ subroutine test_46(error_cnt)
         write(error_unit,'(A)') 'Error using json_get_string_vec_by_path default'
         error_cnt = error_cnt + 1
     end if
+    call json%get(p, 'not_there', cvec2, ilen, found, default=cvec_default)
+    if (json%failed() .or. found .or. all(cvec2 /= cvec_default) .or. all(ilen/=1_IK)) then
+        write(error_unit,'(A)') 'Error using json_get_alloc_string_vec_by_path default'
+        error_cnt = error_cnt + 1
+    end if
+    call json%get(p, 'not_there', cvec2, ilen, found, default=cvec_default, default_ilen=ilen_default)
+    if (json%failed() .or. found .or. all(cvec2 /= cvec_default) .or. all(ilen/=1_IK)) then
+        write(error_unit,'(A)') 'Error using json_get_alloc_string_vec_by_path default'
+        error_cnt = error_cnt + 1
+    end if
 
     call json%destroy(p)
 
@@ -159,6 +182,16 @@ subroutine test_46(error_cnt)
         write(error_unit,'(A)') 'Error using json_get_string_vec_by_path default'
         error_cnt = error_cnt + 1
     end if
+    call json_f%get(CK_'not_there', cvec2, ilen, found, default=cvec_default)
+    if (json%failed() .or. found .or. all(cvec2 /= cvec_default) .or. all(ilen/=1_IK)) then
+        write(error_unit,'(A)') 'Error using json_get_alloc_string_vec_by_path default'
+        error_cnt = error_cnt + 1
+    end if
+    call json_f%get(CK_'not_there', cvec2, ilen, found, default=cvec_default, default_ilen=ilen_default)
+    if (json%failed() .or. found .or. all(cvec2 /= cvec_default) .or. all(ilen/=1_IK)) then
+        write(error_unit,'(A)') 'Error using json_get_alloc_string_vec_by_path default'
+        error_cnt = error_cnt + 1
+    end if
 
     ! default:
     call json_f%get('not_there', ival, found, default=99_IK)
@@ -190,6 +223,16 @@ subroutine test_46(error_cnt)
         write(error_unit,'(A)') 'Error using json_get_string_vec_by_path default'
         error_cnt = error_cnt + 1
     end if
+    call json_f%get('not_there', cvec2, ilen, found, default=cvec_default)
+    if (json%failed() .or. found .or. all(cvec2 /= cvec_default) .or. all(ilen/=1_IK)) then
+        write(error_unit,'(A)') 'Error using json_get_alloc_string_vec_by_path default'
+        error_cnt = error_cnt + 1
+    end if
+    call json_f%get('not_there', cvec2, ilen, found, default=cvec_default, default_ilen=ilen_default)
+    if (json%failed() .or. found .or. all(cvec2 /= cvec_default) .or. all(ilen/=1_IK)) then
+        write(error_unit,'(A)') 'Error using json_get_alloc_string_vec_by_path default'
+        error_cnt = error_cnt + 1
+    end if
 
     if (error_cnt==0) then
         write(error_unit,'(A)') 'Success!'
