error handling example: cosmetics.

examples/example_hl.f90

@@ -97,10 +97,10 @@ PROGRAM example
   test_result  = division(test_number1, test_number2, ifail)
 
   SELECT TYPE(info => ifail%info)
-  CLASS is (t_arithmetic_error)
+  TYPE is (t_arithmetic_error)
     WRITE (0,*) "I'm too stupid!"
     CALL ifail%report()
-  CLASS is (t_invalid_input_error)
+  TYPE is (t_invalid_input_error)
     WRITE (0,*) "You are too stupid!"
     CALL ifail%report()
   CLASS default

src/error_handling.f90

@@ -32,7 +32,6 @@ MODULE error_handling
     CHARACTER(LEN=MAX_ERROR_STR_LEN) :: error_string
   END TYPE t_error_info
 
-
   !> Error info type: Invalid user input
   TYPE, EXTENDS(t_error_info) :: t_invalid_input_error
   END TYPE t_invalid_input_error
@@ -41,7 +40,6 @@ MODULE error_handling
   TYPE, EXTENDS(t_error_info) :: t_arithmetic_error
   END TYPE t_arithmetic_error
 
- 
 
   !> Base class for errors
   TYPE t_error
@@ -60,7 +58,11 @@ CONTAINS
   SUBROUTINE create_error(new_error, new_info)
     TYPE(t_error),       INTENT(INOUT) :: new_error
     CLASS(t_error_info), INTENT(IN)    :: new_info
-    ALLOCATE(new_error%info, source=new_info)
+    INTEGER :: ierrstat
+    ALLOCATE(new_error%info, source=new_info, STAT=ierrstat)
+    IF (ierrstat /= 0) THEN
+      WRITE (0,*) "error_discard: DEALLOCATE failed!"
+    END IF
   END SUBROUTINE create_error
 
 
@@ -72,6 +74,7 @@ CONTAINS
   SUBROUTINE transfer_error(inform, new_error)
     TYPE(t_error), INTENT(IN)    :: inform
     TYPE(t_error), INTENT(INOUT) :: new_error
+    IF (ASSOCIATED(new_error%info))  CALL new_error%report()
     new_error%info => inform%info
   END SUBROUTINE transfer_error
 
@@ -94,7 +97,13 @@ CONTAINS
   !
   SUBROUTINE error_discard(this)
     CLASS(t_error) :: this
-    IF (ASSOCIATED(this%info))  DEALLOCATE(this%info)
+    INTEGER        :: ierrstat
+    IF (ASSOCIATED(this%info)) THEN
+      DEALLOCATE(this%info, STAT=ierrstat)
+      IF (ierrstat /= 0) THEN
+        WRITE (0,*) "error_discard: DEALLOCATE failed!"
+      END IF
+    END IF
   END SUBROUTINE error_discard
 
 END MODULE error_handling