diff --git a/src/json_value_module.F90 b/src/json_value_module.F90 index 5718969924..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,25 +1911,27 @@ end subroutine wrap_json_throw_exception ! !### See also ! * [[json_failed]] +! * [[json_throw_exception]] - 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 + if (present(error_msg)) then + if (json%exception_thrown) then + ! if an exception has been thrown, + ! then this will always be allocated + ! [see json_throw_exception] error_msg = json%err_message - else - error_msg = 'Unknown error.' end if - else - error_msg = CK_'' end if end subroutine json_check_for_errors @@ -8875,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 diff --git a/src/tests/jf_test_15.F90 b/src/tests/jf_test_15.F90 index 6eb89c3c4b..a4c6550876 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_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_msg) !error condition false - not allocated call file1%move(file2) !should throw an exception since points are not associated call file1%initialize()