From c6562cdc95320e517b6f3dcb381c1b93d7e34f53 Mon Sep 17 00:00:00 2001 From: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> Date: Wed, 20 Jul 2022 20:26:59 +0200 Subject: [PATCH 1/3] Fix overflow for huge negative integers --- src/testdrive.F90 | 294 +++++++++++++++++++++++++------------------- test/test_check.F90 | 45 ++++++- 2 files changed, 210 insertions(+), 129 deletions(-) diff --git a/src/testdrive.F90 b/src/testdrive.F90 index 0ac587e..35811ff 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,179 @@ 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 + integer(ik) :: n character(len=1), parameter :: numbers(0:9) = & ["0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] - if (val == 0_i1) then + if (val == 0_ik) then string = numbers(0) return end if - n = abs(val) + n = val buffer = "" - pos = buffer_len + 1 - do while (n > 0_i1) - pos = pos - 1 - buffer(pos:pos) = numbers(mod(n, 10_i1)) - n = n/10_i1 - end do - if (val < 0_i1) then + if (val < 0_ik) then + do while (n < 0_ik) + pos = pos - 1 + buffer(pos:pos) = numbers(abs(mod(n, 10_ik))) + n = n/10_ik + end do + pos = pos - 1 - buffer(pos:pos) = "-" + buffer(pos:pos) = '-' + else + do while (n > 0_ik) + pos = pos - 1 + buffer(pos:pos) = numbers(mod(n, 10_ik)) + n = n/10_ik + end do 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 + integer(ik) :: n character(len=1), parameter :: numbers(0:9) = & ["0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] - if (val == 0_i2) then + if (val == 0_ik) then string = numbers(0) return end if - n = abs(val) + n = val buffer = "" - pos = buffer_len + 1 - do while (n > 0_i2) - pos = pos - 1 - buffer(pos:pos) = numbers(mod(n, 10_i2)) - n = n/10_i2 - end do - if (val < 0_i2) then + if (val < 0_ik) then + do while (n < 0_ik) + pos = pos - 1 + buffer(pos:pos) = numbers(abs(mod(n, 10_ik))) + n = n/10_ik + end do + pos = pos - 1 - buffer(pos:pos) = "-" + buffer(pos:pos) = '-' + else + do while (n > 0_ik) + pos = pos - 1 + buffer(pos:pos) = numbers(mod(n, 10_ik)) + n = n/10_ik + end do 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 + integer(ik) :: n character(len=1), parameter :: numbers(0:9) = & ["0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] - if (val == 0_i4) then + if (val == 0_ik) then string = numbers(0) return end if - n = abs(val) + n = val buffer = "" - pos = buffer_len + 1 - do while (n > 0_i4) - pos = pos - 1 - buffer(pos:pos) = numbers(mod(n, 10_i4)) - n = n/10_i4 - end do - if (val < 0_i4) then + if (val < 0_ik) then + do while (n < 0_ik) + pos = pos - 1 + buffer(pos:pos) = numbers(abs(mod(n, 10_ik))) + n = n/10_ik + end do + pos = pos - 1 - buffer(pos:pos) = "-" + buffer(pos:pos) = '-' + else + do while (n > 0_ik) + pos = pos - 1 + buffer(pos:pos) = numbers(mod(n, 10_ik)) + n = n/10_ik + end do 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 + integer(ik) :: n character(len=1), parameter :: numbers(0:9) = & ["0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] - if (val == 0_i8) then + if (val == 0_ik) then string = numbers(0) return end if - n = abs(val) + n = val buffer = "" - pos = buffer_len + 1 - do while (n > 0_i8) - pos = pos - 1 - buffer(pos:pos) = numbers(mod(n, 10_i8)) - n = n/10_i8 - end do - if (val < 0_i8) then + if (val < 0_ik) then + do while (n < 0_ik) + pos = pos - 1 + buffer(pos:pos) = numbers(abs(mod(n, 10_ik))) + n = n/10_ik + end do + pos = pos - 1 - buffer(pos:pos) = "-" + buffer(pos:pos) = '-' + else + do while (n > 0_ik) + pos = pos - 1 + buffer(pos:pos) = numbers(mod(n, 10_ik)) + n = n/10_ik + end do 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 +1845,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 +1857,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 +1870,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 +1884,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..3ccab1d 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(-128_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(-32768_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(-2147483648_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(-9223372036854775808_i8), "-9223372036854775808") + end subroutine test_string_i8 + + end module test_check From 75d36b2ec326aeaa2a93a27aacc4bc0c3b40b724 Mon Sep 17 00:00:00 2001 From: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> Date: Wed, 20 Jul 2022 20:39:46 +0200 Subject: [PATCH 2/3] Fix overflow --- test/test_check.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/test/test_check.F90 b/test/test_check.F90 index 3ccab1d..fcf8245 100644 --- a/test/test_check.F90 +++ b/test/test_check.F90 @@ -1490,7 +1490,7 @@ subroutine test_string_i1(error) !> Error handling type(error_type), allocatable, intent(out) :: error - call check(error, to_string(-128_i1), "-128") + call check(error, to_string(-huge(1_i1) - 1_i1), "-128") end subroutine test_string_i1 @@ -1499,7 +1499,7 @@ subroutine test_string_i2(error) !> Error handling type(error_type), allocatable, intent(out) :: error - call check(error, to_string(-32768_i2), "-32768") + call check(error, to_string(-huge(1_i2) - 1_i2), "-32768") end subroutine test_string_i2 @@ -1508,7 +1508,7 @@ subroutine test_string_i4(error) !> Error handling type(error_type), allocatable, intent(out) :: error - call check(error, to_string(-2147483648_i4), "-2147483648") + call check(error, to_string(-huge(1_i4) - 1_i4), "-2147483648") end subroutine test_string_i4 @@ -1517,7 +1517,7 @@ subroutine test_string_i8(error) !> Error handling type(error_type), allocatable, intent(out) :: error - call check(error, to_string(-9223372036854775808_i8), "-9223372036854775808") + call check(error, to_string(-huge(1_i8) - 1_i8), "-9223372036854775808") end subroutine test_string_i8 From e722cb13baa99d89d5e82ca7f1df34c184ff1179 Mon Sep 17 00:00:00 2001 From: Sebastian Ehlert <28669218+awvwgk@users.noreply.github.com> Date: Thu, 21 Jul 2022 10:36:39 +0200 Subject: [PATCH 3/3] Simplify to_string for integers --- src/testdrive.F90 | 96 ++++++++++++++++++----------------------------- 1 file changed, 36 insertions(+), 60 deletions(-) diff --git a/src/testdrive.F90 b/src/testdrive.F90 index 35811ff..0cd6b83 100644 --- a/src/testdrive.F90 +++ b/src/testdrive.F90 @@ -1675,32 +1675,26 @@ pure function integer_i1_to_string(val) result(string) character(len=buffer_len) :: buffer integer :: pos integer(ik) :: n - character(len=1), parameter :: numbers(0:9) = & - ["0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] + character(len=1), parameter :: numbers(-9:0) = & + ["9", "8", "7", "6", "5", "4", "3", "2", "1", "0"] if (val == 0_ik) then string = numbers(0) return end if - n = val + n = sign(val, -1_ik) buffer = "" pos = buffer_len + 1 - if (val < 0_ik) then - do while (n < 0_ik) - pos = pos - 1 - buffer(pos:pos) = numbers(abs(mod(n, 10_ik))) - n = n/10_ik - end do + do while (n < 0_ik) + pos = pos - 1 + buffer(pos:pos) = numbers(mod(n, 10_ik)) + n = n/10_ik + end do + if (val < 0_ik) then pos = pos - 1 buffer(pos:pos) = '-' - else - do while (n > 0_ik) - pos = pos - 1 - buffer(pos:pos) = numbers(mod(n, 10_ik)) - n = n/10_ik - end do end if string = buffer(pos:) @@ -1718,32 +1712,26 @@ pure function integer_i2_to_string(val) result(string) character(len=buffer_len) :: buffer integer :: pos integer(ik) :: n - character(len=1), parameter :: numbers(0:9) = & - ["0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] + character(len=1), parameter :: numbers(-9:0) = & + ["9", "8", "7", "6", "5", "4", "3", "2", "1", "0"] if (val == 0_ik) then string = numbers(0) return end if - n = val + n = sign(val, -1_ik) buffer = "" pos = buffer_len + 1 - if (val < 0_ik) then - do while (n < 0_ik) - pos = pos - 1 - buffer(pos:pos) = numbers(abs(mod(n, 10_ik))) - n = n/10_ik - end do + do while (n < 0_ik) + pos = pos - 1 + buffer(pos:pos) = numbers(mod(n, 10_ik)) + n = n/10_ik + end do + if (val < 0_ik) then pos = pos - 1 buffer(pos:pos) = '-' - else - do while (n > 0_ik) - pos = pos - 1 - buffer(pos:pos) = numbers(mod(n, 10_ik)) - n = n/10_ik - end do end if string = buffer(pos:) @@ -1761,32 +1749,26 @@ pure function integer_i4_to_string(val) result(string) character(len=buffer_len) :: buffer integer :: pos integer(ik) :: n - character(len=1), parameter :: numbers(0:9) = & - ["0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] + character(len=1), parameter :: numbers(-9:0) = & + ["9", "8", "7", "6", "5", "4", "3", "2", "1", "0"] if (val == 0_ik) then string = numbers(0) return end if - n = val + n = sign(val, -1_ik) buffer = "" pos = buffer_len + 1 - if (val < 0_ik) then - do while (n < 0_ik) - pos = pos - 1 - buffer(pos:pos) = numbers(abs(mod(n, 10_ik))) - n = n/10_ik - end do + do while (n < 0_ik) + pos = pos - 1 + buffer(pos:pos) = numbers(mod(n, 10_ik)) + n = n/10_ik + end do + if (val < 0_ik) then pos = pos - 1 buffer(pos:pos) = '-' - else - do while (n > 0_ik) - pos = pos - 1 - buffer(pos:pos) = numbers(mod(n, 10_ik)) - n = n/10_ik - end do end if string = buffer(pos:) @@ -1804,32 +1786,26 @@ pure function integer_i8_to_string(val) result(string) character(len=buffer_len) :: buffer integer :: pos integer(ik) :: n - character(len=1), parameter :: numbers(0:9) = & - ["0", "1", "2", "3", "4", "5", "6", "7", "8", "9"] + character(len=1), parameter :: numbers(-9:0) = & + ["9", "8", "7", "6", "5", "4", "3", "2", "1", "0"] if (val == 0_ik) then string = numbers(0) return end if - n = val + n = sign(val, -1_ik) buffer = "" pos = buffer_len + 1 - if (val < 0_ik) then - do while (n < 0_ik) - pos = pos - 1 - buffer(pos:pos) = numbers(abs(mod(n, 10_ik))) - n = n/10_ik - end do + do while (n < 0_ik) + pos = pos - 1 + buffer(pos:pos) = numbers(mod(n, 10_ik)) + n = n/10_ik + end do + if (val < 0_ik) then pos = pos - 1 buffer(pos:pos) = '-' - else - do while (n > 0_ik) - pos = pos - 1 - buffer(pos:pos) = numbers(mod(n, 10_ik)) - n = n/10_ik - end do end if string = buffer(pos:)