diff --git a/src/testdrive.F90 b/src/testdrive.F90 index 0ac587e..0cd6b83 100644 --- a/src/testdrive.F90 +++ b/src/testdrive.F90 @@ -113,7 +113,7 @@ module testdrive public :: unittest_type, testsuite_type, error_type public :: check, test_failed, skip_test public :: test_interface, collect_interface - public :: get_argument, get_variable + public :: get_argument, get_variable, to_string !> Single precision real numbers @@ -215,28 +215,28 @@ module testdrive end interface check - interface ch - module procedure :: integer_i1_to_char - module procedure :: integer_i2_to_char - module procedure :: integer_i4_to_char - module procedure :: integer_i8_to_char - module procedure :: real_sp_to_char - module procedure :: real_dp_to_char + interface to_string + module procedure :: integer_i1_to_string + module procedure :: integer_i2_to_string + module procedure :: integer_i4_to_string + module procedure :: integer_i8_to_string + module procedure :: real_sp_to_string + module procedure :: real_dp_to_string #if WITH_XDP - module procedure :: real_xdp_to_char + module procedure :: real_xdp_to_string #endif #if WITH_QP - module procedure :: real_qp_to_char + module procedure :: real_qp_to_string #endif - module procedure :: complex_sp_to_char - module procedure :: complex_dp_to_char + module procedure :: complex_sp_to_string + module procedure :: complex_dp_to_string #if WITH_XDP - module procedure :: complex_xdp_to_char + module procedure :: complex_xdp_to_string #endif #if WITH_QP - module procedure :: complex_qp_to_char + module procedure :: complex_qp_to_string #endif - end interface ch + end interface to_string !> Implementation of check for not a number value, in case a compiler does not @@ -663,14 +663,14 @@ subroutine check_float_dp(error, actual, expected, message, more, thr, rel) if (relative) then call test_failed(error, & "Floating point value missmatch", & - "expected "//ch(expected)//" but got "//ch(actual)//" "//& - "(difference: "//ch(int(diff*100))//"%)", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(int(diff*100))//"%)", & more) else call test_failed(error, & "Floating point value missmatch", & - "expected "//ch(expected)//" but got "//ch(actual)//" "//& - "(difference: "//ch(diff)//")", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(diff)//")", & more) end if end if @@ -758,14 +758,14 @@ subroutine check_float_sp(error, actual, expected, message, more, thr, rel) if (relative) then call test_failed(error, & "Floating point value missmatch", & - "expected "//ch(expected)//" but got "//ch(actual)//" "//& - "(difference: "//ch(int(diff*100))//"%)", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(int(diff*100))//"%)", & more) else call test_failed(error, & "Floating point value missmatch", & - "expected "//ch(expected)//" but got "//ch(actual)//" "//& - "(difference: "//ch(diff)//")", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(diff)//")", & more) end if end if @@ -854,14 +854,14 @@ subroutine check_float_xdp(error, actual, expected, message, more, thr, rel) if (relative) then call test_failed(error, & "Floating point value missmatch", & - "expected "//ch(expected)//" but got "//ch(actual)//" "//& - "(difference: "//ch(int(diff*100))//"%)", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(int(diff*100))//"%)", & more) else call test_failed(error, & "Floating point value missmatch", & - "expected "//ch(expected)//" but got "//ch(actual)//" "//& - "(difference: "//ch(diff)//")", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(diff)//")", & more) end if end if @@ -951,14 +951,14 @@ subroutine check_float_qp(error, actual, expected, message, more, thr, rel) if (relative) then call test_failed(error, & "Floating point value missmatch", & - "expected "//ch(expected)//" but got "//ch(actual)//" "//& - "(difference: "//ch(int(diff*100))//"%)", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(int(diff*100))//"%)", & more) else call test_failed(error, & "Floating point value missmatch", & - "expected "//ch(expected)//" but got "//ch(actual)//" "//& - "(difference: "//ch(diff)//")", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(diff)//")", & more) end if end if @@ -1047,14 +1047,14 @@ subroutine check_complex_dp(error, actual, expected, message, more, thr, rel) if (relative) then call test_failed(error, & "Floating point value missmatch", & - "expected "//ch(expected)//" but got "//ch(actual)//" "//& - "(difference: "//ch(int(diff*100))//"%)", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(int(diff*100))//"%)", & more) else call test_failed(error, & "Floating point value missmatch", & - "expected "//ch(expected)//" but got "//ch(actual)//" "//& - "(difference: "//ch(diff)//")", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(diff)//")", & more) end if end if @@ -1142,14 +1142,14 @@ subroutine check_complex_sp(error, actual, expected, message, more, thr, rel) if (relative) then call test_failed(error, & "Floating point value missmatch", & - "expected "//ch(expected)//" but got "//ch(actual)//" "//& - "(difference: "//ch(int(diff*100))//"%)", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(int(diff*100))//"%)", & more) else call test_failed(error, & "Floating point value missmatch", & - "expected "//ch(expected)//" but got "//ch(actual)//" "//& - "(difference: "//ch(diff)//")", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(diff)//")", & more) end if end if @@ -1238,14 +1238,14 @@ subroutine check_complex_xdp(error, actual, expected, message, more, thr, rel) if (relative) then call test_failed(error, & "Floating point value missmatch", & - "expected "//ch(expected)//" but got "//ch(actual)//" "//& - "(difference: "//ch(int(diff*100))//"%)", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(int(diff*100))//"%)", & more) else call test_failed(error, & "Floating point value missmatch", & - "expected "//ch(expected)//" but got "//ch(actual)//" "//& - "(difference: "//ch(diff)//")", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(diff)//")", & more) end if end if @@ -1335,14 +1335,14 @@ subroutine check_complex_qp(error, actual, expected, message, more, thr, rel) if (relative) then call test_failed(error, & "Floating point value missmatch", & - "expected "//ch(expected)//" but got "//ch(actual)//" "//& - "(difference: "//ch(int(diff*100))//"%)", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(int(diff*100))//"%)", & more) else call test_failed(error, & "Floating point value missmatch", & - "expected "//ch(expected)//" but got "//ch(actual)//" "//& - "(difference: "//ch(diff)//")", & + "expected "//to_string(expected)//" but got "//to_string(actual)//" "//& + "(difference: "//to_string(diff)//")", & more) end if end if @@ -1400,7 +1400,7 @@ subroutine check_int_i1(error, actual, expected, message, more) else call test_failed(error, & "Integer value missmatch", & - "expected "//ch(expected)//" but got "//ch(actual), & + "expected "//to_string(expected)//" but got "//to_string(actual), & more) end if end if @@ -1431,7 +1431,7 @@ subroutine check_int_i2(error, actual, expected, message, more) else call test_failed(error, & "Integer value missmatch", & - "expected "//ch(expected)//" but got "//ch(actual), & + "expected "//to_string(expected)//" but got "//to_string(actual), & more) end if end if @@ -1462,7 +1462,7 @@ subroutine check_int_i4(error, actual, expected, message, more) else call test_failed(error, & "Integer value missmatch", & - "expected "//ch(expected)//" but got "//ch(actual), & + "expected "//to_string(expected)//" but got "//to_string(actual), & more) end if end if @@ -1493,7 +1493,7 @@ subroutine check_int_i8(error, actual, expected, message, more) else call test_failed(error, & "Integer value missmatch", & - "expected "//ch(expected)//" but got "//ch(actual), & + "expected "//to_string(expected)//" but got "//to_string(actual), & more) end if end if @@ -1664,139 +1664,155 @@ subroutine get_variable(var, val) end subroutine get_variable - pure function integer_i1_to_char(val) result(string) - integer(i1), intent(in) :: val + pure function integer_i1_to_string(val) result(string) + integer, parameter :: ik = i1 + !> Integer value to create string from + integer(ik), intent(in) :: val + !> String representation of integer character(len=:), allocatable :: string + integer, parameter :: buffer_len = range(val)+2 character(len=buffer_len) :: buffer integer :: pos - integer(i1) :: n - character(len=1), parameter :: numbers(0:9) = & - ["0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] + integer(ik) :: n + character(len=1), parameter :: numbers(-9:0) = & + ["9", "8", "7", "6", "5", "4", "3", "2", "1", "0"] - if (val == 0_i1) then + if (val == 0_ik) then string = numbers(0) return end if - n = abs(val) + n = sign(val, -1_ik) buffer = "" - pos = buffer_len + 1 - do while (n > 0_i1) + do while (n < 0_ik) pos = pos - 1 - buffer(pos:pos) = numbers(mod(n, 10_i1)) - n = n/10_i1 + buffer(pos:pos) = numbers(mod(n, 10_ik)) + n = n/10_ik end do - if (val < 0_i1) then + + if (val < 0_ik) then pos = pos - 1 - buffer(pos:pos) = "-" + buffer(pos:pos) = '-' end if string = buffer(pos:) - end function integer_i1_to_char + end function integer_i1_to_string - pure function integer_i2_to_char(val) result(string) - integer(i2), intent(in) :: val + pure function integer_i2_to_string(val) result(string) + integer, parameter :: ik = i2 + !> Integer value to create string from + integer(ik), intent(in) :: val + !> String representation of integer character(len=:), allocatable :: string + integer, parameter :: buffer_len = range(val)+2 character(len=buffer_len) :: buffer integer :: pos - integer(i2) :: n - character(len=1), parameter :: numbers(0:9) = & - ["0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] + integer(ik) :: n + character(len=1), parameter :: numbers(-9:0) = & + ["9", "8", "7", "6", "5", "4", "3", "2", "1", "0"] - if (val == 0_i2) then + if (val == 0_ik) then string = numbers(0) return end if - n = abs(val) + n = sign(val, -1_ik) buffer = "" - pos = buffer_len + 1 - do while (n > 0_i2) + do while (n < 0_ik) pos = pos - 1 - buffer(pos:pos) = numbers(mod(n, 10_i2)) - n = n/10_i2 + buffer(pos:pos) = numbers(mod(n, 10_ik)) + n = n/10_ik end do - if (val < 0_i2) then + + if (val < 0_ik) then pos = pos - 1 - buffer(pos:pos) = "-" + buffer(pos:pos) = '-' end if string = buffer(pos:) - end function integer_i2_to_char + end function integer_i2_to_string - pure function integer_i4_to_char(val) result(string) - integer(i4), intent(in) :: val + pure function integer_i4_to_string(val) result(string) + integer, parameter :: ik = i4 + !> Integer value to create string from + integer(ik), intent(in) :: val + !> String representation of integer character(len=:), allocatable :: string + integer, parameter :: buffer_len = range(val)+2 character(len=buffer_len) :: buffer integer :: pos - integer(i4) :: n - character(len=1), parameter :: numbers(0:9) = & - ["0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] + integer(ik) :: n + character(len=1), parameter :: numbers(-9:0) = & + ["9", "8", "7", "6", "5", "4", "3", "2", "1", "0"] - if (val == 0_i4) then + if (val == 0_ik) then string = numbers(0) return end if - n = abs(val) + n = sign(val, -1_ik) buffer = "" - pos = buffer_len + 1 - do while (n > 0_i4) + do while (n < 0_ik) pos = pos - 1 - buffer(pos:pos) = numbers(mod(n, 10_i4)) - n = n/10_i4 + buffer(pos:pos) = numbers(mod(n, 10_ik)) + n = n/10_ik end do - if (val < 0_i4) then + + if (val < 0_ik) then pos = pos - 1 - buffer(pos:pos) = "-" + buffer(pos:pos) = '-' end if string = buffer(pos:) - end function integer_i4_to_char + end function integer_i4_to_string - pure function integer_i8_to_char(val) result(string) - integer(i8), intent(in) :: val + pure function integer_i8_to_string(val) result(string) + integer, parameter :: ik = i8 + !> Integer value to create string from + integer(ik), intent(in) :: val + !> String representation of integer character(len=:), allocatable :: string + integer, parameter :: buffer_len = range(val)+2 character(len=buffer_len) :: buffer integer :: pos - integer(i8) :: n - character(len=1), parameter :: numbers(0:9) = & - ["0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] + integer(ik) :: n + character(len=1), parameter :: numbers(-9:0) = & + ["9", "8", "7", "6", "5", "4", "3", "2", "1", "0"] - if (val == 0_i8) then + if (val == 0_ik) then string = numbers(0) return end if - n = abs(val) + n = sign(val, -1_ik) buffer = "" - pos = buffer_len + 1 - do while (n > 0_i8) + do while (n < 0_ik) pos = pos - 1 - buffer(pos:pos) = numbers(mod(n, 10_i8)) - n = n/10_i8 + buffer(pos:pos) = numbers(mod(n, 10_ik)) + n = n/10_ik end do - if (val < 0_i8) then + + if (val < 0_ik) then pos = pos - 1 - buffer(pos:pos) = "-" + buffer(pos:pos) = '-' end if string = buffer(pos:) - end function integer_i8_to_char + end function integer_i8_to_string - pure function real_sp_to_char(val) result(string) + pure function real_sp_to_string(val) result(string) real(sp), intent(in) :: val character(len=:), allocatable :: string integer, parameter :: buffer_len = 128 @@ -1805,10 +1821,10 @@ pure function real_sp_to_char(val) result(string) write(buffer, '(g0)') val string = trim(buffer) - end function real_sp_to_char + end function real_sp_to_string - pure function real_dp_to_char(val) result(string) + pure function real_dp_to_string(val) result(string) real(dp), intent(in) :: val character(len=:), allocatable :: string integer, parameter :: buffer_len = 128 @@ -1817,11 +1833,11 @@ pure function real_dp_to_char(val) result(string) write(buffer, '(g0)') val string = trim(buffer) - end function real_dp_to_char + end function real_dp_to_string #if WITH_XDP - pure function real_xdp_to_char(val) result(string) + pure function real_xdp_to_string(val) result(string) real(xdp), intent(in) :: val character(len=:), allocatable :: string integer, parameter :: buffer_len = 128 @@ -1830,12 +1846,12 @@ pure function real_xdp_to_char(val) result(string) write(buffer, '(g0)') val string = trim(buffer) - end function real_xdp_to_char + end function real_xdp_to_string #endif #if WITH_QP - pure function real_qp_to_char(val) result(string) + pure function real_qp_to_string(val) result(string) real(qp), intent(in) :: val character(len=:), allocatable :: string integer, parameter :: buffer_len = 128 @@ -1844,47 +1860,47 @@ pure function real_qp_to_char(val) result(string) write(buffer, '(g0)') val string = trim(buffer) - end function real_qp_to_char + end function real_qp_to_string #endif - pure function complex_sp_to_char(val) result(string) + pure function complex_sp_to_string(val) result(string) complex(sp), intent(in) :: val character(len=:), allocatable :: string - string = "("//ch(real(val))//", "//ch(aimag(val))//")" + string = "("//to_string(real(val))//", "//to_string(aimag(val))//")" - end function complex_sp_to_char + end function complex_sp_to_string - pure function complex_dp_to_char(val) result(string) + pure function complex_dp_to_string(val) result(string) complex(dp), intent(in) :: val character(len=:), allocatable :: string - string = "("//ch(real(val))//", "//ch(aimag(val))//")" + string = "("//to_string(real(val))//", "//to_string(aimag(val))//")" - end function complex_dp_to_char + end function complex_dp_to_string #if WITH_XDP - pure function complex_xdp_to_char(val) result(string) + pure function complex_xdp_to_string(val) result(string) complex(xdp), intent(in) :: val character(len=:), allocatable :: string - string = "("//ch(real(val))//", "//ch(aimag(val))//")" + string = "("//to_string(real(val))//", "//to_string(aimag(val))//")" - end function complex_xdp_to_char + end function complex_xdp_to_string #endif #if WITH_QP - pure function complex_qp_to_char(val) result(string) + pure function complex_qp_to_string(val) result(string) complex(qp), intent(in) :: val character(len=:), allocatable :: string - string = "("//ch(real(val))//", "//ch(aimag(val))//")" + string = "("//to_string(real(val))//", "//to_string(aimag(val))//")" - end function complex_qp_to_char + end function complex_qp_to_string #endif diff --git a/test/test_check.F90 b/test/test_check.F90 index 2bee139..fcf8245 100644 --- a/test/test_check.F90 +++ b/test/test_check.F90 @@ -23,7 +23,7 @@ module test_check use, intrinsic :: ieee_arithmetic, only : ieee_value, ieee_quiet_nan - use testdrive, only : new_unittest, unittest_type, error_type, check, skip_test + use testdrive, only : new_unittest, unittest_type, error_type, check, skip_test, to_string implicit none private @@ -157,7 +157,12 @@ subroutine collect_check(testsuite) new_unittest("character", test_char), & new_unittest("character-fail", test_char_fail, should_fail=.true.), & new_unittest("character-message", test_char_message, should_fail=.true.), & - new_unittest("character-with-more", test_char_with_more, should_fail=.true.) & + new_unittest("character-with-more", test_char_with_more, should_fail=.true.), & + new_unittest("character-with-more", test_char_with_more, should_fail=.true.), & + new_unittest("string-i1", test_string_i1), & + new_unittest("string-i2", test_string_i2), & + new_unittest("string-i4", test_string_i4), & + new_unittest("string-i8", test_string_i8) & ] end subroutine collect_check @@ -1480,4 +1485,40 @@ subroutine test_char_with_more(error) end subroutine test_char_with_more + subroutine test_string_i1(error) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + call check(error, to_string(-huge(1_i1) - 1_i1), "-128") + end subroutine test_string_i1 + + + subroutine test_string_i2(error) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + call check(error, to_string(-huge(1_i2) - 1_i2), "-32768") + end subroutine test_string_i2 + + + subroutine test_string_i4(error) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + call check(error, to_string(-huge(1_i4) - 1_i4), "-2147483648") + end subroutine test_string_i4 + + + subroutine test_string_i8(error) + + !> Error handling + type(error_type), allocatable, intent(out) :: error + + call check(error, to_string(-huge(1_i8) - 1_i8), "-9223372036854775808") + end subroutine test_string_i8 + + end module test_check