Added option to stop if any exceptions are raised. Fixes #318

Author: jacobwilliams

src/json_file_module.F90

@@ -371,7 +371,8 @@ subroutine initialize_json_core_in_file(me,verbose,compact_reals,&
                                             path_separator,&
                                             compress_vectors,&
                                             allow_duplicate_keys,&
-                                            escape_solidus)
+                                            escape_solidus,&
+                                            stop_on_error)
 
     implicit none
 
@@ -390,7 +391,8 @@ subroutine initialize_json_core_in_file(me,verbose,compact_reals,&
                             path_separator,&
                             compress_vectors,&
                             allow_duplicate_keys,&
-                            escape_solidus)
+                            escape_solidus,&
+                            stop_on_error)
 
     end subroutine initialize_json_core_in_file
 !*****************************************************************************************
@@ -456,7 +458,8 @@ function initialize_json_file(p,verbose,compact_reals,&
                                   path_separator,&
                                   compress_vectors,&
                                   allow_duplicate_keys,&
-                                  escape_solidus) result(file_object)
+                                  escape_solidus,&
+                                  stop_on_error) result(file_object)
 
     implicit none
 
@@ -477,7 +480,8 @@ function initialize_json_file(p,verbose,compact_reals,&
                                 path_separator,&
                                 compress_vectors,&
                                 allow_duplicate_keys,&
-                                escape_solidus)
+                                escape_solidus,&
+                                stop_on_error)
 
     if (present(p)) file_object%p => p
 

src/json_initialize_arguments.inc

@@ -73,4 +73,7 @@ logical(LK),intent(in),optional :: escape_solidus
   !! Note that this option does not affect parsing
   !! (both escaped and unescaped are still valid in
   !! all cases).
+logical(LK),intent(in),optional :: stop_on_error
+  !! If an exception is raised, then immediately quit.
+  !! (Default if False).
 

src/json_value_module.F90

@@ -167,6 +167,11 @@ module json_value_module
 
         logical(LK) :: is_verbose = .false.        !! if true, all exceptions are
                                                    !! immediately printed to console.
+
+        logical(LK) :: stop_on_error = .false.    !! if true, then the program is
+                                                   !! stopped immediately when an
+                                                   !! exception is raised.
+
         logical(LK) :: exception_thrown = .false.  !! The error flag. Will be set to true
                                                    !! when an error is thrown in the class.
                                                    !! Many of the methods will check this
@@ -814,7 +819,8 @@ function initialize_json_core(verbose,compact_reals,&
                                   path_separator,&
                                   compress_vectors,&
                                   allow_duplicate_keys,&
-                                  escape_solidus) result(json_core_object)
+                                  escape_solidus,&
+                                  stop_on_error) result(json_core_object)
 
     implicit none
 
@@ -833,7 +839,8 @@ function initialize_json_core(verbose,compact_reals,&
                                 path_separator,&
                                 compress_vectors,&
                                 allow_duplicate_keys,&
-                                escape_solidus)
+                                escape_solidus,&
+                                stop_on_error)
 
     end function initialize_json_core
 !*****************************************************************************************
@@ -869,7 +876,8 @@ subroutine json_initialize(me,verbose,compact_reals,&
                                path_separator,&
                                compress_vectors,&
                                allow_duplicate_keys,&
-                               escape_solidus)
+                               escape_solidus,&
+                               stop_on_error)
 
     implicit none
 
@@ -904,6 +912,8 @@ subroutine json_initialize(me,verbose,compact_reals,&
     !various optional inputs:
     if (present(spaces_per_tab)) &
         me%spaces_per_tab = spaces_per_tab
+    if (present(stop_on_error)) &
+        me%stop_on_error = stop_on_error
     if (present(verbose)) &
         me%is_verbose = verbose
     if (present(strict_type_checking)) &
@@ -1789,6 +1799,8 @@ end subroutine json_clear_exceptions
 !
 !@note If `is_verbose` is true, this will also print a
 !      traceback if the Intel compiler is used.
+!
+!@note If `stop_on_error` is true, then the program is stopped.
 
     subroutine json_throw_exception(json,msg)
 
@@ -1804,14 +1816,31 @@ subroutine json_throw_exception(json,msg)
     json%exception_thrown = .true.
     json%err_message = trim(msg)
 
-    if (json%is_verbose) then
+    if (json%stop_on_error) then
+
+#ifdef __INTEL_COMPILER
+        ! for Intel, we raise a traceback and quit
+        call tracebackqq(string=trim(msg), user_exit_code=0)
+#else
+        write(error_unit,'(A)') 'JSON-Fortran Exception: '//trim(msg)
+        error stop 'JSON-Fortran Exception'
+#endif
+
+    elseif (json%is_verbose) then
+
         write(output_unit,'(A)') '***********************'
         write(output_unit,'(A)') 'JSON-Fortran Exception: '//trim(msg)
-        !call backtrace()     ! gfortran (use -fbacktrace -fall-intrinsics flags)
+
+#if defined __GFORTRAN__
+        !call backtrace()  ! (have to compile with -fbacktrace -fall-intrinsics flags)
+#endif
+
 #ifdef __INTEL_COMPILER
         call tracebackqq(user_exit_code=-1)  ! print a traceback and return
 #endif
+
         write(output_unit,'(A)') '***********************'
+
     end if
 
     end subroutine json_throw_exception