From 001ef27296792360ce46f81fd450a2d972450a74 Mon Sep 17 00:00:00 2001 From: Jose Alves Date: Thu, 2 Nov 2023 19:11:40 +0100 Subject: [PATCH] update interface str2num > to_num( ) using mold --- example/strings/example_str2num.f90 | 6 +- src/stdlib_str2num.f90 | 229 +++++++++++++------------- test/string/test_string_to_number.f90 | 36 ++-- 3 files changed, 142 insertions(+), 129 deletions(-) diff --git a/example/strings/example_str2num.f90 b/example/strings/example_str2num.f90 index 9e8d1a7b9..0d5203f25 100644 --- a/example/strings/example_str2num.f90 +++ b/example/strings/example_str2num.f90 @@ -8,13 +8,13 @@ program example_str2num chain = " 1.234 1.E1 1e0 0.1234E0 12.21e+001 -34.5E1" allocate( r(6), p(6) ) - !> Example for streamline conversion using `str2float_p` + !> Example for streamline conversion using `to_num_p` cptr => chain do i =1, 6 - r(i) = str2float_p( cptr ) !> the pointer is shifted within the function + r(i) = to_num_p( cptr , r(i) ) !> the pointer is shifted within the function end do read(chain,*) p - print *, "Reading with str2num" + print *, "Reading with to_num" print *, r print *, "Reading with formatted read" print *, p diff --git a/src/stdlib_str2num.f90 b/src/stdlib_str2num.f90 index 27df9ee37..869c56523 100644 --- a/src/stdlib_str2num.f90 +++ b/src/stdlib_str2num.f90 @@ -9,12 +9,7 @@ module stdlib_str2num use iso_fortran_env, only: int32, int64, sp => real32, dp => real64 implicit none private - !> easy to use function interfaces - public :: str2int, str2int_p - public :: str2float, str2float_p - public :: str2double, str2double_p - !> generic subroutine interface - public :: str2num + public :: to_num, to_num_p integer, parameter :: ikind = selected_int_kind(2) integer(kind=ikind), parameter :: digit_0 = ichar('0',kind=ikind) @@ -30,46 +25,119 @@ module stdlib_str2num integer(kind=ikind), parameter :: BD = ichar('D',kind=ikind) - digit_0 integer(kind=ikind), parameter :: LF = 10, CR = 13, WS = 32 - interface str2num - !> version: experimental - module procedure str2int_32 - module procedure str2real_sp - module procedure str2real_dp + interface to_num + module procedure to_int + module procedure to_float + module procedure to_double + end interface + + interface to_num_p + module procedure to_int_p + module procedure to_float_p + module procedure to_double_p + end interface + + interface to_num_base + module procedure to_int_32 + module procedure to_real_sp + module procedure to_real_dp end interface contains !--------------------------------------------- - ! String To Integer interfaces + ! String To Number interfaces !--------------------------------------------- - elemental function str2int(s) result(int) + function to_int(s,mold) result(v) ! -- In/out Variables character(*), intent(in) :: s !> input string - integer :: int !> Output integer 32 value + integer, intent(in) :: mold !> dummy argument to disambiguate at compile time the generic interface + integer :: v !> Output integer 32 value ! -- Internal Variables integer(1) :: p !> position within the number integer(1) :: stat !> error status !---------------------------------------------- - call str2num(s,int,p,stat) + call to_num_base(s,v,p,stat) + end function + + function to_int_p(s,mold,stat) result(v) + ! -- In/out Variables + character(len=:), pointer :: s !> input string + integer, intent(in) :: mold !> dummy argument to disambiguate at compile time the generic interface + integer :: v !> Output integer 32 value + integer(1),intent(inout), optional :: stat + ! -- Internal Variables + integer(1) :: p !> position within the number + integer(1) :: err + !---------------------------------------------- + call to_num_base(s,v,p,err) + p = min( p , len(s) ) + s => s(p:) + if(present(stat)) stat = err + end function + + function to_float(s,mold) result(r) + ! -- In/out Variables + character(*), intent(in) :: s !> input string + real(sp), intent(in) :: mold !> dummy argument to disambiguate at compile time the generic interface + real(sp) :: r !> Output real value + ! -- Internal Variables + integer(1) :: p !> position within the number + integer(1) :: stat ! error status + !---------------------------------------------- + call to_num_base(s,r,p,stat) end function - function str2int_p(s,stat) result(int) + function to_float_p(s,mold,stat) result(r) ! -- In/out Variables character(len=:), pointer :: s !> input string - integer :: int !> Output integer 32 value + real(sp), intent(in) :: mold !> dummy argument to disambiguate at compile time the generic interface + real(sp) :: r !> Output real value integer(1),intent(inout), optional :: stat ! -- Internal Variables integer(1) :: p !> position within the number integer(1) :: err !---------------------------------------------- - call str2num(s,int,p,err) + call to_num_base(s,r,p,err) p = min( p , len(s) ) s => s(p:) if(present(stat)) stat = err end function - elemental subroutine str2int_32(s,v,p,stat) + function to_double(s,mold) result(r) + ! -- In/out Variables + character(*), intent(in) :: s !> input string + real(dp), intent(in) :: mold !> dummy argument to disambiguate at compile time the generic interface + real(dp) :: r !> Output real value + ! -- Internal Variables + integer(1) :: p !> position within the number + integer(1) :: stat ! error status + !---------------------------------------------- + call to_num_base(s,r,p,stat) + end function + + function to_double_p(s,mold,stat) result(r) + ! -- In/out Variables + character(len=:), pointer :: s !> input string + real(dp), intent(in) :: mold !> dummy argument to disambiguate at compile time the generic interface + real(dp) :: r !> Output real value + integer(1),intent(inout), optional :: stat + ! -- Internal Variables + integer(1) :: p !> position within the number + integer(1) :: err + !---------------------------------------------- + call to_num_base(s,r,p,err) + p = min( p , len(s) ) + s => s(p:) + if(present(stat)) stat = err + end function + + !--------------------------------------------- + ! String To Number Implementations + !--------------------------------------------- + + subroutine to_int_32(s,v,p,stat) !> Return an unsigned 32-bit integer ! -- In/out Variables character(*), intent(in) :: s !> input string @@ -95,38 +163,8 @@ elemental subroutine str2int_32(s,v,p,stat) end do stat = 0 end subroutine - - !--------------------------------------------- - ! String To Real function interfaces - !--------------------------------------------- - - elemental function str2float(s) result(r) - ! -- In/out Variables - character(*), intent(in) :: s !> input string - real(sp) :: r !> Output real value - ! -- Internal Variables - integer(1) :: p !> position within the number - integer(1) :: stat ! error status - !---------------------------------------------- - call str2num(s,r,p,stat) - end function - - function str2float_p(s,stat) result(r) - ! -- In/out Variables - character(len=:), pointer :: s !> input string - real(sp) :: r !> Output real value - integer(1),intent(inout), optional :: stat - ! -- Internal Variables - integer(1) :: p !> position within the number - integer(1) :: err - !---------------------------------------------- - call str2num(s,r,p,err) - p = min( p , len(s) ) - s => s(p:) - if(present(stat)) stat = err - end function - elemental subroutine str2real_sp(s,v,p,stat) + subroutine to_real_sp(s,v,p,stat) integer, parameter :: wp = sp !> Sequentially unroll the character and get the sub integers composing the whole number, fraction and exponent ! -- In/out Variables @@ -138,24 +176,16 @@ elemental subroutine str2real_sp(s,v,p,stat) ! -- Internal Variables real(sp), parameter :: rnan = transfer(int(B'01111111101000000000000000000000',int32), 1._sp) integer(kind=ikind), parameter :: nwnb = 39 !> number of whole number factors - integer(kind=ikind), parameter :: nfnb = 40 !> number of fractional number factors - real(wp), parameter :: whole_number_base(nwnb) = & - [ 1e38, 1e37, 1e36, 1e35, 1e34, 1e33, 1e32, & - 1e31, 1e30, 1e29, 1e28, 1e27, 1e26, 1e25, 1e24, & - 1e23, 1e22, 1e21, 1e20, 1e19, 1e18, 1e17, 1e16, & - 1e15, 1e14, 1e13, 1e12, 1e11, 1e10, 1e9, 1e8, & - 1e7, 1e6, 1e5, 1e4, 1e3, 1e2, 1e1, 1e0] - real(wp), parameter :: fractional_base(nfnb) = & - [1e-1, 1e-2, 1e-3, 1e-4, 1e-5, 1e-6, 1e-7, 1e-8, & - 1e-9, 1e-10, 1e-11, 1e-12, 1e-13, 1e-14, 1e-15, 1e-16, & - 1e-17, 1e-18, 1e-19, 1e-20, 1e-21, 1e-22, 1e-23, 1e-24, & - 1e-25, 1e-26, 1e-27, 1e-28, 1e-29, 1e-30, 1e-31, 1e-32, & - 1e-33, 1e-34, 1e-35, 1e-36, 1e-37, 1e-38, 1e-39, 1e-40 ] + integer(kind=ikind), parameter :: nfnb = 37 !> number of fractional number factors + integer :: e + real(wp), parameter :: whole_number_base(nwnb) = [(10._wp**(nwnb-e),e=1,nwnb)] + real(wp), parameter :: fractional_base(nfnb) = [(10._wp**(-e),e=1,nfnb)] real(wp), parameter :: expbase(nwnb+nfnb) = [whole_number_base, fractional_base] integer(1) :: sign, sige !> sign of integer number and exponential integer(wp) :: int_wp !> long integer to capture fractional part integer :: i_exp !> integer to capture whole number part + integer :: exp_aux integer(1) :: i, pP, pE, val , resp !---------------------------------------------- stat = 23 !> initialize error status with any number > 0 @@ -218,42 +248,19 @@ elemental subroutine str2real_sp(s,v,p,stat) exit end if end do - - v = sign*int_wp*expbase(nwnb-1+resp-sige*max(0,i_exp)) + + exp_aux = nwnb-1+resp-sige*max(0,i_exp) + if( exp_aux>0 .and. exp_aux<=nwnb+nfnb) then + v = sign*int_wp*expbase(exp_aux) + else if(exp_aux>nwnb+nfnb) then + v = sign*int_wp*fractional_base(exp_aux-(nwnb+nfnb))*expbase(nwnb+nfnb) + else + v = sign*int_wp*10._wp**(sige*max(0,i_exp)-resp) + end if stat = 0 end subroutine - !--------------------------------------------- - ! String To Double function interfaces - !--------------------------------------------- - - elemental function str2double(s) result(r) - ! -- In/out Variables - character(*), intent(in) :: s !> input string - real(dp) :: r !> Output real value - ! -- Internal Variables - integer(1) :: p !> position within the number - integer(1) :: stat ! error status - !---------------------------------------------- - call str2num(s,r,p,stat) - end function - - function str2double_p(s,stat) result(r) - ! -- In/out Variables - character(len=:), pointer :: s !> input string - real(dp) :: r !> Output real value - integer(1),intent(inout), optional :: stat - ! -- Internal Variables - integer(1) :: p !> position within the number - integer(1) :: err - !---------------------------------------------- - call str2num(s,r,p,err) - p = min( p , len(s) ) - s => s(p:) - if(present(stat)) stat = err - end function - - elemental subroutine str2real_dp(s,v,p,stat) + subroutine to_real_dp(s,v,p,stat) integer, parameter :: wp = dp !> Sequentially unroll the character and get the sub integers composing the whole number, fraction and exponent ! -- In/out Variables @@ -265,25 +272,16 @@ elemental subroutine str2real_dp(s,v,p,stat) ! -- Internal Variables real(dp), parameter :: rNaN = TRANSFER(9218868437227405313_int64, 1._dp) integer(kind=ikind), parameter :: nwnb = 40 !> number of whole number factors - integer(kind=ikind), parameter :: nfnb = 40 !> number of fractional number factors - real(wp), parameter :: whole_number_base(nwnb) = & - [1d39, 1d38, 1d37, 1d36, 1d35, 1d34, 1d33, 1d32, & - 1d31, 1d30, 1d29, 1d28, 1d27, 1d26, 1d25, 1d24, & - 1d23, 1d22, 1d21, 1d20, 1d19, 1d18, 1d17, 1d16, & - 1d15, 1d14, 1d13, 1d12, 1d11, 1d10, 1d9, 1d8, & - 1d7, 1d6, 1d5, 1d4, 1d3, 1d2, 1d1, 1d0] - real(wp), parameter :: fractional_base(nfnb) = & - [1d-1, 1d-2, 1d-3, 1d-4, 1d-5, 1d-6, 1d-7, 1d-8, & - 1d-9, 1d-10, 1d-11, 1d-12, 1d-13, 1d-14, 1d-15, 1d-16, & - 1d-17, 1d-18, 1d-19, 1d-20, 1d-21, 1d-22, 1d-23, 1d-24, & - 1d-25, 1d-26, 1d-27, 1d-28, 1d-29, 1d-30, 1d-31, 1d-32, & - 1d-33, 1d-34, 1d-35, 1d-36, 1d-37, 1d-38, 1d-39, 1d-40 ] - real(wp), parameter :: period_skip = 0d0 + integer(kind=ikind), parameter :: nfnb = 64 !> number of fractional number factors + integer :: e + real(wp), parameter :: whole_number_base(nwnb) = [(10._wp**(nwnb-e),e=1,nwnb)] + real(wp), parameter :: fractional_base(nfnb) = [(10._wp**(-e),e=1,nfnb)] real(wp), parameter :: expbase(nwnb+nfnb) = [whole_number_base, fractional_base] integer(1) :: sign, sige !> sign of integer number and exponential integer(wp) :: int_wp !> long integer to capture fractional part integer :: i_exp !> integer to capture whole number part + integer :: exp_aux integer(1) :: i, pP, pE, val , resp !---------------------------------------------- stat = 23 !> initialize error status with any number > 0 @@ -346,8 +344,15 @@ elemental subroutine str2real_dp(s,v,p,stat) exit end if end do - - v = sign*int_wp*expbase(nwnb-1+resp-sige*max(0,i_exp)) + + exp_aux = nwnb-1+resp-sige*max(0,i_exp) + if( exp_aux>0 .and. exp_aux<=nwnb+nfnb) then + v = sign*int_wp*expbase(exp_aux) + else if(exp_aux>nwnb+nfnb) then + v = sign*int_wp*fractional_base(exp_aux-(nwnb+nfnb))*expbase(nwnb+nfnb) + else + v = sign*int_wp*10._wp**(sige*max(0,i_exp)-resp) + end if stat = 0 end subroutine diff --git a/test/string/test_string_to_number.f90 b/test/string/test_string_to_number.f90 index be241fa8c..cf4156c66 100644 --- a/test/string/test_string_to_number.f90 +++ b/test/string/test_string_to_number.f90 @@ -12,13 +12,13 @@ subroutine collect_string_to_number(testsuite) type(unittest_type), allocatable, intent(out) :: testsuite(:) testsuite = [ & - new_unittest("str2float", test_str2float), & - new_unittest("str2double", test_str2double) & + new_unittest("to_float", test_to_float), & + new_unittest("to_double", test_to_double) & ] end subroutine collect_string_to_number - subroutine test_str2float(error) - use stdlib_str2num, only: str2real => str2float + subroutine test_to_float(error) + use stdlib_str2num type(error_type), allocatable, intent(out) :: error integer, parameter :: wp = sp @@ -88,23 +88,27 @@ subroutine test_str2float(error) call check(error, ucheck("123456.78901234567890123456789012345678901234567890+2") ) if (allocated(error)) return + call check(error, ucheck("0.140129846432481707092372958328991613128026194187651577"//& + & "175706828388979108268586060148663818836212158203125E-44")) + if (allocated(error)) return + contains logical function ucheck(s) character(*), intent(in) :: s real(wp) :: formatted_read_out - real(wp) :: str2real_out + real(wp) :: to_num_out real(wp) :: abs_err real(wp) :: rel_err ucheck = .true. read(s,*) formatted_read_out - str2real_out = str2real(s) - abs_err = str2real_out - formatted_read_out + to_num_out = to_num(s, to_num_out) + abs_err = to_num_out - formatted_read_out rel_err = abs_err / formatted_read_out if(abs(rel_err) > 10*epsilon(0.0_wp)) then write(*,"('formatted read : ' g0)") formatted_read_out - write(*,"('str2real : ' g0)") str2real_out + write(*,"('to_num : ' g0)") to_num_out write(*,"('difference abs : ' g0)") abs_err write(*,"('difference rel : ' g0 '%')") rel_err * 100 ucheck = .false. @@ -112,8 +116,8 @@ logical function ucheck(s) end function end subroutine - subroutine test_str2double(error) - use stdlib_str2num, only: str2real => str2double + subroutine test_to_double(error) + use stdlib_str2num type(error_type), allocatable, intent(out) :: error integer, parameter :: wp = dp @@ -183,23 +187,27 @@ subroutine test_str2double(error) call check(error, ucheck("123456.78901234567890123456789012345678901234567890+2") ) if (allocated(error)) return + call check(error, ucheck("0.140129846432481707092372958328991613128026194187651577"//& + & "175706828388979108268586060148663818836212158203125E-44")) + if (allocated(error)) return + contains logical function ucheck(s) character(*), intent(in) :: s real(wp) :: formatted_read_out - real(wp) :: str2real_out + real(wp) :: to_num_out real(wp) :: abs_err real(wp) :: rel_err ucheck = .true. read(s,*) formatted_read_out - str2real_out = str2real(s) - abs_err = str2real_out - formatted_read_out + to_num_out = to_num(s, to_num_out) + abs_err = to_num_out - formatted_read_out rel_err = abs_err / formatted_read_out if(abs(rel_err) > 10*epsilon(0.0_wp)) then write(*,"('formatted read : ' g0)") formatted_read_out - write(*,"('str2real : ' g0)") str2real_out + write(*,"('to_num : ' g0)") to_num_out write(*,"('difference abs : ' g0)") abs_err write(*,"('difference rel : ' g0 '%')") rel_err * 100 ucheck = .false.