From 4492ac6702d2518b6e154ea30fa6da133c2b052d Mon Sep 17 00:00:00 2001
From: Florian Prill <m300196@mlogin102.hpc.dkrz.de>
Date: Mon, 12 Sep 2016 11:34:27 +0200
Subject: [PATCH] error handling example: cosmetics.
---
examples/example_hl.f90 | 4 ++--
src/error_handling.f90 | 17 +++++++++++++----
2 files changed, 15 insertions(+), 6 deletions(-)
diff --git a/examples/example_hl.f90 b/examples/example_hl.f90
index 694b5f19..eb9cc94e 100644
--- a/examples/example_hl.f90
+++ b/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
diff --git a/src/error_handling.f90 b/src/error_handling.f90
index ab3ea6f7..070aae45 100644
--- a/src/error_handling.f90
+++ b/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
--
GitLab