diff --git a/examples/example_hl.f90 b/examples/example_hl.f90
index f9a36e6b501f8cc052e063bcf94ef35e4ad01b08..fe1fd82ea0e990ffc8be754dae813990180b9579 100644
--- a/examples/example_hl.f90
+++ b/examples/example_hl.f90
@@ -1,18 +1,20 @@
-
PROGRAM example
USE mtime, ONLY: setCalendar, PROLEPTIC_GREGORIAN
USE mtime_hl, ONLY: t_datetime, t_timedelta, min, max, &
& t_timedeltaFromMilliseconds, &
& divisionquotienttimespan
+ USE mtime_print_by_callback
IMPLICIT NONE
- TYPE(t_datetime) :: dt, dt2, dt3, dt4
- TYPE(t_timedelta) :: td, td1
+ TYPE(t_datetime) :: dt, dt2, dt3, dt4, dt5
+ TYPE(t_timedelta) :: td, td1, td2
TYPE(divisionquotienttimespan) :: dqts
+ CHARACTER(LEN=*), PARAMETER :: ERR_UNCAUGHT = "!!!!!!!!! error was not caught !!!!!!!"
INTEGER :: test_number1, test_number2, test_result
+ LOGICAL :: lerror
WRITE (0,*) "example_hl : test example"
@@ -77,11 +79,82 @@ PROGRAM example
dqts = td1%divideInSecondsBy(td)
WRITE (0,*) td1%toString(), " / ", td%toString(), " = ", dqts%quotient, " plus stuff"
- ! produce error
- dt = t_datetime("1970--01-01T00:00:00")
-
! toSeconds, toMilliSeconds
WRITE (0,*) td%toString(), " is in seconds ", td%toSeconds(dt)
WRITE (0,*) td%toString(), " is in milliseconds ", td%toMilliSeconds(dt)
+ ! register an error callback without stopping the application for
+ ! our tests:
+ CALL register_finish_mtime_procedure(error_callback)
+
+ ! produce errors
+ WRITE (0,*) 'ERROR TEST: dt = t_datetime("1970--01-01T00:00:00")'
+ lerror = .FALSE.
+ dt = t_datetime("1970--01-01T00:00:00")
+ IF (.NOT. lerror) WRITE(0,*) ERR_UNCAUGHT
+
+ WRITE (0,*) 'ERROR TEST: dt = dt5'
+ lerror = .FALSE.
+ dt = dt5
+ IF (.NOT. lerror) WRITE(0,*) ERR_UNCAUGHT
+
+ WRITE (0,*) 'ERROR TEST: dt5%toString()'
+ lerror = .FALSE.
+ WRITE (0,*) dt5%toString()
+ IF (.NOT. lerror) WRITE(0,*) ERR_UNCAUGHT
+
+ WRITE (0,*) 'ERROR TEST: dt5%to_posix_string()'
+ lerror = .FALSE.
+ WRITE (0,*) dt5%toString("%s%d%LK")
+ IF (.NOT. lerror) WRITE(0,*) ERR_UNCAUGHT
+
+ WRITE (0,*) 'ERROR TEST: dt = dt + td2'
+ lerror = .FALSE.
+ dt = dt + td2
+ IF (.NOT. lerror) WRITE(0,*) ERR_UNCAUGHT
+
+ WRITE (0,*) 'ERROR TEST: dt = dt - td2'
+ lerror = .FALSE.
+ dt = dt - td2
+ IF (.NOT. lerror) WRITE(0,*) ERR_UNCAUGHT
+
+ WRITE (0,*) 'ERROR TEST: dt = dt - td2'
+ lerror = .FALSE.
+ dt = dt - td2
+ IF (.NOT. lerror) WRITE(0,*) ERR_UNCAUGHT
+
+ WRITE (0,*) 'ERROR TEST: td = t_timedelta(...)'
+ lerror = .FALSE.
+ td = t_timedelta("P1lK")
+ IF (.NOT. lerror) WRITE(0,*) ERR_UNCAUGHT
+
+ td = t_timedeltaFromMilliseconds(HUGE(INT(1)))
+ WRITE (0,*) "t_timedeltaFromMilliseconds(HUGE(INT(1))) : HUGE(INT(1)) = ", HUGE(INT(1))
+ WRITE (0,*) "td%toString() = ", td%toString()
+
+ WRITE (0,*) 'ERROR TEST: td = td * 0.000001D0'
+ WRITE (0,*) 'td%toString() = ', td%toString()
+ lerror = .FALSE.
+ td = td * 0.000001D0
+ IF (.NOT. lerror) WRITE(0,*) ERR_UNCAUGHT
+
+ WRITE (0,*) 'ERROR TEST: td2 = td2 * 1'
+ lerror = .FALSE.
+ td2 = td2 * 1
+ IF (.NOT. lerror) WRITE(0,*) ERR_UNCAUGHT
+
+ WRITE (0,*) 'ERROR TEST: td2%toString()'
+ lerror = .FALSE.
+ WRITE (0,*) 'td2%toString() = ', td2%toString()
+ IF (.NOT. lerror) WRITE(0,*) ERR_UNCAUGHT
+
+CONTAINS
+
+ SUBROUTINE error_callback(leading_text, message_text)
+ CHARACTER(len=*), INTENT(in) :: leading_text
+ CHARACTER(len=*), INTENT(in) :: message_text
+ WRITE (0,*) TRIM(leading_text), ": ", TRIM(message_text)
+ lerror = .TRUE.
+ END SUBROUTINE error_callback
+
END PROGRAM example
diff --git a/src/libmtime.f90 b/src/libmtime.f90
index c777d023ff794b65c6b9aec9d9d974004d52eeca..7f546a515c832ae8bba51640e3d57d6035609c1d 100644
--- a/src/libmtime.f90
+++ b/src/libmtime.f90
@@ -3476,7 +3476,7 @@ contains
IF (ASSOCIATED(finish_message)) THEN
CALL finish_message(TRIM(leading_text), TRIM(message_text))
ELSE
- WRITE (0,*) TRIM(leading_text), TRIM(message_text)
+ WRITE (0,*) TRIM(leading_text), ": ", TRIM(message_text)
STOP
END IF
END SUBROUTINE finish_mtime_plain
@@ -3580,9 +3580,11 @@ module mtime
integer, parameter :: max_mtime_error_str_len = 132
!
!> @cond DOXYGEN_IGNORE_THIS
- integer, parameter :: no_error = 0, &
+ INTEGER, PARAMETER, PUBLIC :: no_error = 0, &
& calendar_calendartostring = 0*100 + 1, &
+
+ & general_arithmetic_error = 0*100 + 2, &
& julianday_newjulianday = 1*100 + 1, &
& julianday_juliandaytostring = 1*100 + 3, &
@@ -3649,6 +3651,9 @@ contains
select case (errno)
case (no_error)
error_message = 'no error'
+
+ case (general_arithmetic_error)
+ error_message = 'error in arithmetic operation'
case (calendar_calendartostring)
error_message = 'could not retrieve the string in <calendartostring>'
diff --git a/src/libmtime_hl.f90 b/src/libmtime_hl.f90
index 6abd56c9c603aad6666765d311e5fcdc2d1cea40..9c211076ca4d259ce3534f9efd87066e9c8f5b0f 100644
--- a/src/libmtime_hl.f90
+++ b/src/libmtime_hl.f90
@@ -347,6 +347,7 @@ contains
INTEGER :: errno
td_tmp => newtimedelta(td_string, errno)
CALL handle_errno(errno, __FILE__, __LINE__)
+ IF (.NOT. ASSOCIATED(td_tmp)) RETURN
t_timedelta_assign_string%td = td_tmp
t_timedelta_assign_string%td%sign = td_tmp%sign
call deallocatetimedelta(td_tmp)
@@ -423,10 +424,14 @@ contains
td_tmp => newtimedelta(this%td, errno)
CALL handle_errno(errno, __FILE__, __LINE__)
td_tmp2 = td_tmp * lambda
+ IF (ASSOCIATED(td_tmp2)) THEN
+ CALL handle_errno(general_arithmetic_error, __FILE__, __LINE__)
+ RETURN
+ END IF
scaled_td%td = td_tmp2
scaled_td%td%sign = td_tmp2%sign
- CALL deallocatetimedelta(td_tmp)
- CALL deallocatetimedelta(td_tmp2)
+ IF (ASSOCIATED(td_tmp)) CALL deallocatetimedelta(td_tmp)
+ IF (ASSOCIATED(td_tmp2)) CALL deallocatetimedelta(td_tmp2)
END FUNCTION t_timedelta_scalar_multiply_long
FUNCTION t_timedelta_scalar_multiply_inv_long(lambda, this) RESULT(scaled_td)
@@ -438,10 +443,14 @@ contains
td_tmp => newtimedelta(this%td, errno)
CALL handle_errno(errno, __FILE__, __LINE__)
td_tmp2 = td_tmp * lambda
+ IF (ASSOCIATED(td_tmp2)) THEN
+ CALL handle_errno(general_arithmetic_error, __FILE__, __LINE__)
+ RETURN
+ END IF
scaled_td%td = td_tmp2
scaled_td%td%sign = td_tmp2%sign
- CALL deallocatetimedelta(td_tmp)
- CALL deallocatetimedelta(td_tmp2)
+ IF (ASSOCIATED(td_tmp)) CALL deallocatetimedelta(td_tmp)
+ IF (ASSOCIATED(td_tmp2)) CALL deallocatetimedelta(td_tmp2)
END FUNCTION t_timedelta_scalar_multiply_inv_long
FUNCTION t_timedelta_scalar_multiply_int (this, lambda) RESULT(scaled_td)
@@ -453,10 +462,14 @@ contains
td_tmp => newtimedelta(this%td, errno)
CALL handle_errno(errno, __FILE__, __LINE__)
td_tmp2 = td_tmp * lambda
+ IF (ASSOCIATED(td_tmp2)) THEN
+ CALL handle_errno(general_arithmetic_error, __FILE__, __LINE__)
+ RETURN
+ END IF
scaled_td%td = td_tmp2
scaled_td%td%sign = td_tmp2%sign
- CALL deallocatetimedelta(td_tmp)
- CALL deallocatetimedelta(td_tmp2)
+ IF (ASSOCIATED(td_tmp)) CALL deallocatetimedelta(td_tmp)
+ IF (ASSOCIATED(td_tmp2)) CALL deallocatetimedelta(td_tmp2)
END FUNCTION t_timedelta_scalar_multiply_int
FUNCTION t_timedelta_scalar_multiply_inv_int(lambda, this) RESULT(scaled_td)
@@ -468,10 +481,14 @@ contains
td_tmp => newtimedelta(this%td, errno)
CALL handle_errno(errno, __FILE__, __LINE__)
td_tmp2 = td_tmp * lambda
+ IF (ASSOCIATED(td_tmp2)) THEN
+ CALL handle_errno(general_arithmetic_error, __FILE__, __LINE__)
+ RETURN
+ END IF
scaled_td%td = td_tmp2
scaled_td%td%sign = td_tmp2%sign
- CALL deallocatetimedelta(td_tmp)
- CALL deallocatetimedelta(td_tmp2)
+ IF (ASSOCIATED(td_tmp)) CALL deallocatetimedelta(td_tmp)
+ IF (ASSOCIATED(td_tmp2)) CALL deallocatetimedelta(td_tmp2)
END FUNCTION t_timedelta_scalar_multiply_inv_int
FUNCTION t_timedelta_scalar_multiply_real (this, lambda) RESULT(scaled_td)
@@ -483,10 +500,14 @@ contains
td_tmp => newtimedelta(this%td, errno)
CALL handle_errno(errno, __FILE__, __LINE__)
td_tmp2 = td_tmp * lambda
+ IF (ASSOCIATED(td_tmp2)) THEN
+ CALL handle_errno(general_arithmetic_error, __FILE__, __LINE__)
+ RETURN
+ END IF
scaled_td%td = td_tmp2
scaled_td%td%sign = td_tmp2%sign
- CALL deallocatetimedelta(td_tmp)
- CALL deallocatetimedelta(td_tmp2)
+ IF (ASSOCIATED(td_tmp)) CALL deallocatetimedelta(td_tmp)
+ IF (ASSOCIATED(td_tmp2)) CALL deallocatetimedelta(td_tmp2)
END FUNCTION t_timedelta_scalar_multiply_real
FUNCTION t_timedelta_scalar_multiply_inv_real(lambda, this) RESULT(scaled_td)
@@ -498,10 +519,14 @@ contains
td_tmp => newtimedelta(this%td, errno)
CALL handle_errno(errno, __FILE__, __LINE__)
td_tmp2 = td_tmp * lambda
+ IF (ASSOCIATED(td_tmp2)) THEN
+ CALL handle_errno(general_arithmetic_error, __FILE__, __LINE__)
+ RETURN
+ END IF
scaled_td%td = td_tmp2
scaled_td%td%sign = td_tmp2%sign
- CALL deallocatetimedelta(td_tmp)
- CALL deallocatetimedelta(td_tmp2)
+ IF (ASSOCIATED(td_tmp)) CALL deallocatetimedelta(td_tmp)
+ IF (ASSOCIATED(td_tmp2)) CALL deallocatetimedelta(td_tmp2)
END FUNCTION t_timedelta_scalar_multiply_inv_real