From d2f12e21dc550ee5ed7794113d397861092da7d6 Mon Sep 17 00:00:00 2001 From: Jacob Williams Date: Sun, 8 Jul 2018 20:10:08 -0500 Subject: [PATCH 1/3] Made the two arguments to json_check_for_errors options, so now either or both can be used. Note that if no errors, then error_msg is now returned unallocated. Fixes #344. --- src/json_value_module.F90 | 26 ++++++++++++++------------ src/tests/jf_test_15.F90 | 6 ++++++ 2 files changed, 20 insertions(+), 12 deletions(-) diff --git a/src/json_value_module.F90 b/src/json_value_module.F90 index 5718969924..5c0e5cf4d4 100644 --- a/src/json_value_module.F90 +++ b/src/json_value_module.F90 @@ -1909,24 +1909,26 @@ end subroutine wrap_json_throw_exception !### See also ! * [[json_failed]] - subroutine json_check_for_errors(json,status_ok,error_msg) + pure subroutine json_check_for_errors(json,status_ok,error_msg) implicit none - class(json_core),intent(inout) :: json - 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) + class(json_core),intent(in) :: json + logical(LK),intent(out),optional :: status_ok !! true if there were no errors + character(kind=CK,len=:),allocatable,intent(out),optional :: error_msg !! the error message. + !! (not allocated if + !! there were no errors) - status_ok = .not. json%exception_thrown + if (present(status_ok)) status_ok = .not. json%exception_thrown - if (.not. status_ok) then - if (allocated(json%err_message)) then - error_msg = json%err_message - else - error_msg = 'Unknown error.' + if (present(error_msg)) then + if (json%exception_thrown) then + if (allocated(json%err_message)) then + error_msg = json%err_message + else + error_msg = 'Unknown error.' ! this should never happen + end if end if - else - error_msg = CK_'' end if end subroutine json_check_for_errors diff --git a/src/tests/jf_test_15.F90 b/src/tests/jf_test_15.F90 index 6eb89c3c4b..7ecb062076 100644 --- a/src/tests/jf_test_15.F90 +++ b/src/tests/jf_test_15.F90 @@ -52,10 +52,16 @@ subroutine test_15(error_cnt) call json%get(p2,'logical',d) call json%get(p2,'integer',tf) call json%get(p2,'real', tf) + call json%check_for_errors(status_ok, error_msg) !error condition true + call json%check_for_errors(status_ok) !error condition true + call json%check_for_errors(error_msg) !error condition true + call json%initialize(print_signs=.true.) !print signs flag call json%check_for_errors(status_ok, error_msg) !error condition false + call json%check_for_errors(status_ok) !error condition false + call json%check_for_errors(error_msg) !error condition false - not allocated call file1%move(file2) !should throw an exception since points are not associated call file1%initialize() From fbdfd7d8097ba545ba27a59d33c3893a8ff1fb32 Mon Sep 17 00:00:00 2001 From: Jacob Williams Date: Sun, 8 Jul 2018 20:10:24 -0500 Subject: [PATCH 2/3] fix typos --- src/tests/jf_test_15.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/tests/jf_test_15.F90 b/src/tests/jf_test_15.F90 index 7ecb062076..a4c6550876 100644 --- a/src/tests/jf_test_15.F90 +++ b/src/tests/jf_test_15.F90 @@ -54,14 +54,14 @@ subroutine test_15(error_cnt) call json%get(p2,'real', tf) call json%check_for_errors(status_ok, error_msg) !error condition true - call json%check_for_errors(status_ok) !error condition true - call json%check_for_errors(error_msg) !error condition true + call json%check_for_errors(status_ok) !error condition true + call json%check_for_errors(error_msg=error_msg) !error condition true call json%initialize(print_signs=.true.) !print signs flag call json%check_for_errors(status_ok, error_msg) !error condition false - call json%check_for_errors(status_ok) !error condition false - call json%check_for_errors(error_msg) !error condition false - not allocated + call json%check_for_errors(status_ok) !error condition false + call json%check_for_errors(error_msg=error_msg) !error condition false - not allocated call file1%move(file2) !should throw an exception since points are not associated call file1%initialize() From 089b012c001cc77c6a00b10f50ee9589de5d23eb Mon Sep 17 00:00:00 2001 From: Jacob Williams Date: Mon, 9 Jul 2018 07:55:56 -0500 Subject: [PATCH 3/3] some minor internal cleanup of error handler. --- src/json_value_module.F90 | 21 ++++++++++++--------- 1 file changed, 12 insertions(+), 9 deletions(-) diff --git a/src/json_value_module.F90 b/src/json_value_module.F90 index 5c0e5cf4d4..73be4bef8b 100644 --- a/src/json_value_module.F90 +++ b/src/json_value_module.F90 @@ -176,7 +176,10 @@ module json_value_module !! when an error is thrown in the class. !! Many of the methods will check this !! and return immediately if it is true. - character(kind=CK,len=:),allocatable :: err_message !! the error message + character(kind=CK,len=:),allocatable :: err_message + !! the error message. + !! if `exception_thrown=False` then + !! this variable is not allocated. integer(IK) :: char_count = 0 !! character position in the current line integer(IK) :: line_count = 1 !! lines read counter @@ -1804,7 +1807,7 @@ pure subroutine json_clear_exceptions(json) !clear the flag and message: json%exception_thrown = .false. - json%err_message = CK_'' + if (allocated(json%err_message)) deallocate(json%err_message) end subroutine json_clear_exceptions !***************************************************************************************** @@ -1908,6 +1911,7 @@ end subroutine wrap_json_throw_exception ! !### See also ! * [[json_failed]] +! * [[json_throw_exception]] pure subroutine json_check_for_errors(json,status_ok,error_msg) @@ -1923,11 +1927,10 @@ pure subroutine json_check_for_errors(json,status_ok,error_msg) if (present(error_msg)) then if (json%exception_thrown) then - if (allocated(json%err_message)) then - error_msg = json%err_message - else - error_msg = 'Unknown error.' ! this should never happen - end if + ! if an exception has been thrown, + ! then this will always be allocated + ! [see json_throw_exception] + error_msg = json%err_message end if end if @@ -8877,8 +8880,8 @@ subroutine annotate_invalid_json(json,iunit,str) end if !create the error message: - json%err_message = json%err_message//newline//& - 'line: '//trim(adjustl(line_str))//', '//& + if (allocated(json%err_message)) json%err_message = json%err_message//newline + json%err_message = 'line: '//trim(adjustl(line_str))//', '//& 'character: '//trim(adjustl(char_str))//newline//& trim(line)//newline//arrow_str