From 901a11a6560f6f52f4fe06bb74189c6e984c5d20 Mon Sep 17 00:00:00 2001 From: Jacob Williams Date: Sun, 5 Feb 2017 14:44:34 -0600 Subject: [PATCH 1/9] added alternate get_string routine that returns allocatable strings (length is the max length of any string in the array). some other minor refactoring. --- src/json_file_module.F90 | 48 ++++ src/json_value_module.F90 | 460 +++++++++++++++++++++++++++++--------- src/tests/jf_test_20.f90 | 2 +- 3 files changed, 401 insertions(+), 109 deletions(-) diff --git a/src/json_file_module.F90 b/src/json_file_module.F90 index 3878a84338..47b241bfff 100644 --- a/src/json_file_module.F90 +++ b/src/json_file_module.F90 @@ -101,6 +101,7 @@ module json_file_module MAYBEWRAP(json_file_get_double_vec), & MAYBEWRAP(json_file_get_logical_vec), & MAYBEWRAP(json_file_get_string_vec), & + MAYBEWRAP(json_file_get_alloc_string_vec), & json_file_get_root generic,public :: update => MAYBEWRAP(json_file_update_integer), & @@ -140,6 +141,7 @@ module json_file_module procedure :: MAYBEWRAP(json_file_get_double_vec) procedure :: MAYBEWRAP(json_file_get_logical_vec) procedure :: MAYBEWRAP(json_file_get_string_vec) + procedure :: MAYBEWRAP(json_file_get_alloc_string_vec) procedure :: json_file_get_root !update: @@ -1116,6 +1118,52 @@ subroutine wrap_json_file_get_string_vec(me, path, vec, found) end subroutine wrap_json_file_get_string_vec !***************************************************************************************** +!***************************************************************************************** +!> author: Jacob Williams +! date: 12/17/2016 +! +! Get an (allocatable length) string vector from a JSON file. +! This is just a wrapper for [[json_get_alloc_string_vec_with_path]]. + + subroutine json_file_get_alloc_string_vec(me, path, vec, ilen, found) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CK,len=*),intent(in) :: path + character(kind=CK,len=:),dimension(:),allocatable,intent(out) :: vec + integer(IK),dimension(:),allocatable,intent(out) :: ilen !! the actual length + !! of each character + !! string in the array + logical(LK),intent(out),optional :: found + + call me%core%get(me%p, path, vec, ilen, found) + + 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_with_path]]. + + subroutine wrap_json_file_get_alloc_string_vec(me, path, vec, ilen, found) + + implicit none + + class(json_file),intent(inout) :: me + character(kind=CDK,len=*),intent(in) :: path + character(kind=CK,len=:),dimension(:),allocatable,intent(out) :: vec + integer(IK),dimension(:),allocatable,intent(out) :: ilen !! the actual length + !! of each character + !! string in the array + logical(LK),intent(out),optional :: found + + call me%get(to_unicode(path), vec, ilen, found) + + end subroutine wrap_json_file_get_alloc_string_vec +!***************************************************************************************** + !***************************************************************************************** !> author: Jacob Williams ! date:1/10/2015 diff --git a/src/json_value_module.F90 b/src/json_value_module.F90 index d1d88bbd73..739ed45ee9 100644 --- a/src/json_value_module.F90 +++ b/src/json_value_module.F90 @@ -295,16 +295,17 @@ module json_value_module ! path. The path version is split up into unicode and non-unicode versions. generic,public :: get => & - MAYBEWRAP(json_get_by_path), & - json_get_integer, MAYBEWRAP(json_get_integer_with_path), & - json_get_integer_vec, MAYBEWRAP(json_get_integer_vec_with_path), & - json_get_double, MAYBEWRAP(json_get_double_with_path), & - json_get_double_vec, MAYBEWRAP(json_get_double_vec_with_path), & - json_get_logical, MAYBEWRAP(json_get_logical_with_path), & - json_get_logical_vec, MAYBEWRAP(json_get_logical_vec_with_path), & - json_get_string, MAYBEWRAP(json_get_string_with_path), & - json_get_string_vec, MAYBEWRAP(json_get_string_vec_with_path), & - json_get_array, MAYBEWRAP(json_get_array_with_path) + MAYBEWRAP(json_get_by_path), & + json_get_integer, MAYBEWRAP(json_get_integer_with_path), & + json_get_integer_vec, MAYBEWRAP(json_get_integer_vec_with_path), & + json_get_double, MAYBEWRAP(json_get_double_with_path), & + json_get_double_vec, MAYBEWRAP(json_get_double_vec_with_path), & + json_get_logical, MAYBEWRAP(json_get_logical_with_path), & + json_get_logical_vec, MAYBEWRAP(json_get_logical_vec_with_path), & + json_get_string, MAYBEWRAP(json_get_string_with_path), & + json_get_string_vec, MAYBEWRAP(json_get_string_vec_with_path), & + json_get_alloc_string_vec,MAYBEWRAP(json_get_alloc_string_vec_with_path),& + json_get_array, MAYBEWRAP(json_get_array_with_path) procedure,private :: json_get_integer procedure,private :: json_get_integer_vec procedure,private :: json_get_double @@ -313,6 +314,7 @@ module json_value_module procedure,private :: json_get_logical_vec procedure,private :: json_get_string procedure,private :: json_get_string_vec + procedure,private :: json_get_alloc_string_vec procedure,private :: json_get_array procedure,private :: MAYBEWRAP(json_get_by_path) procedure,private :: MAYBEWRAP(json_get_integer_with_path) @@ -324,6 +326,7 @@ module json_value_module procedure,private :: MAYBEWRAP(json_get_string_with_path) procedure,private :: MAYBEWRAP(json_get_string_vec_with_path) procedure,private :: MAYBEWRAP(json_get_array_with_path) + procedure,private :: MAYBEWRAP(json_get_alloc_string_vec_with_path) procedure,private :: json_get_by_path_default procedure,private :: json_get_by_path_rfc6901 @@ -514,6 +517,11 @@ module json_value_module procedure :: json_info procedure :: MAYBEWRAP(json_info_by_path) + !> + ! get string info about a [[json_value]] + generic,public :: string_info => json_string_info + procedure :: json_string_info + !> ! get matrix info about a [[json_value]] generic,public :: matrix_info => json_matrix_info, MAYBEWRAP(json_matrix_info_by_path) @@ -1017,6 +1025,162 @@ subroutine json_info(json,p,var_type,n_children,name) end subroutine json_info !***************************************************************************************** +!***************************************************************************************** +!> author: Jacob Williams +! date: 12/18/2016 +! +! Returns information about characters strings returned from a [[json_value]]. + + subroutine json_string_info(json,p,ilen,max_str_len,found) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer :: p + integer(IK),dimension(:),allocatable,intent(out),optional :: ilen !! if `p` is an array, this + !! is the actual length + !! of each character + !! string in the array. + !! if not an array, this + !! is returned unallocated. + integer(IK),intent(out),optional :: max_str_len !! The maximum length required to + !! hold the string representation returned + !! by a call to a `get` routine. If a scalar, + !! this is just the length of the scalar. If + !! a vector, this is the maximum length of + !! any element. + logical(LK),intent(out),optional :: found !! true if there were no errors. + !! if not present, an error will + !! throw an exception + + character(kind=CK,len=:),allocatable :: cval !! for getting values as strings. + logical(LK) :: initialized !! if the output array has been sized + logical(LK) :: get_max_len !! if we are returning the `max_str_len` + logical(LK) :: get_ilen !! if we are returning the `ilen` array + logical(LK) :: is_array !! if the variable is an array + integer(IK) :: var_type !! variable type + + get_max_len = present(max_str_len) + get_ilen = present(ilen) + + if (.not. json%exception_thrown) then + + found = .true. + initialized = .false. + + if (get_max_len) max_str_len = 0 + + select case (p%var_type) + + case (json_array) ! it's an array + + ! call routine for each element + call json%get(p, array_callback=get_string_lengths) + + case default ! not an array + + if (json%strict_type_checking) then + ! only allowing strings to be returned + ! as strings, so we can check size directly + call json%info(p,var_type=var_type) + if (var_type==json_string) then + if (allocated(p%str_value) .and. get_max_len) & + max_str_len = len(p%str_value) + else + ! it isn't a string, so there is no length + call json%throw_exception('Error in json_string_info: '//& + 'When strict_type_checking is true '//& + 'the variable must be a character string.') + end if + else + ! in this case, we have to get the value + ! as a string to know what size it is. + call json%get(p, value=cval) + if (.not. json%exception_thrown) then + if (allocated(cval) .and. get_max_len) & + max_str_len = len(cval) + end if + end if + + end select + + end if + + if (json%exception_thrown) then + if (present(found)) then + call json%clear_exceptions() + found = .false. + end if + if (get_max_len) max_str_len = 0 + if (get_ilen) then + if (allocated(ilen)) deallocate(ilen) + end if + end if + + contains + + subroutine get_string_lengths(json, element, i, count) + + !! callback function to call for each element in the array. + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: element + integer(IK),intent(in) :: i !! index + integer(IK),intent(in) :: count !! size of array + + character(kind=CK,len=:),allocatable :: cval + integer(IK) :: var_type + + if (json%exception_thrown) return + + if (.not. initialized) then + if (get_ilen) allocate(ilen(count)) + initialized = .true. + end if + + if (json%strict_type_checking) then + ! only allowing strings to be returned + ! as strings, so we can check size directly + call json%info(element,var_type=var_type) + if (var_type==json_string) then + if (allocated(element%str_value)) then + if (get_max_len) then + if (len(element%str_value)>max_str_len) & + max_str_len = len(element%str_value) + end if + if (get_ilen) ilen(i) = len(element%str_value) + else + if (get_ilen) ilen(i) = 0 + end if + else + ! it isn't a string, so there is no length + call json%throw_exception('Error in json_string_info: '//& + 'When strict_type_checking is true '//& + 'the array must contain only '//& + 'character strings.') + end if + else + ! in this case, we have to get the value + ! as a string to know what size it is. + call json%get(element, value=cval) + if (json%exception_thrown) return + if (allocated(cval)) then + if (get_max_len) then + if (len(cval)>max_str_len) max_str_len = len(cval) + end if + if (get_ilen) ilen(i) = len(cval) + else + if (get_ilen) ilen(i) = 0 + end if + end if + + end subroutine get_string_lengths + + end subroutine json_string_info +!***************************************************************************************** + !***************************************************************************************** ! ! Returns information about a [[json_value]], given the path. @@ -4752,41 +4916,27 @@ subroutine json_get_integer_vec_with_path(json, me, path, vec, found) implicit none class(json_core),intent(inout) :: json - type(json_value),pointer :: me + type(json_value),pointer,intent(in) :: me character(kind=CK,len=*),intent(in) :: path integer(IK),dimension(:),allocatable,intent(out) :: vec logical(LK),intent(out),optional :: found - logical(LK) :: initialized - - initialized = .false. - - call json%get(me, path=path, array_callback=get_int_from_array, found=found) - - ! need to duplicate callback function, no other way - contains - - subroutine get_int_from_array(json, element, i, count) - - !! callback function for integer - - implicit none + type(json_value),pointer :: p - class(json_core),intent(inout) :: json - type(json_value),pointer,intent(in) :: element - integer(IK),intent(in) :: i !! index - integer(IK),intent(in) :: count !! size of array + call json%get(me, path, p, found) - !size the output array: - if (.not. initialized) then - allocate(vec(count)) - initialized = .true. - end if + if (present(found)) then + if (.not. found) return + else + if (json%exception_thrown) return + end if - !populate the elements: - call json%get(element, value=vec(i)) + call json%get(p, vec) - end subroutine get_int_from_array + if (present(found) .and. json%exception_thrown) then + call json%clear_exceptions() + found = .false. + end if end subroutine json_get_integer_vec_with_path !***************************************************************************************** @@ -4978,40 +5128,27 @@ subroutine json_get_double_vec_with_path(json, me, path, vec, found) implicit none class(json_core),intent(inout) :: json - type(json_value),pointer :: me + type(json_value),pointer,intent(in) :: me character(kind=CK,len=*),intent(in) :: path real(RK),dimension(:),allocatable,intent(out) :: vec logical(LK),intent(out),optional :: found - logical(LK) :: initialized - - initialized = .false. - - !the callback function is called for each element of the array: - call json%get(me, path=path, array_callback=get_double_from_array, found=found) - - contains - - subroutine get_double_from_array(json, element, i, count) - !! callback function for double - - implicit none + type(json_value),pointer :: p - class(json_core),intent(inout) :: json - type(json_value),pointer,intent(in) :: element - integer(IK),intent(in) :: i !! index - integer(IK),intent(in) :: count !! size of array + call json%get(me, path, p, found) - !size the output array: - if (.not. initialized) then - allocate(vec(count)) - initialized = .true. - end if + if (present(found)) then + if (.not. found) return + else + if (json%exception_thrown) return + end if - !populate the elements: - call json%get(element, value=vec(i)) + call json%get(p, vec) - end subroutine get_double_from_array + if (present(found) .and. json%exception_thrown) then + call json%clear_exceptions() + found = .false. + end if end subroutine json_get_double_vec_with_path !***************************************************************************************** @@ -5204,36 +5341,22 @@ subroutine json_get_logical_vec_with_path(json, me, path, vec, found) logical(LK),dimension(:),allocatable,intent(out) :: vec logical(LK),intent(out),optional :: found - logical(LK) :: initialized - - initialized = .false. - - !the callback function is called for each element of the array: - call json%get(me, path=path, array_callback=get_logical_from_array, found=found) - - contains - - subroutine get_logical_from_array(json, element, i, count) - - !! callback function for logical - - implicit none + type(json_value),pointer :: p - class(json_core),intent(inout) :: json - type(json_value),pointer,intent(in) :: element - integer(IK),intent(in) :: i !! index - integer(IK),intent(in) :: count !! size of array + call json%get(me, path, p, found) - !size the output array: - if (.not. initialized) then - allocate(vec(count)) - initialized = .true. - end if + if (present(found)) then + if (.not. found) return + else + if (json%exception_thrown) return + end if - !populate the elements: - call json%get(element, value=vec(i)) + call json%get(p, vec) - end subroutine get_logical_from_array + if (present(found) .and. json%exception_thrown) then + call json%clear_exceptions() + found = .false. + end if end subroutine json_get_logical_vec_with_path !***************************************************************************************** @@ -5498,12 +5621,79 @@ subroutine json_get_string_vec_with_path(json, me, path, vec, found) character(kind=CK,len=*),dimension(:),allocatable,intent(out) :: vec logical(LK),intent(out),optional :: found - logical(LK) :: initialized + type(json_value),pointer :: p + + call json%get(me, path, p, found) + + if (present(found)) then + if (.not. found) return + else + if (json%exception_thrown) return + end if + + call json%get(p, vec) + + if (present(found) .and. json%exception_thrown) then + call json%clear_exceptions() + found = .false. + end if + + end subroutine json_get_string_vec_with_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_get_string_vec_with_path]], where "path" is kind=CDK + + subroutine wrap_json_get_string_vec_with_path(json, me, path, vec, found) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me + character(kind=CDK,len=*),intent(in) :: path + character(kind=CK,len=*),dimension(:),allocatable,intent(out) :: vec + logical(LK),intent(out),optional :: found + + call json%get(me,to_unicode(path),vec,found) + + end subroutine wrap_json_get_string_vec_with_path +!***************************************************************************************** + +!***************************************************************************************** +!> author: Jacob Williams +! date: 12/16/2016 +! +! Get a string vector from a [[json_value(type)]]. This is an alternate +! version of [[json_get_string_vec]]. This one returns an allocatable +! length character (where the string length is the maximum length of +! any element in the array). It also returns an integer array of the +! actual sizes of the strings in the JSON structure. +! +!@note This is somewhat inefficient since it does +! cycle through the array twice. + + subroutine json_get_alloc_string_vec(json, me, vec, ilen) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me + character(kind=CK,len=:),dimension(:),allocatable,intent(out) :: vec + integer(IK),dimension(:),allocatable,intent(out) :: ilen !! the actual length + !! of each character + !! string in the array + + logical(LK) :: initialized !! if the output array has been sized + integer(IK) :: max_len !! the length of the longest string in the array initialized = .false. - !the callback function is called for each element of the array: - call json%get(me, path=path, array_callback=get_chars_from_array, found=found) + call json%string_info(me,ilen=ilen,max_str_len=max_len) + if (.not. json%exception_thrown) then + ! now get each string using the callback function: + call json%get(me, array_callback=get_chars_from_array) + end if contains @@ -5518,51 +5708,105 @@ subroutine get_chars_from_array(json, element, i, count) integer(IK),intent(in) :: i !! index integer(IK),intent(in) :: count !! size of array - character(kind=CK,len=:),allocatable :: cval + character(kind=CK,len=:),allocatable :: cval !! for getting string !size the output array: if (.not. initialized) then - allocate(vec(count)) + ! string length long enough to hold the longest one + allocate( character(kind=CK,len=max_len) :: vec(count) ) + allocate( ilen(count) ) initialized = .true. end if !populate the elements: call json%get(element, value=cval) if (allocated(cval)) then - vec(i) = cval + vec(i) = cval + ilen(i) = len(cval) ! return the actual length deallocate(cval) else - vec(i) = '' + vec(i) = '' + ilen(i) = 0 end if end subroutine get_chars_from_array - end subroutine json_get_string_vec_with_path + end subroutine json_get_alloc_string_vec !***************************************************************************************** !***************************************************************************************** !> -! Alternate version of [[json_get_string_vec_with_path]], where "path" is kind=CDK +! Alternate version of [[json_get_alloc_string_vec]] where input is the path. +! +! This is an alternate version of [[json_get_string_vec_with_path]]. +! This one returns an allocatable length character (where the string +! length is the maximum length of any element in the array). It also +! returns an integer array of the actual sizes of the strings in the +! JSON structure. +! +!@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. - subroutine wrap_json_get_string_vec_with_path(json, me, path, vec, found) + subroutine json_get_alloc_string_vec_with_path(json, me, path, vec, ilen, found) implicit none - class(json_core),intent(inout) :: json - type(json_value),pointer,intent(in) :: me - character(kind=CDK,len=*),intent(in) :: path - character(kind=CK,len=*),dimension(:),allocatable,intent(out) :: vec - logical(LK),intent(out),optional :: found + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me + character(kind=CK,len=*),intent(in) :: path + character(kind=CK,len=:),dimension(:),allocatable,intent(out) :: vec + integer(IK),dimension(:),allocatable,intent(out) :: ilen !! the actual length + !! of each character + !! string in the array + logical(LK),intent(out),optional :: found - call json%get(me,to_unicode(path),vec,found) + type(json_value),pointer :: p - end subroutine wrap_json_get_string_vec_with_path + call json%get(me, path, p, found) + + 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 + + end subroutine json_get_alloc_string_vec_with_path +!***************************************************************************************** + +!***************************************************************************************** +!> +! Alternate version of [[json_get_alloc_string_vec_with_path]], where "path" is kind=CDK + + subroutine wrap_json_get_alloc_string_vec_with_path(json,me,path,vec,ilen,found) + + implicit none + + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me + character(kind=CDK,len=*),intent(in) :: path + character(kind=CK,len=:),dimension(:),allocatable,intent(out) :: vec + integer(IK),dimension(:),allocatable,intent(out) :: ilen !! the actual length + !! of each character + !! string in the array + logical(LK),intent(out),optional :: found + + call json%get(me,to_unicode(path),vec,ilen,found) + + end subroutine wrap_json_get_alloc_string_vec_with_path !***************************************************************************************** !***************************************************************************************** !> -! This routine calls the user-supplied [[json_array_callback_func]] subroutine -! for each element in the array. +! This routine calls the user-supplied [[json_array_callback_func]] +! subroutine for each element in the array. ! !@note For integer, double, logical, and character arrays, ! higher-level routines are provided (see `get` methods), so diff --git a/src/tests/jf_test_20.f90 b/src/tests/jf_test_20.f90 index d05cad78d3..608fb96e0d 100644 --- a/src/tests/jf_test_20.f90 +++ b/src/tests/jf_test_20.f90 @@ -22,7 +22,7 @@ subroutine test_20(error_cnt) type(json_core) :: json type(json_value),pointer :: p,new,element,elements,root - logical(lk) :: found,is_valid + logical(lk) :: is_valid integer(IK),dimension(:),allocatable :: iarray character(kind=CK,len=:),allocatable :: error_msg From 23755c943f9c8e2888e6098f8ab177018a5127bc Mon Sep 17 00:00:00 2001 From: Jacob Williams Date: Wed, 15 Mar 2017 22:20:13 -0500 Subject: [PATCH 2/9] bug fix and minor changes. added unit tests. --- src/json_value_module.F90 | 17 +++-- src/tests/jf_test_25.F90 | 132 ++++++++++++++++++++++++++++++++++++++ 2 files changed, 140 insertions(+), 9 deletions(-) create mode 100644 src/tests/jf_test_25.F90 diff --git a/src/json_value_module.F90 b/src/json_value_module.F90 index 023060580c..79212c514a 100644 --- a/src/json_value_module.F90 +++ b/src/json_value_module.F90 @@ -1139,7 +1139,7 @@ end subroutine json_info !> author: Jacob Williams ! date: 12/18/2016 ! -! Returns information about characters strings returned from a [[json_value]]. +! Returns information about character strings returned from a [[json_value]]. subroutine json_string_info(json,p,ilen,max_str_len,found) @@ -1167,7 +1167,6 @@ subroutine json_string_info(json,p,ilen,max_str_len,found) logical(LK) :: initialized !! if the output array has been sized logical(LK) :: get_max_len !! if we are returning the `max_str_len` logical(LK) :: get_ilen !! if we are returning the `ilen` array - logical(LK) :: is_array !! if the variable is an array integer(IK) :: var_type !! variable type get_max_len = present(max_str_len) @@ -1175,7 +1174,7 @@ subroutine json_string_info(json,p,ilen,max_str_len,found) if (.not. json%exception_thrown) then - found = .true. + if (present(found)) found = .true. initialized = .false. if (get_max_len) max_str_len = 0 @@ -6433,7 +6432,7 @@ subroutine json_get_logical(json, me, value) class(json_core),intent(inout) :: json type(json_value),pointer,intent(in) :: me - logical(LK) :: value + logical(LK),intent(out) :: value value = .false. if ( json%exception_thrown ) return @@ -6472,7 +6471,7 @@ subroutine json_get_logical_by_path(json, me, path, value, found) class(json_core),intent(inout) :: json type(json_value),pointer,intent(in) :: me character(kind=CK,len=*),intent(in) :: path - logical(LK) :: value + logical(LK),intent(out) :: value logical(LK),intent(out),optional :: found type(json_value),pointer :: p @@ -6522,7 +6521,7 @@ subroutine wrap_json_get_logical_by_path(json, me, path, value, found) class(json_core),intent(inout) :: json type(json_value),pointer,intent(in) :: me character(kind=CDK,len=*),intent(in) :: path - logical(LK) :: value + logical(LK),intent(out) :: value logical(LK),intent(out),optional :: found call json%get(me,to_unicode(path),value,found) @@ -6928,8 +6927,8 @@ subroutine json_get_alloc_string_vec(json, me, vec, ilen) implicit none - class(json_core),intent(inout) :: json - type(json_value),pointer,intent(in) :: me + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: me character(kind=CK,len=:),dimension(:),allocatable,intent(out) :: vec integer(IK),dimension(:),allocatable,intent(out) :: ilen !! the actual length !! of each character @@ -6965,7 +6964,7 @@ subroutine get_chars_from_array(json, element, i, count) if (.not. initialized) then ! string length long enough to hold the longest one allocate( character(kind=CK,len=max_len) :: vec(count) ) - allocate( ilen(count) ) + !allocate( ilen(count) ) initialized = .true. end if diff --git a/src/tests/jf_test_25.F90 b/src/tests/jf_test_25.F90 new file mode 100644 index 0000000000..dceaf4dd71 --- /dev/null +++ b/src/tests/jf_test_25.F90 @@ -0,0 +1,132 @@ +!***************************************************************************************** +!> +! Module for the 25th unit test. + +module jf_test_25_mod + + use json_module, rk => json_rk, lk => json_lk, ik => json_ik, ck => json_ck, cdk => json_cdk + use, intrinsic :: iso_fortran_env , only: error_unit, output_unit + + implicit none + +contains + + subroutine test_25(error_cnt) + + !! Test the allocatable string vector routines. + + implicit none + + integer,intent(out) :: error_cnt + + type(json_value),pointer :: p, tmp + type(json_core) :: json + logical(lk) :: found + character(kind=CK,len=:),dimension(:),allocatable :: vec !! array of strings from JSON + integer(ik),dimension(:),allocatable :: ilen !! array of string lengths + + character(kind=CK,len=*),parameter :: json_str = & + '{"str_array": ["1","22","333","55555"]}' + + error_cnt = 0 + call json%initialize( verbose=.false. ) + if (json%failed()) then + call json%print_error_message(error_unit) + error_cnt = error_cnt + 1 + end if + + write(error_unit,'(A)') '' + write(error_unit,'(A)') '=================================' + write(error_unit,'(A)') ' TEST 25' + write(error_unit,'(A)') '=================================' + write(error_unit,'(A)') '' + + write(error_unit,'(A)') '' + write(error_unit,'(A)') 'parsing...' + call json%parse(p,json_str) + if (json%failed()) then + call json%print_error_message(error_unit) + error_cnt = error_cnt + 1 + end if + + write(error_unit,'(A)') '' + write(error_unit,'(A)') 'printing...' + call json%print(p,output_unit) + + write(error_unit,'(A)') '' + write(error_unit,'(A)') 'getting data...' + + ! get child, then array: + call json%get_child(p,'str_array',tmp) + if (json%failed()) then + call json%print_error_message(error_unit) + error_cnt = error_cnt + 1 + end if + call json%get(tmp, vec, ilen) + if (json%failed()) then + call json%print_error_message(error_unit) + error_cnt = error_cnt + 1 + end if + if (allocated(vec) .and. allocated(ilen)) then + if (all(ilen==[1,2,3,5])) then + write(error_unit,'(A)') 'success!' + else + write(error_unit,'(A,1X,*(I5,1X))') 'failed: ', ilen + error_cnt = error_cnt + 1 + end if + else + write(error_unit,'(A)') 'failed: vectors not allocated.' + error_cnt = error_cnt + 1 + end if + + ! try get by path: + call json%get(p, 'str_array', vec, ilen, found) + if (json%failed()) then + call json%print_error_message(error_unit) + error_cnt = error_cnt + 1 + end if + if (all(ilen==[1,2,3,5])) then + write(error_unit,'(A)') 'success!' + else + write(error_unit,'(A,1X,*(I5,1X))') 'failed: ', ilen + error_cnt = error_cnt + 1 + end if + +#ifdef USE_UCS4 + ! also try unicode versions: + call json%get(p, CDK_'str_array', vec, ilen, found) + call json%get(p, CK_'str_array', vec, ilen) + if (json%failed()) then + call json%print_error_message(error_unit) + error_cnt = error_cnt + 1 + end if +#endif + + ! clean up + write(error_unit,'(A)') '' + write(error_unit,'(A)') 'destroy...' + call json%destroy(p) + if (json%failed()) then + call json%print_error_message(error_unit) + error_cnt = error_cnt + 1 + end if + + end subroutine test_25 + +end module jf_test_25_mod +!***************************************************************************************** + +!***************************************************************************************** +program jf_test_25 + + !! 25th unit test. + + use jf_test_25_mod , only: test_25 + implicit none + integer :: n_errors + n_errors = 0 + call test_25(n_errors) + if (n_errors /= 0) stop 1 + +end program jf_test_25 +!***************************************************************************************** From 535d857a89585004e3a7cdb6dfb0c7ae15028291 Mon Sep 17 00:00:00 2001 From: Jacob Williams Date: Thu, 16 Mar 2017 19:34:33 -0500 Subject: [PATCH 3/9] attempted fix for gfortran bug. --- src/json_value_module.F90 | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/src/json_value_module.F90 b/src/json_value_module.F90 index 79212c514a..a5a2eb9b2f 100644 --- a/src/json_value_module.F90 +++ b/src/json_value_module.F90 @@ -6963,8 +6963,16 @@ subroutine get_chars_from_array(json, element, i, count) !size the output array: if (.not. initialized) then ! string length long enough to hold the longest one +#if defined __GFORTRAN__ + ! this is a work-around for a bug + ! in the gfortran 4.9 compiler. + block + character(kind=CK,len=max_len),dimension(count) :: tmp_array + vec = tmp_array + end block +#else allocate( character(kind=CK,len=max_len) :: vec(count) ) - !allocate( ilen(count) ) +#endif initialized = .true. end if From c0887cd4b5b4ff0ad21680a2f95a7456f745f4ed Mon Sep 17 00:00:00 2001 From: Jacob Williams Date: Thu, 16 Mar 2017 19:44:23 -0500 Subject: [PATCH 4/9] another attempt to fix gfortran bug on Travis. --- src/json_value_module.F90 | 24 ++++++++++++++++++++---- 1 file changed, 20 insertions(+), 4 deletions(-) diff --git a/src/json_value_module.F90 b/src/json_value_module.F90 index a5a2eb9b2f..e3b220491c 100644 --- a/src/json_value_module.F90 +++ b/src/json_value_module.F90 @@ -6966,10 +6966,11 @@ subroutine get_chars_from_array(json, element, i, count) #if defined __GFORTRAN__ ! this is a work-around for a bug ! in the gfortran 4.9 compiler. - block - character(kind=CK,len=max_len),dimension(count) :: tmp_array - vec = tmp_array - end block + call allocate_vec(max_len,count) + !block + ! character(kind=CK,len=max_len),dimension(count) :: tmp_array + ! vec = tmp_array + !end block #else allocate( character(kind=CK,len=max_len) :: vec(count) ) #endif @@ -6989,6 +6990,21 @@ subroutine get_chars_from_array(json, element, i, count) end subroutine get_chars_from_array + subroutine allocate_vec(max_len,count) + + !! try to allocate on assignment to avoid gfortran bug. + + implicit none + + integer(IK),intent(in) :: max_len + integer(IK),intent(in) :: count + + character(kind=CK,len=max_len),dimension(count) :: tmp_array + + vec = tmp_array + + end subroutine allocate_vec + end subroutine json_get_alloc_string_vec !***************************************************************************************** From 1a76fb30e3dafd405c989308533e90f8e1c1d7c7 Mon Sep 17 00:00:00 2001 From: Jacob Williams Date: Thu, 16 Mar 2017 19:56:58 -0500 Subject: [PATCH 5/9] trying gfortran-5 for travis build. --- .travis.yml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/.travis.yml b/.travis.yml index a3018826f4..b9f5e22502 100644 --- a/.travis.yml +++ b/.travis.yml @@ -18,7 +18,7 @@ addons: - kalakris-cmake - ubuntu-toolchain-r-test packages: - - gfortran-4.9 + - gfortran-5 - binutils - cmake - python-pip @@ -53,9 +53,9 @@ install: mkdir "$HOME/.local/bin" fi - export PATH="$HOME/.local/bin:$PATH" - - export FC=/usr/bin/gfortran-4.9 - - ln -fs /usr/bin/gfortran-4.9 "$HOME/.local/bin/gfortran" && gfortran --version - - ls -l /usr/bin/gfortran-4.9 + - export FC=/usr/bin/gfortran-5 + - ln -fs /usr/bin/gfortran-5 "$HOME/.local/bin/gfortran" && gfortran --version + - ls -l /usr/bin/gfortran-5 - ln -fs /usr/bin/gcov-4.9 "$HOME/.local/bin/gcov" && gcov --version - perl --version - | From da3cfbe69c3bbb9d9ddcb0d424749eaa750e8012 Mon Sep 17 00:00:00 2001 From: Jacob Williams Date: Thu, 16 Mar 2017 20:01:32 -0500 Subject: [PATCH 6/9] change gcov to 5 as well. --- .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index b9f5e22502..adcfc15871 100644 --- a/.travis.yml +++ b/.travis.yml @@ -56,7 +56,7 @@ install: - export FC=/usr/bin/gfortran-5 - ln -fs /usr/bin/gfortran-5 "$HOME/.local/bin/gfortran" && gfortran --version - ls -l /usr/bin/gfortran-5 - - ln -fs /usr/bin/gcov-4.9 "$HOME/.local/bin/gcov" && gcov --version + - ln -fs /usr/bin/gcov-5 "$HOME/.local/bin/gcov" && gcov --version - perl --version - | if ! which f90split; then From 23e1a1f3a16cd2e5cc8beae6d56209d711d92dd3 Mon Sep 17 00:00:00 2001 From: Jacob Williams Date: Thu, 16 Mar 2017 20:11:47 -0500 Subject: [PATCH 7/9] try gfortran-6 on travis. --- .travis.yml | 10 ++++---- src/json_value_module.F90 | 48 +++++++++++++++++++-------------------- 2 files changed, 29 insertions(+), 29 deletions(-) diff --git a/.travis.yml b/.travis.yml index adcfc15871..be9750fb49 100644 --- a/.travis.yml +++ b/.travis.yml @@ -18,7 +18,7 @@ addons: - kalakris-cmake - ubuntu-toolchain-r-test packages: - - gfortran-5 + - gfortran-6 - binutils - cmake - python-pip @@ -53,10 +53,10 @@ install: mkdir "$HOME/.local/bin" fi - export PATH="$HOME/.local/bin:$PATH" - - export FC=/usr/bin/gfortran-5 - - ln -fs /usr/bin/gfortran-5 "$HOME/.local/bin/gfortran" && gfortran --version - - ls -l /usr/bin/gfortran-5 - - ln -fs /usr/bin/gcov-5 "$HOME/.local/bin/gcov" && gcov --version + - export FC=/usr/bin/gfortran-6 + - ln -fs /usr/bin/gfortran-6 "$HOME/.local/bin/gfortran" && gfortran --version + - ls -l /usr/bin/gfortran-6 + - ln -fs /usr/bin/gcov-6 "$HOME/.local/bin/gcov" && gcov --version - perl --version - | if ! which f90split; then diff --git a/src/json_value_module.F90 b/src/json_value_module.F90 index e3b220491c..401b23b84d 100644 --- a/src/json_value_module.F90 +++ b/src/json_value_module.F90 @@ -6963,17 +6963,17 @@ subroutine get_chars_from_array(json, element, i, count) !size the output array: if (.not. initialized) then ! string length long enough to hold the longest one -#if defined __GFORTRAN__ - ! this is a work-around for a bug - ! in the gfortran 4.9 compiler. - call allocate_vec(max_len,count) - !block - ! character(kind=CK,len=max_len),dimension(count) :: tmp_array - ! vec = tmp_array - !end block -#else +!#if defined __GFORTRAN__ +! ! this is a work-around for a bug +! ! in the gfortran 4.9 compiler. +! call allocate_vec(max_len,count) +! !block +! ! character(kind=CK,len=max_len),dimension(count) :: tmp_array +! ! vec = tmp_array +! !end block +!#else allocate( character(kind=CK,len=max_len) :: vec(count) ) -#endif +!#endif initialized = .true. end if @@ -6990,20 +6990,20 @@ subroutine get_chars_from_array(json, element, i, count) end subroutine get_chars_from_array - subroutine allocate_vec(max_len,count) - - !! try to allocate on assignment to avoid gfortran bug. - - implicit none - - integer(IK),intent(in) :: max_len - integer(IK),intent(in) :: count - - character(kind=CK,len=max_len),dimension(count) :: tmp_array - - vec = tmp_array - - end subroutine allocate_vec + !subroutine allocate_vec(max_len,count) +! + !!! try to allocate on assignment to avoid gfortran bug. +! + !implicit none +! + !integer(IK),intent(in) :: max_len + !integer(IK),intent(in) :: count +! + !character(kind=CK,len=max_len),dimension(count) :: tmp_array +! + !vec = tmp_array +! + !end subroutine allocate_vec end subroutine json_get_alloc_string_vec !***************************************************************************************** From bb8573fa16754ff92d491ea65a9fd2c93925fce7 Mon Sep 17 00:00:00 2001 From: Jacob Williams Date: Thu, 16 Mar 2017 20:32:08 -0500 Subject: [PATCH 8/9] add warning in code. Keep Travis at gfortran-6. --- src/json_value_module.F90 | 29 ++++------------------------- 1 file changed, 4 insertions(+), 25 deletions(-) diff --git a/src/json_value_module.F90 b/src/json_value_module.F90 index 401b23b84d..95127b2136 100644 --- a/src/json_value_module.F90 +++ b/src/json_value_module.F90 @@ -6922,6 +6922,9 @@ end subroutine wrap_json_get_string_vec_by_path ! !@note This is somewhat inefficient since it does ! cycle through the array twice. +! +!@warning The allocation of `vec` doesn't work with +! gfortran 4.9 or 5 due to compiler bugs subroutine json_get_alloc_string_vec(json, me, vec, ilen) @@ -6963,17 +6966,8 @@ subroutine get_chars_from_array(json, element, i, count) !size the output array: if (.not. initialized) then ! string length long enough to hold the longest one -!#if defined __GFORTRAN__ -! ! this is a work-around for a bug -! ! in the gfortran 4.9 compiler. -! call allocate_vec(max_len,count) -! !block -! ! character(kind=CK,len=max_len),dimension(count) :: tmp_array -! ! vec = tmp_array -! !end block -!#else + ! Note that this doesn't work with gfortran 4.9 or 5. allocate( character(kind=CK,len=max_len) :: vec(count) ) -!#endif initialized = .true. end if @@ -6990,21 +6984,6 @@ subroutine get_chars_from_array(json, element, i, count) end subroutine get_chars_from_array - !subroutine allocate_vec(max_len,count) -! - !!! try to allocate on assignment to avoid gfortran bug. -! - !implicit none -! - !integer(IK),intent(in) :: max_len - !integer(IK),intent(in) :: count -! - !character(kind=CK,len=max_len),dimension(count) :: tmp_array -! - !vec = tmp_array -! - !end subroutine allocate_vec - end subroutine json_get_alloc_string_vec !***************************************************************************************** From 1f285e995e9e7cc58cafc49c6274459981d5c8e3 Mon Sep 17 00:00:00 2001 From: Jacob Williams Date: Thu, 16 Mar 2017 20:40:07 -0500 Subject: [PATCH 9/9] added alloc string unit test for json_file object. --- src/tests/jf_test_25.F90 | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/src/tests/jf_test_25.F90 b/src/tests/jf_test_25.F90 index dceaf4dd71..39dded872c 100644 --- a/src/tests/jf_test_25.F90 +++ b/src/tests/jf_test_25.F90 @@ -21,6 +21,7 @@ subroutine test_25(error_cnt) type(json_value),pointer :: p, tmp type(json_core) :: json + type(json_file) :: f logical(lk) :: found character(kind=CK,len=:),dimension(:),allocatable :: vec !! array of strings from JSON integer(ik),dimension(:),allocatable :: ilen !! array of string lengths @@ -102,6 +103,35 @@ subroutine test_25(error_cnt) end if #endif + ! test json_file interface + f = json_file(p) + call f%get('str_array', vec, ilen, found) + if (f%failed()) then + call f%print_error_message(error_unit) + error_cnt = error_cnt + 1 + end if + if (all(ilen==[1,2,3,5])) then + write(error_unit,'(A)') 'json_file success!' + else + write(error_unit,'(A,1X,*(I5,1X))') 'json_file failed: ', ilen + error_cnt = error_cnt + 1 + end if +#ifdef USE_UCS4 + ! unicode test + f = json_file(p) + call f%get(CDK_'str_array', vec, ilen, found) + if (f%failed()) then + call f%print_error_message(error_unit) + error_cnt = error_cnt + 1 + end if + if (all(ilen==[1,2,3,5])) then + write(error_unit,'(A)') 'json_file success!' + else + write(error_unit,'(A,1X,*(I5,1X))') 'json_file failed: ', ilen + error_cnt = error_cnt + 1 + end if +#endif + ! clean up write(error_unit,'(A)') '' write(error_unit,'(A)') 'destroy...'