From 6b426df24f9544261cd6619302d7a437ba14eacb Mon Sep 17 00:00:00 2001 From: Jacob Williams Date: Sat, 11 Jun 2016 21:26:18 -0500 Subject: [PATCH 1/3] first cut at added traverse() to json_file. --- src/json_file_module.F90 | 90 +++++++++++++++++++++++++-------------- src/json_value_module.F90 | 26 +++++------ 2 files changed, 72 insertions(+), 44 deletions(-) diff --git a/src/json_file_module.F90 b/src/json_file_module.F90 index f129b1ee7e..2ad2cf7f07 100644 --- a/src/json_file_module.F90 +++ b/src/json_file_module.F90 @@ -61,7 +61,10 @@ module json_file_module private - type(json_core) :: json !! the instance of the [[json_core]] factory used for this file + type(json_core),public :: core !! The instance of the [[json_core]] + !! factory used for this file. + !! Note that this is public, so it can + !! also be used by the user. type(json_value),pointer :: p => null() !! the JSON structure read from the file @@ -142,6 +145,9 @@ module json_file_module procedure :: json_file_print_1 procedure :: json_file_print_2 + !traverse + procedure,public :: traverse => json_file_traverse + end type json_file !********************************************************* @@ -188,7 +194,7 @@ pure function json_file_failed(me) result(failed) class(json_file),intent(in) :: me logical(LK) :: failed !! will be true if there has been an error. - failed = me%json%failed() + failed = me%core%failed() end function json_file_failed !***************************************************************************************** @@ -205,7 +211,7 @@ subroutine json_file_check_for_errors(me,status_ok,error_msg) logical(LK),intent(out) :: status_ok !! true if there were no errors character(kind=CK,len=:),allocatable,intent(out) :: error_msg !! the error message (if there were errors) - call me%json%check_for_errors(status_ok,error_msg) + call me%core%check_for_errors(status_ok,error_msg) end subroutine json_file_check_for_errors !***************************************************************************************** @@ -220,7 +226,7 @@ pure subroutine json_file_clear_exceptions(me) class(json_file),intent(inout) :: me - call me%json%clear_exceptions() + call me%core%clear_exceptions() end subroutine json_file_clear_exceptions !***************************************************************************************** @@ -236,7 +242,7 @@ subroutine json_file_print_error_message(me,io_unit) class(json_file),intent(inout) :: me integer, intent(in), optional :: io_unit - call me%json%print_error_message(io_unit) + call me%core%print_error_message(io_unit) end subroutine json_file_print_error_message !***************************************************************************************** @@ -274,7 +280,7 @@ subroutine initialize_json_core_in_file(me,verbose,compact_reals,& logical(LK),intent(in),optional :: case_sensitive_keys !! for name and path comparisons, are they !! case sensitive. - call me%json%initialize(verbose,compact_reals,& + call me%core%initialize(verbose,compact_reals,& print_signs,real_format,spaces_per_tab,& strict_type_checking,& trailing_spaces_significant,& @@ -346,7 +352,7 @@ function initialize_json_file_v2(json_value_object, json_core_object) & type(json_core),intent(in) :: json_core_object file_object%p => json_value_object - file_object%json = json_core_object + file_object%core = json_core_object end function initialize_json_file_v2 !***************************************************************************************** @@ -375,10 +381,10 @@ subroutine json_file_destroy(me,destroy_core) logical,intent(in),optional :: destroy_core !! to also destroy the [[json_core]]. !! default is to leave it as is. - if (associated(me%p)) call me%json%destroy(me%p) + if (associated(me%p)) call me%core%destroy(me%p) if (present(destroy_core)) then - if (destroy_core) call me%json%destroy() + if (destroy_core) call me%core%destroy() end if end subroutine json_file_destroy @@ -405,7 +411,7 @@ subroutine json_file_move_pointer(to,from) if (from%failed()) then !Don't get the data if the FROM file has an !active exception, since it may not be valid. - call to%json%throw_exception('Error in json_file_move_pointer: '//& + call to%core%throw_exception('Error in json_file_move_pointer: '//& 'error exception in FROM file.') else call to%initialize() !initialize and clear any exceptions that may be present @@ -414,7 +420,7 @@ subroutine json_file_move_pointer(to,from) end if else - call to%json%throw_exception('Error in json_file_move_pointer: '//& + call to%core%throw_exception('Error in json_file_move_pointer: '//& 'pointer is not associated.') end if @@ -448,7 +454,7 @@ subroutine json_file_load(me, filename, unit) character(kind=CDK,len=*),intent(in) :: filename !! the filename to open integer(IK),intent(in),optional :: unit !! the unit number to use (if not present, a newunit is used) - call me%json%parse(file=filename, p=me%p, unit=unit) + call me%core%parse(file=filename, p=me%p, unit=unit) end subroutine json_file_load !***************************************************************************************** @@ -474,7 +480,7 @@ subroutine json_file_load_from_string(me, str) class(json_file),intent(inout) :: me character(kind=CK,len=*),intent(in) :: str !! string to load JSON data from - call me%json%parse(str=str, p=me%p) + call me%core%parse(str=str, p=me%p) end subroutine json_file_load_from_string !***************************************************************************************** @@ -507,7 +513,7 @@ subroutine json_file_print_to_console(me) class(json_file),intent(inout) :: me - call me%json%print(me%p,iunit=output_unit) + call me%core%print(me%p,iunit=output_unit) end subroutine json_file_print_to_console !***************************************************************************************** @@ -526,9 +532,9 @@ subroutine json_file_print_1(me, iunit) integer(IK),intent(in) :: iunit !! file unit number (must not be -1) if (iunit/=unit2str) then - call me%json%print(me%p,iunit=iunit) + call me%core%print(me%p,iunit=iunit) else - call me%json%throw_exception('Error in json_file_print_1: iunit must not be -1.') + call me%core%throw_exception('Error in json_file_print_1: iunit must not be -1.') end if end subroutine json_file_print_1 @@ -559,7 +565,7 @@ subroutine json_file_print_2(me,filename) class(json_file),intent(inout) :: me character(kind=CDK,len=*),intent(in) :: filename !! filename to print to - call me%json%print(me%p,filename) + call me%core%print(me%p,filename) end subroutine json_file_print_2 !***************************************************************************************** @@ -587,7 +593,7 @@ subroutine json_file_print_to_string(me,str) class(json_file),intent(inout) :: me character(kind=CK,len=:),allocatable,intent(out) :: str !! string to print JSON data to - call me%json%print_to_string(me%p,str) + call me%core%print_to_string(me%p,str) end subroutine json_file_print_to_string !***************************************************************************************** @@ -619,7 +625,7 @@ subroutine json_file_variable_info(me,path,found,var_type,n_children) if (found) then !get info: - call me%json%info(p,var_type,n_children) + call me%core%info(p,var_type,n_children) else @@ -689,7 +695,7 @@ subroutine json_file_get_object(me, path, p, found) type(json_value),pointer,intent(out) :: p !! pointer to the variable logical(LK),intent(out),optional :: found !! if it was really found - call me%json%get(me%p, path=path, p=p, found=found) + call me%core%get(me%p, path=path, p=p, found=found) end subroutine json_file_get_object !***************************************************************************************** @@ -727,7 +733,7 @@ subroutine json_file_get_integer(me, path, val, found) integer(IK),intent(out) :: val !! value logical(LK),intent(out),optional :: found !! if it was really found - call me%json%get(me%p, path=path, value=val, found=found) + call me%core%get(me%p, path=path, value=val, found=found) end subroutine json_file_get_integer !***************************************************************************************** @@ -765,7 +771,7 @@ subroutine json_file_get_integer_vec(me, path, vec, found) integer(IK),dimension(:),allocatable,intent(out) :: vec !! the value vector logical(LK),intent(out),optional :: found !! if it was really found - call me%json%get(me%p, path, vec, found) + call me%core%get(me%p, path, vec, found) end subroutine json_file_get_integer_vec !***************************************************************************************** @@ -803,7 +809,7 @@ subroutine json_file_get_double (me, path, val, found) real(RK),intent(out) :: val logical(LK),intent(out),optional :: found - call me%json%get(me%p, path=path, value=val, found=found) + call me%core%get(me%p, path=path, value=val, found=found) end subroutine json_file_get_double !***************************************************************************************** @@ -841,7 +847,7 @@ subroutine json_file_get_double_vec(me, path, vec, found) real(RK),dimension(:),allocatable,intent(out) :: vec logical(LK),intent(out),optional :: found - call me%json%get(me%p, path, vec, found) + call me%core%get(me%p, path, vec, found) end subroutine json_file_get_double_vec !***************************************************************************************** @@ -879,7 +885,7 @@ subroutine json_file_get_logical(me,path,val,found) logical(LK),intent(out) :: val logical(LK),intent(out),optional :: found - call me%json%get(me%p, path=path, value=val, found=found) + call me%core%get(me%p, path=path, value=val, found=found) end subroutine json_file_get_logical !***************************************************************************************** @@ -917,7 +923,7 @@ subroutine json_file_get_logical_vec(me, path, vec, found) logical(LK),dimension(:),allocatable,intent(out) :: vec logical(LK),intent(out),optional :: found - call me%json%get(me%p, path, vec, found) + call me%core%get(me%p, path, vec, found) end subroutine json_file_get_logical_vec !***************************************************************************************** @@ -956,7 +962,7 @@ subroutine json_file_get_string(me, path, val, found) character(kind=CK,len=:),allocatable,intent(out) :: val logical(LK),intent(out),optional :: found - call me%json%get(me%p, path=path, value=val, found=found) + call me%core%get(me%p, path=path, value=val, found=found) end subroutine json_file_get_string !***************************************************************************************** @@ -994,7 +1000,7 @@ subroutine json_file_get_string_vec(me, path, vec, found) character(kind=CK,len=*),dimension(:),allocatable,intent(out) :: vec logical(LK),intent(out),optional :: found - call me%json%get(me%p, path, vec, found) + call me%core%get(me%p, path, vec, found) end subroutine json_file_get_string_vec !***************************************************************************************** @@ -1037,7 +1043,7 @@ subroutine json_file_update_integer(me,name,val,found) integer(IK),intent(in) :: val logical(LK),intent(out) :: found - if (.not. me%json%failed()) call me%json%update(me%p,name,val,found) + if (.not. me%core%failed()) call me%core%update(me%p,name,val,found) end subroutine json_file_update_integer !***************************************************************************************** @@ -1080,7 +1086,7 @@ subroutine json_file_update_logical(me,name,val,found) logical(LK),intent(in) :: val logical(LK),intent(out) :: found - if (.not. me%json%failed()) call me%json%update(me%p,name,val,found) + if (.not. me%core%failed()) call me%core%update(me%p,name,val,found) end subroutine json_file_update_logical !***************************************************************************************** @@ -1123,7 +1129,7 @@ subroutine json_file_update_real(me,name,val,found) real(RK),intent(in) :: val logical(LK),intent(out) :: found - if (.not. me%json%failed()) call me%json%update(me%p,name,val,found) + if (.not. me%core%failed()) call me%core%update(me%p,name,val,found) end subroutine json_file_update_real !***************************************************************************************** @@ -1166,7 +1172,7 @@ subroutine json_file_update_string(me,name,val,found) character(kind=CK,len=*),intent(in) :: val logical(LK),intent(out) :: found - if (.not. me%json%failed()) call me%json%update(me%p,name,val,found) + if (.not. me%core%failed()) call me%core%update(me%p,name,val,found) end subroutine json_file_update_string !***************************************************************************************** @@ -1225,6 +1231,26 @@ subroutine json_file_update_string_val_ascii(me,name,val,found) end subroutine json_file_update_string_val_ascii !***************************************************************************************** +!***************************************************************************************** +!> author: Jacob Williams +! date: 6/11/2016 +! +! Traverse the JSON structure in the file. +! This routine calls the user-specified [[json_traverse_callback_func]] +! for each element of the structure. + + subroutine json_file_traverse(me,traverse_callback) + + implicit none + + class(json_file),intent(inout) :: me + procedure(json_traverse_callback_func) :: traverse_callback + + call me%core%traverse(me%p,traverse_callback) + + end subroutine json_file_traverse +!***************************************************************************************** + !***************************************************************************************** end module json_file_module !***************************************************************************************** diff --git a/src/json_value_module.F90 b/src/json_value_module.F90 index 359eec397a..676551072b 100644 --- a/src/json_value_module.F90 +++ b/src/json_value_module.F90 @@ -565,7 +565,7 @@ module json_value_module !************************************************************************************* abstract interface - subroutine array_callback_func(json, element, i, count) + subroutine json_array_callback_func(json, element, i, count) !! Array element callback function. Used by [[json_get_array]] import :: json_value,json_core,IK implicit none @@ -573,18 +573,20 @@ subroutine array_callback_func(json, element, i, count) type(json_value),pointer,intent(in) :: element integer(IK),intent(in) :: i !! index integer(IK),intent(in) :: count !! size of array - end subroutine array_callback_func + end subroutine json_array_callback_func - subroutine traverse_callback_func(json,p,finished) + subroutine json_traverse_callback_func(json,p,finished) !! Callback function used by [[json_traverse]] import :: json_value,json_core,LK implicit none class(json_core),intent(inout) :: json type(json_value),pointer,intent(in) :: p logical(LK),intent(out) :: finished !! set true to stop traversing - end subroutine traverse_callback_func + end subroutine json_traverse_callback_func end interface + public :: json_array_callback_func + public :: json_traverse_callback_func !************************************************************************************* contains @@ -4487,7 +4489,7 @@ end subroutine wrap_json_get_string_vec_with_path !***************************************************************************************** !> -! This routine calls the user-supplied [[array_callback_func]] subroutine +! 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, @@ -4500,7 +4502,7 @@ subroutine json_get_array(json, me, array_callback) class(json_core),intent(inout) :: json type(json_value),pointer,intent(in) :: me - procedure(array_callback_func) :: array_callback + procedure(json_array_callback_func) :: array_callback type(json_value),pointer :: element !! temp variable for getting elements integer(IK) :: i !! counter @@ -4542,16 +4544,16 @@ end subroutine json_get_array ! date: 4/28/2016 ! ! Traverse a JSON structure. -! This routine calls the user-specified [[traverse_callback_func]] +! This routine calls the user-specified [[json_traverse_callback_func]] ! for each element of the structure. subroutine json_traverse(json,p,traverse_callback) implicit none - class(json_core),intent(inout) :: json - type(json_value),pointer,intent(in) :: p - procedure(traverse_callback_func) :: traverse_callback + class(json_core),intent(inout) :: json + type(json_value),pointer,intent(in) :: p + procedure(json_traverse_callback_func) :: traverse_callback logical(LK) :: finished !! can be used to stop the process @@ -4613,7 +4615,7 @@ subroutine json_get_array_with_path(json, me, path, array_callback, found) class(json_core),intent(inout) :: json type(json_value),pointer,intent(in) :: me character(kind=CK,len=*),intent(in) :: path - procedure(array_callback_func) :: array_callback + procedure(json_array_callback_func) :: array_callback logical(LK),intent(out),optional :: found type(json_value),pointer :: p @@ -4658,7 +4660,7 @@ subroutine wrap_json_get_array_with_path(json, me, path, array_callback, found) class(json_core),intent(inout) :: json type(json_value),pointer,intent(in) :: me character(kind=CDK,len=*),intent(in) :: path - procedure(array_callback_func) :: array_callback + procedure(json_array_callback_func) :: array_callback logical(LK),intent(out),optional :: found call json%get(me, to_unicode(path), array_callback, found) From 99479cf8192992e4a7b48c08673a7006a1373d11 Mon Sep 17 00:00:00 2001 From: Jacob Williams Date: Sun, 12 Jun 2016 11:34:14 -0500 Subject: [PATCH 2/3] added get/set routines for the json_core in a json_file core no longer public in json_file (reverts change made in previous commit) --- src/json_file_module.F90 | 63 ++++++++++++++++++++++++++++++++++------ 1 file changed, 54 insertions(+), 9 deletions(-) diff --git a/src/json_file_module.F90 b/src/json_file_module.F90 index 2ad2cf7f07..330056d11e 100644 --- a/src/json_file_module.F90 +++ b/src/json_file_module.F90 @@ -61,16 +61,15 @@ module json_file_module private - type(json_core),public :: core !! The instance of the [[json_core]] - !! factory used for this file. - !! Note that this is public, so it can - !! also be used by the user. - + type(json_core) :: core !! The instance of the [[json_core]] factory used for this file. type(json_value),pointer :: p => null() !! the JSON structure read from the file contains - procedure,public :: initialize => initialize_json_core_in_file + generic,public :: initialize => initialize_json_core_in_file,& + set_json_core_in_file + + procedure,public :: get_core => get_json_core_in_file procedure,public :: load_file => json_file_load @@ -112,9 +111,20 @@ module json_file_module json_file_update_string_val_ascii #endif + !traverse + procedure,public :: traverse => json_file_traverse + + ! *************************************************** + ! private routines + ! *************************************************** + !load from string: procedure :: MAYBEWRAP(json_file_load_from_string) + !initialize + procedure :: initialize_json_core_in_file + procedure :: set_json_core_in_file + !git info: procedure :: MAYBEWRAP(json_file_variable_info) @@ -145,9 +155,6 @@ module json_file_module procedure :: json_file_print_1 procedure :: json_file_print_2 - !traverse - procedure,public :: traverse => json_file_traverse - end type json_file !********************************************************* @@ -289,6 +296,44 @@ subroutine initialize_json_core_in_file(me,verbose,compact_reals,& end subroutine initialize_json_core_in_file !***************************************************************************************** +!***************************************************************************************** +!> +! Set the [[json_core]] for this [[json_file]]. +! +!@note: This does not destroy the data in the file. +! +!@note: This one is used if you want to initialize the file with +! an already-existing [[json_core]] (presumably, this was already +! initialized by a call to [[initialize_json_core]] or similar). + + subroutine set_json_core_in_file(me,core) + + implicit none + + class(json_file),intent(inout) :: me + type(json_core),intent(in) :: core + + me%core = core + + end subroutine set_json_core_in_file +!***************************************************************************************** + +!***************************************************************************************** +!> +! Get a copy of the [[json_core]] in this [[json_file]]. + + subroutine get_json_core_in_file(me,core) + + implicit none + + class(json_file),intent(in) :: me + type(json_core),intent(out) :: core + + core = me%core + + end subroutine get_json_core_in_file +!***************************************************************************************** + !***************************************************************************************** !> author: Izaak Beekman ! date: 07/23/2015 From 6fe76f793f717f08ff59ef3c845d366374050c08 Mon Sep 17 00:00:00 2001 From: Jacob Williams Date: Sun, 12 Jun 2016 16:06:41 -0500 Subject: [PATCH 3/3] added unit tests for recent new features. --- src/tests/jf_test_14.f90 | 46 ++++++++++++++++++++++++++++++++++++---- src/tests/jf_test_3.f90 | 14 ++++++++++++ 2 files changed, 56 insertions(+), 4 deletions(-) diff --git a/src/tests/jf_test_14.f90 b/src/tests/jf_test_14.f90 index d65144a308..29a7db5012 100644 --- a/src/tests/jf_test_14.f90 +++ b/src/tests/jf_test_14.f90 @@ -14,6 +14,7 @@ module jf_test_14_mod character(len=*),parameter :: dir = '../files/inputs/' !! working directory character(len=*),parameter :: filename1 = 'test1.json' !! the file to read integer :: icount = 0 !! a count of the number of "name" variables found + character(len=:),allocatable :: new_name !! name to change to contains @@ -29,6 +30,7 @@ subroutine test_14(error_cnt) type(json_core) :: json type(json_value),pointer :: p + type(json_file) :: f write(error_unit,'(A)') '' write(error_unit,'(A)') '=================================' @@ -37,7 +39,9 @@ subroutine test_14(error_cnt) write(error_unit,'(A)') '' error_cnt = 0 + icount = 0 !number of name changes (should be 2) + new_name = 'Fred' !change all names to this call json%initialize() !initialize the module @@ -60,7 +64,7 @@ subroutine test_14(error_cnt) if (error_cnt==0) then write(error_unit,'(A)') '' - write(error_unit,'(A)') ' All names changed to Fred:' + write(error_unit,'(A)') ' All names changed to '//new_name//':' write(error_unit,'(A)') '' call json%print(p,output_unit) write(error_unit,'(A)') '' @@ -72,6 +76,40 @@ subroutine test_14(error_cnt) error_cnt = error_cnt + 1 end if + ! now, test traversal from a json_file: + new_name = 'Bob' + icount = 0 + call f%initialize() + call f%load_file(dir//filename1) !read the file + if (f%failed()) then + call f%print_error_message(error_unit) + error_cnt = error_cnt + 1 + end if + call f%traverse(rename) !traverse all nodes in the structure + if (f%failed()) then + call f%print_error_message(error_unit) + error_cnt = error_cnt + 1 + end if + + if (icount/=2) then + write(error_unit,'(A)') 'Error: should be 2 "name" variables in this file: '//filename1 + error_cnt = error_cnt + 1 + end if + + if (error_cnt==0) then + write(error_unit,'(A)') '' + write(error_unit,'(A)') ' All names changed to '//new_name//':' + write(error_unit,'(A)') '' + call f%print_file(output_unit) + write(error_unit,'(A)') '' + end if + + call f%destroy() ! clean up + if (f%failed()) then + call f%print_error_message(error_unit) + error_cnt = error_cnt + 1 + end if + end subroutine test_14 subroutine rename(json,p,finished) !! change all "name" variable values to "Fred" @@ -91,9 +129,9 @@ subroutine rename(json,p,finished) !! change all "name" variable values to "Fre !it must be a string named "name": if (var_type==json_string .and. str=='name') then - call json%get(p,'@',str) ! get original name - call json%update(p,'@','Fred',found) ! change it - write(error_unit,'(A)') str//' name changed' + call json%get(p,'@',str) ! get original name + call json%update(p,'@',new_name,found) ! change it + write(error_unit,'(A)') str//' name changed to '//new_name icount = icount + 1 end if diff --git a/src/tests/jf_test_3.f90 b/src/tests/jf_test_3.f90 index fbb646261b..51be30c7fa 100644 --- a/src/tests/jf_test_3.f90 +++ b/src/tests/jf_test_3.f90 @@ -31,6 +31,7 @@ subroutine test_3(error_cnt) integer :: i character(kind=json_CK,len=10) :: str real(wp),dimension(:),allocatable :: rvec + type(json_core) :: core write(error_unit,'(A)') '' write(error_unit,'(A)') '=================================' @@ -119,6 +120,19 @@ subroutine test_3(error_cnt) error_cnt = error_cnt + 1 end if + write(error_unit,'(A)') '' + write(error_unit,'(A)') 'json_core tests...' + ! test json_core manipulation: + call core%initialize(trailing_spaces_significant=.true.,& + case_sensitive_keys=.true.) + call json%initialize(core) ! send it to the file + call core%destroy() + call json%get_core(core) ! get it back + if (core%failed()) then + call core%print_error_message(error_unit) + error_cnt = error_cnt + 1 + end if + end subroutine test_3 end module jf_test_3_mod