diff --git a/ci/fpm-deployment.sh b/ci/fpm-deployment.sh
index fd81d1258..8cc1b245c 100644
--- a/ci/fpm-deployment.sh
+++ b/ci/fpm-deployment.sh
@@ -9,7 +9,8 @@ destdir="${DESTDIR:-stdlib-fpm}"
fypp="${FYPP:-$(which fypp)}"
# Arguments for the fypp preprocessor
-fyflags="${FYFLAGS:--DMAXRANK=4}"
+maxrank=4
+fyflags="${FYFLAGS:--DMAXRANK=$maxrank}"
# Number of parallel jobs for preprocessing
if [ $(uname) = "Darwin" ]; then
@@ -44,6 +45,12 @@ mkdir -p "$destdir/src" "$destdir/test" "$destdir/example"
find src -maxdepth 1 -iname "*.fypp" \
| cut -f1 -d. | xargs -P "$njob" -I{} "$fypp" "{}.fypp" "$destdir/{}.f90" $fyflags
+find test -name "test_*.fypp" -exec cp {} "$destdir/test/" \;
+fyflags="${fyflags} -I src"
+find $destdir/test -maxdepth 1 -iname "*.fypp" \
+ | cut -f1 -d. | xargs -P "$njob" -I{} "$fypp" "{}.fypp" "{}.f90" $fyflags
+find $destdir/test -name "test_*.fypp" -exec rm {} \;
+
# Collect stdlib source files
find src -maxdepth 1 -iname "*.f90" -exec cp {} "$destdir/src/" \;
find test -name "test_*.f90" -exec cp {} "$destdir/test/" \;
diff --git a/doc/specs/stdlib_str2num.md b/doc/specs/stdlib_str2num.md
new file mode 100644
index 000000000..47b783cc5
--- /dev/null
+++ b/doc/specs/stdlib_str2num.md
@@ -0,0 +1,82 @@
+---
+title: str2num
+---
+
+# The `stdlib_str2num` module
+
+This module proposes a function-style interface for string-to-number conversion. It also profits from Fortran's interfaces to implement precision-dependant algorithms to maximize runtime efficiency.
+
+[TOC]
+
+## `to_num` - conversion of strings to numbers
+
+### Status
+
+Experimental
+
+### Description
+
+Convert a string or an array of strings to numerical types.
+
+### Syntax
+
+`number = [[stdlib_str2num(module):to_num(interface)]](string, mold)`
+
+### Arguments
+
+`string`: argument has `intent(in)` and is of type `character(*)`.
+
+`mold`: argument has `intent(in)` and is of numerical type (that is of `integer` or of `real`). **Note**: The type of the `mold` argument defines the type of the result.
+
+### Return value
+
+Return a scalar of numerical type (i.e., `integer`, or `real`).
+
+### Example
+
+```fortran
+{!example/strings/example_string_to_number.f90!}
+```
+
+## `to_num_from_stream` - conversion of a stream of values in a string to numbers
+
+### Status
+
+Experimental
+
+### Description
+
+Convert a stream of values in a string to an array of values.
+
+### Syntax
+
+`number = [[stdlib_str2num(module):to_num_from_stream(interface)]](string, mold)`
+
+### Arguments
+
+`string`: argument has `intent(in)` and is of type `character(:), pointer`.
+
+`mold`: argument has `intent(in)` and is of numerical type (currently of `integer` or `real`). **Note**: The type of the `mold` argument defines the type of the result.
+
+### Return value
+
+Return a scalar of numerical type (i.e., `integer` or `real`).
+
+### Example
+
+```fortran
+{!example/strings/example_stream_of_strings_to_numbers.f90!}
+```
+
+## Note
+The accuracy of the conversion is implementation dependent; it is recommended that implementers guarantee precision down to the last 3 bits.
+
+**The current implementation has been tested to provide for** :
+
+`sp` : exact match
+
+`dp` : precision up-to epsilon(0.0_dp)
+
+`qp` : precision around 200*epsilon(0.0_qp)
+
+Where precision refers to the relative difference between `to_num` and `read`. On the other hand, `to_num` provides speed-ups ranging from 4x to >10x compared to the intrinsic `read`.
diff --git a/example/strings/CMakeLists.txt b/example/strings/CMakeLists.txt
index 086140bcb..cbaf4f0f3 100644
--- a/example/strings/CMakeLists.txt
+++ b/example/strings/CMakeLists.txt
@@ -10,3 +10,5 @@ ADD_EXAMPLE(starts_with)
ADD_EXAMPLE(strip)
ADD_EXAMPLE(to_string)
ADD_EXAMPLE(zfill)
+ADD_EXAMPLE(string_to_number)
+ADD_EXAMPLE(stream_of_strings_to_numbers)
\ No newline at end of file
diff --git a/example/strings/example_stream_of_strings_to_numbers.f90 b/example/strings/example_stream_of_strings_to_numbers.f90
new file mode 100644
index 000000000..40845beab
--- /dev/null
+++ b/example/strings/example_stream_of_strings_to_numbers.f90
@@ -0,0 +1,22 @@
+program example_stream_of_strings_to_numbers
+ use stdlib_kinds, only: dp
+ use stdlib_str2num, only: to_num_from_stream
+ character(:), allocatable, target :: chain
+ character(len=:), pointer :: cptr
+ real(dp), allocatable :: r(:), p(:)
+ integer :: i
+
+ chain = " 1.234 1.E1 1e0 0.1234E0 12.21e+001 -34.5E1"
+ allocate( r(6), p(6) )
+ !> Example for streamline conversion using `to_num_from_stream`
+ cptr => chain
+ do i =1, 6
+ r(i) = to_num_from_stream( cptr , r(i) ) !> the pointer is shifted within the function
+ end do
+ read(chain,*) p
+ print *, "Reading with to_num_from_stream"
+ print *, r
+ print *, "Reading with formatted read"
+ print *, p
+
+end program example_stream_of_strings_to_numbers
\ No newline at end of file
diff --git a/example/strings/example_string_to_number.f90 b/example/strings/example_string_to_number.f90
new file mode 100644
index 000000000..4781a9c6e
--- /dev/null
+++ b/example/strings/example_string_to_number.f90
@@ -0,0 +1,10 @@
+program example_string_to_number
+ use stdlib_kinds, only: dp
+ use stdlib_str2num, only: to_num
+ implicit none
+ character(:), allocatable :: txt
+ real(dp) :: x
+
+ txt = ' 8.8541878128e−12 '
+ x = to_num( txt , x )
+ end program example_string_to_number
\ No newline at end of file
diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt
index 8a6fe66cc..0c2f76c8d 100644
--- a/src/CMakeLists.txt
+++ b/src/CMakeLists.txt
@@ -55,6 +55,7 @@ set(fppFiles
stdlib_math_is_close.fypp
stdlib_math_all_close.fypp
stdlib_math_diff.fypp
+ stdlib_str2num.fypp
stdlib_string_type.fypp
stdlib_string_type_constructor.fypp
stdlib_strings_to_string.fypp
diff --git a/src/stdlib_str2num.fypp b/src/stdlib_str2num.fypp
new file mode 100644
index 000000000..d7deac90c
--- /dev/null
+++ b/src/stdlib_str2num.fypp
@@ -0,0 +1,594 @@
+#:include "common.fypp"
+!> The `stdlib_str2num` module provides procedures and interfaces for conversion
+!> of characters to numerical types. Currently supported: `integer` and `real`.
+!! ([Specification](../page/specs/stdlib_str2num.html)
+!>
+!> This code was modified from https://github.com/jalvesz/Fortran-String-to-Num by Alves Jose
+!> And was possible thanks to all the discussions in this thread https://fortran-lang.discourse.group/t/faster-string-to-double/
+!>
+!> Known precisions limits of current proposal :
+!> Conversion to double precision is exact up to epsilon(0.0_dp)
+!> example:
+!> input : 123456.78901234567890123456789012345678901234567890+2
+!> formatted read : 12345678.90123457
+!> to_num : 12345678.90123457
+!> difference abs : 0.1862645149230957E-08
+!> difference rel : 0.1508742584455759E-13%
+!>
+!> Conversion to quadruple precision can deviate at about 200*epsilon(0.0_qp)
+!> example:
+!> input : 0.140129846432481707092372958328991613128026194187651577175706828388979108268586060148663818836212158203125E-443
+!> formatted read : 0.140129846432481707092372958328991608E-443
+!> to_num : 0.140129846432481707092372958328996233E-443
+!> difference abs : 0.4625E-475
+!> difference rel : 0.3300E-029%
+
+module stdlib_str2num
+ use stdlib_kinds, only: sp, dp, xdp, qp, int8, int16, int32, int64
+ use, intrinsic:: ieee_arithmetic, only: ieee_value, ieee_positive_inf, ieee_quiet_nan
+ implicit none
+ private
+ public :: to_num, to_num_from_stream
+
+ integer(int8), parameter :: digit_0 = ichar('0',int8)
+ integer(int8), parameter :: period = ichar('.',int8) - digit_0
+ integer(int8), parameter :: comma = ichar(',',int8) - digit_0
+ integer(int8), parameter :: minus_sign = ichar('-',int8) - digit_0
+ integer(int8), parameter :: plus_sign = ichar('+',int8) - digit_0
+ integer(int8), parameter :: Inf = ichar('I',int8)
+ integer(int8), parameter :: NaN = ichar('N',int8)
+ integer(int8), parameter :: le = ichar('e',int8) - digit_0
+ integer(int8), parameter :: BE = ichar('E',int8) - digit_0
+ integer(int8), parameter :: ld = ichar('d',int8) - digit_0
+ integer(int8), parameter :: BD = ichar('D',int8) - digit_0
+ integer(int8), parameter :: LF = 10, CR = 13, WS = 32
+
+ interface to_num
+ !! version: experimental
+ !!
+ !! Conversion of strings to numbers
+ !! ([Specification](../page/specs/stdlib_str2num.html#to-num-conversion-of-strings-to-numbers))
+ #:for k1, t1 in (INT_KINDS_TYPES + REAL_KINDS_TYPES)
+ module procedure to_${k1}$
+ #:endfor
+ end interface
+
+ interface to_num_from_stream
+ !! version: experimental
+ !!
+ !! Conversion of a stream of values in a string to numbers
+ !! ([Specification](../page/specs/stdlib_str2num.html#to-num-p-conversion-of-a-stream-of-values-in-a-strings-to-numbers))
+ #:for k1, t1 in (INT_KINDS_TYPES + REAL_KINDS_TYPES)
+ module procedure to_${k1}$_from_stream
+ #:endfor
+ end interface
+
+ interface to_num_base
+ #:for k1, t1 in (INT_KINDS_TYPES + REAL_KINDS_TYPES)
+ module procedure to_${k1}$_base
+ #:endfor
+ end interface
+
+ contains
+
+ !---------------------------------------------
+ ! String To Number interfaces
+ !---------------------------------------------
+
+ #:for k1, t1 in (INT_KINDS_TYPES + REAL_KINDS_TYPES)
+ elemental function to_${k1}$(s,mold) result(v)
+ ! -- In/out Variables
+ character(*), intent(in) :: s !> input string
+ ${t1}$, intent(in) :: mold !> dummy argument to disambiguate at compile time the generic interface
+ ${t1}$ :: v !> Output ${t1}$ value
+ ! -- Internal Variables
+ integer(int8) :: p !> position within the number
+ integer(int8) :: stat !> error status
+ !----------------------------------------------
+ call to_num_base(s,v,p,stat)
+ end function
+
+ function to_${k1}$_from_stream(s,mold,stat) result(v)
+ ! -- In/out Variables
+ character(len=:), pointer :: s !> input string
+ ${t1}$, intent(in) :: mold !> dummy argument to disambiguate at compile time the generic interface
+ ${t1}$ :: v !> Output ${t1}$ value
+ integer(int8),intent(inout), optional :: stat
+ ! -- Internal Variables
+ integer(int8) :: p !> position within the number
+ integer(int8) :: err
+ !----------------------------------------------
+ call to_num_base(s,v,p,err)
+ p = min( p , len(s) )
+ s => s(p:)
+ if(present(stat)) stat = err
+ end function
+
+ #:endfor
+ !---------------------------------------------
+ ! String To Number Implementations
+ !---------------------------------------------
+
+ #:for k1, t1 in INT_KINDS_TYPES
+ elemental subroutine to_${k1}$_base(s,v,p,stat)
+ !> Return an ${k1}$ integer
+ ! -- In/out Variables
+ character(*), intent(in) :: s !> input string
+ ${t1}$, intent(out) :: v !> Output real value
+ integer(int8), intent(out) :: p !> position within the number
+ integer(int8), intent(out) :: stat !> status upon succes or failure to read
+ ! -- Internal Variables
+ integer(int8) :: val
+ !----------------------------------------------
+ stat = 23 !> initialize error status with any number > 0
+ !----------------------------------------------
+ ! Find first non white space
+ p = shift_to_nonwhitespace(s)
+ !----------------------------------------------
+ v = 0
+ do while( p<=len(s) )
+ val = iachar(s(p:p))-digit_0
+ if( val >= 0 .and. val <= 9 ) then
+ v = v*10 + val
+ p = p + 1
+ else
+ exit
+ end if
+ end do
+ stat = 0
+ end subroutine
+
+ #:endfor
+
+ elemental subroutine to_sp_base(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
+ character(*), intent(in) :: s !> input string
+ real(wp), intent(inout) :: v !> Output real value
+ integer(int8), intent(out) :: p !> last position within the string
+ integer(int8), intent(out) :: stat !> status upon success or failure to read
+
+ ! -- Internal Variables
+ integer(int8), parameter :: nwnb = 39 !> number of whole number factors
+ integer(int8), parameter :: nfnb = 37 !> number of fractional number factors
+ integer :: e
+ ! Notice: We use dp here to obtain exact precision for sp.
+ ! Otherwise errors may appear in comparison to formatted read.
+ ! See https://github.com/fortran-lang/stdlib/pull/743#issuecomment-1791953430 for more details
+ real(dp), parameter :: whole_number_base(nwnb) = [(10._dp**(nwnb-e),e=1,nwnb)]
+ real(dp), parameter :: fractional_base(nfnb) = [(10._dp**(-e),e=1,nfnb)]
+ real(dp), parameter :: expbase(nwnb+nfnb) = [whole_number_base, fractional_base]
+
+ integer(int8) :: sign, sige !> sign of integer number and exponential
+ integer, parameter :: maxdpt = 11 !> Maximum depth to read values on int_wp
+ integer(dp) :: int_wp !> long integer to capture fractional part
+ integer :: i_exp !> integer to capture whole number part
+ integer :: exp_aux
+ integer(int8) :: i, pP, pE, val , resp
+ !----------------------------------------------
+ stat = 23 !> initialize error status with any number > 0
+ !----------------------------------------------
+ ! Find first non white space
+ p = shift_to_nonwhitespace(s)
+ !----------------------------------------------
+ ! Verify leading negative
+ sign = 1
+ if( iachar(s(p:p)) == minus_sign+digit_0 ) then
+ sign = -1
+ p = p + 1
+ end if
+ if( iachar(s(p:p)) == Inf ) then
+ v = sign*ieee_value(v, ieee_positive_inf)
+ return
+ else if( iachar(s(p:p)) == NaN ) then
+ v = ieee_value(v, ieee_quiet_nan)
+ return
+ end if
+ !----------------------------------------------
+ ! read whole and fractional number in a single integer
+ pP = 127
+ int_wp = 0
+ do i = p, min(maxdpt+p-1,len(s))
+ val = iachar(s(i:i))-digit_0
+ if( val >= 0 .and. val <= 9 ) then
+ int_wp = int_wp*10 + val
+ else if( val == period ) then
+ pP = i
+ else
+ exit
+ end if
+ end do
+ pE = i ! Fix the exponent position
+ do while( i<=len(s) )
+ val = iachar(s(i:i))-digit_0
+ if( val < 0 .or. val > 9 ) exit
+ i = i + 1
+ end do
+ p = i
+ resp = pE-min(pP,p) ! If no decimal indicator found it is taken as being in the current p position
+ if( resp <= 0 ) resp = resp+1
+ !----------------------------------------------
+ ! Get exponential
+ sige = 1
+ if( p<len(s) ) then
+ if( any([le,BE,ld,BD]+digit_0==iachar(s(p:p))) ) p = p + 1
+ if( iachar(s(p:p)) == minus_sign+digit_0 ) then
+ sige = -1
+ p = p + 1
+ else if( iachar(s(p:p)) == plus_sign+digit_0 ) then
+ p = p + 1
+ end if
+ end if
+
+ i_exp = 0
+ do while( p<=len(s) )
+ val = iachar(s(p:p))-digit_0
+ if( val >= 0 .and. val <= 9 ) then
+ i_exp = i_exp*10_int8 + val
+ p = p + 1
+ else
+ exit
+ end if
+ end do
+
+ exp_aux = nwnb-1+resp-sige*i_exp
+ if( exp_aux>0 .and. exp_aux<=nwnb+nfnb ) then
+ v = sign*int_wp*expbase(exp_aux)
+ else
+ v = sign*int_wp*10._dp**(sige*i_exp-resp+1)
+ end if
+ stat = 0
+ end subroutine
+
+ elemental subroutine to_dp_base(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
+ character(*), intent(in) :: s !> input string
+ real(wp), intent(inout) :: v !> Output real value
+ integer(int8), intent(out) :: p !> last position within the string
+ integer(int8), intent(out) :: stat !> status upon success or failure to read
+
+ ! -- Internal Variables
+ integer(int8), parameter :: nwnb = 40 !> number of whole number factors
+ integer(int8), 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(int8) :: sign, sige !> sign of integer number and exponential
+ integer, parameter :: maxdpt = 19 !> Maximum depth to read values on int_wp
+ integer(wp) :: int_wp !> long integer to capture fractional part
+ integer :: i_exp !> integer to capture whole number part
+ integer :: exp_aux
+ integer(int8) :: i, pP, pE, val , resp
+ !----------------------------------------------
+ stat = 23 !> initialize error status with any number > 0
+ !----------------------------------------------
+ ! Find first non white space
+ p = shift_to_nonwhitespace(s)
+ !----------------------------------------------
+ ! Verify leading negative
+ sign = 1
+ if( iachar(s(p:p)) == minus_sign+digit_0 ) then
+ sign = -1
+ p = p + 1
+ end if
+ if( iachar(s(p:p)) == Inf ) then
+ v = sign*ieee_value(v, ieee_positive_inf)
+ return
+ else if( iachar(s(p:p)) == NaN ) then
+ v = ieee_value(v, ieee_quiet_nan)
+ return
+ end if
+ !----------------------------------------------
+ ! read whole and fractional number in a single integer
+ pP = 127
+ int_wp = 0
+ do i = p, min(maxdpt+p-1,len(s))
+ val = iachar(s(i:i))-digit_0
+ if( val >= 0 .and. val <= 9 ) then
+ int_wp = int_wp*10 + val
+ else if( val == period ) then
+ pP = i
+ else
+ exit
+ end if
+ end do
+ pE = i ! Fix the exponent position
+ do while( i<=len(s) )
+ val = iachar(s(i:i))-digit_0
+ if( val < 0 .or. val > 9 ) exit
+ i = i + 1
+ end do
+ p = i
+ resp = pE-min(pP,p) ! If no decimal indicator found it is taken as being in the current p position
+ if( resp <= 0 ) resp = resp+1
+ !----------------------------------------------
+ ! Get exponential
+ sige = 1
+ if( p<len(s) ) then
+ if( any([le,BE,ld,BD]+digit_0==iachar(s(p:p))) ) p = p + 1
+ if( iachar(s(p:p)) == minus_sign+digit_0 ) then
+ sige = -1
+ p = p + 1
+ else if( iachar(s(p:p)) == plus_sign+digit_0 ) then
+ p = p + 1
+ end if
+ end if
+
+ i_exp = 0
+ do while( p<=len(s) )
+ val = iachar(s(p:p))-digit_0
+ if( val >= 0 .and. val <= 9 ) then
+ i_exp = i_exp*10_int8 + val
+ p = p + 1
+ else
+ exit
+ end if
+ end do
+
+ exp_aux = nwnb-1+resp-sige*i_exp
+ if( exp_aux>0 .and. exp_aux<=nwnb+nfnb ) then
+ v = sign*int_wp*expbase(exp_aux)
+ else
+ v = sign*int_wp*10._wp**(sige*i_exp-resp+1)
+ end if
+ stat = 0
+ end subroutine
+
+#:if WITH_XDP
+ elemental subroutine to_xdp_base(s,v,p,stat)
+ integer, parameter :: wp = xdp
+ !> Sequentially unroll the character and get the sub integers composing the whole number, fraction and exponent
+ ! -- In/out Variables
+ character(*), intent(in) :: s !> input string
+ real(wp), intent(inout) :: v !> Output real value
+ integer(int8), intent(out) :: p !> last position within the string
+ integer(int8), intent(out) :: stat !> status upon success or failure to read
+
+ ! -- Internal Variables
+ integer(int8), parameter :: nwnb = 50 !> number of whole number factors
+ integer(int8), 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(int8) :: sign, sige !> sign of integer number and exponential
+ integer, parameter :: maxdpt = 19 !> Maximum depth to read values on int_dp
+ integer(dp) :: int_dp1, int_dp2 !> long integers to capture whole and fractional part
+ integer :: i_exp !> integer to capture exponent number
+ integer :: exp_aux
+ integer(int8) :: i, pP, pE, val , resp, icount, aux
+ !----------------------------------------------
+ stat = 23 !> initialize error status with any number > 0
+ !----------------------------------------------
+ ! Find first non white space
+ p = shift_to_nonwhitespace(s)
+ !----------------------------------------------
+ ! Verify leading negative
+ sign = 1
+ if( iachar(s(p:p)) == minus_sign+digit_0 ) then
+ sign = -1
+ p = p + 1
+ end if
+ if( iachar(s(p:p)) == Inf ) then
+ v = sign*ieee_value(v, ieee_positive_inf)
+ return
+ else if( iachar(s(p:p)) == NaN ) then
+ v = ieee_value(v, ieee_quiet_nan)
+ return
+ end if
+ !----------------------------------------------
+ ! read whole and fractional number using two int64 values
+ pP = 127
+ int_dp1 = 0
+ int_dp2 = 0
+ icount = 0
+ aux = 1
+ do i = p, min(2*maxdpt+p-1,len(s))
+ val = iachar(s(i:i))-digit_0
+ if( val >= 0 .and. val <= 9 ) then
+ icount = icount + 1
+ if( icount<=maxdpt ) then
+ int_dp1 = int_dp1*10 + val
+ else if( icount<2*maxdpt ) then
+ int_dp2 = int_dp2*10 + val
+ end if
+ else if( val == period ) then
+ pP = i
+ aux = 0
+ else
+ exit
+ end if
+ end do
+ pE = i ! Fix the exponent position
+ do while( i<=len(s) )
+ val = iachar(s(i:i))-digit_0
+ if( val < 0 .or. val > 9 ) exit
+ i = i + 1
+ end do
+ p = i
+ resp = pE-min(pP,p) ! If no decimal indicator found it is taken as being in the current p position
+ if( resp <= 0 ) resp = resp+1
+ !----------------------------------------------
+ ! Get exponential
+ sige = 1
+ if( p<len(s) ) then
+ if( any([le,BE,ld,BD]+digit_0==iachar(s(p:p))) ) p = p + 1
+ if( iachar(s(p:p)) == minus_sign+digit_0 ) then
+ sige = -1
+ p = p + 1
+ else if( iachar(s(p:p)) == plus_sign+digit_0 ) then
+ p = p + 1
+ end if
+ end if
+
+ i_exp = 0
+ do while( p<=len(s) )
+ val = iachar(s(p:p))-digit_0
+ if( val >= 0 .and. val <= 9 ) then
+ i_exp = i_exp*10_int8 + val
+ p = p + 1
+ else
+ exit
+ end if
+ end do
+
+ exp_aux = nwnb-1+resp-sige*i_exp
+ if( exp_aux>0 .and. exp_aux<=nwnb+nfnb ) then
+ if( icount<=maxdpt ) then
+ v = sign*int_dp1*expbase(exp_aux)
+ else
+ v = sign*(int_dp1 + int_dp2*fractional_base(maxdpt-1))*expbase(exp_aux-icount+maxdpt)
+ end if
+ else
+ v = sign*(int_dp1 + int_dp2*fractional_base(maxdpt-1))*10._wp**(sige*i_exp-resp+maxdpt+aux)
+ end if
+ stat = 0
+ end subroutine
+#:endif
+
+#:if WITH_QP
+ elemental subroutine to_qp_base(s,v,p,stat)
+ integer, parameter :: wp = qp
+ !> Sequentially unroll the character and get the sub integers composing the whole number, fraction and exponent
+ ! -- In/out Variables
+ character(*), intent(in) :: s !> input string
+ real(wp), intent(inout) :: v !> Output real value
+ integer(int8), intent(out) :: p !> last position within the string
+ integer(int8), intent(out) :: stat !> status upon success or failure to read
+
+ ! -- Internal Variables
+ integer(int8), parameter :: nwnb = 50 !> number of whole number factors
+ integer(int8), 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(int8) :: sign, sige !> sign of integer number and exponential
+ integer, parameter :: maxdpt = 19 !> Maximum depth to read values on int_dp
+ integer(dp) :: int_dp1, int_dp2 !> long integers to capture whole and fractional part
+ integer :: i_exp !> integer to capture exponent number
+ integer :: exp_aux
+ integer(int8) :: i, pP, pE, val , resp, icount, aux
+ !----------------------------------------------
+ stat = 23 !> initialize error status with any number > 0
+ !----------------------------------------------
+ ! Find first non white space
+ p = shift_to_nonwhitespace(s)
+ !----------------------------------------------
+ ! Verify leading negative
+ sign = 1
+ if( iachar(s(p:p)) == minus_sign+digit_0 ) then
+ sign = -1
+ p = p + 1
+ end if
+ if( iachar(s(p:p)) == Inf ) then
+ v = sign*ieee_value(v, ieee_positive_inf)
+ return
+ else if( iachar(s(p:p)) == NaN ) then
+ v = ieee_value(v, ieee_quiet_nan)
+ return
+ end if
+ !----------------------------------------------
+ ! read whole and fractional number using two int64 values
+ pP = 127
+ int_dp1 = 0
+ int_dp2 = 0
+ icount = 0
+ aux = 1
+ do i = p, min(2*maxdpt+p-1,len(s))
+ val = iachar(s(i:i))-digit_0
+ if( val >= 0 .and. val <= 9 ) then
+ icount = icount + 1
+ if( icount<=maxdpt ) then
+ int_dp1 = int_dp1*10 + val
+ else if( icount<2*maxdpt ) then
+ int_dp2 = int_dp2*10 + val
+ end if
+ else if( val == period ) then
+ pP = i
+ aux = 0
+ else
+ exit
+ end if
+ end do
+ pE = i ! Fix the exponent position
+ do while( i<=len(s) )
+ val = iachar(s(i:i))-digit_0
+ if( val < 0 .or. val > 9 ) exit
+ i = i + 1
+ end do
+ p = i
+ resp = pE-min(pP,p) ! If no decimal indicator found it is taken as being in the current p position
+ if( resp <= 0 ) resp = resp+1
+ !----------------------------------------------
+ ! Get exponential
+ sige = 1
+ if( p<len(s) ) then
+ if( any([le,BE,ld,BD]+digit_0==iachar(s(p:p))) ) p = p + 1
+ if( iachar(s(p:p)) == minus_sign+digit_0 ) then
+ sige = -1
+ p = p + 1
+ else if( iachar(s(p:p)) == plus_sign+digit_0 ) then
+ p = p + 1
+ end if
+ end if
+
+ i_exp = 0
+ do while( p<=len(s) )
+ val = iachar(s(p:p))-digit_0
+ if( val >= 0 .and. val <= 9 ) then
+ i_exp = i_exp*10_int8 + val
+ p = p + 1
+ else
+ exit
+ end if
+ end do
+
+ exp_aux = nwnb-1+resp-sige*i_exp
+ if( exp_aux>0 .and. exp_aux<=nwnb+nfnb ) then
+ if( icount<=maxdpt ) then
+ v = sign*int_dp1*expbase(exp_aux)
+ else
+ v = sign*(int_dp1 + int_dp2*fractional_base(maxdpt-1))*expbase(exp_aux-icount+maxdpt)
+ end if
+ else
+ v = sign*(int_dp1 + int_dp2*fractional_base(maxdpt-1))*10._wp**(sige*i_exp-resp+maxdpt+aux)
+ end if
+ stat = 0
+ end subroutine
+#:endif
+
+ !---------------------------------------------
+ ! Internal Utility functions
+ !---------------------------------------------
+
+ elemental function shift_to_nonwhitespace(s) result(p)
+ !> move string to position of the next non white space character
+ character(*),intent(in) :: s !> character chain
+ integer(int8) :: p !> position
+ !----------------------------------------------
+ p = 1
+ do while( p<len(s) .and. (iachar(s(p:p))==WS .or. iachar(s(p:p))==LF .or. iachar(s(p:p))==CR) )
+ p = p + 1
+ end do
+ end function
+
+ elemental function shift_to_whitespace(s) result(p)
+ !> move string to position of the next white space character
+ character(*),intent(in) :: s !> character chain
+ integer(int8) :: p !> position
+ !----------------------------------------------
+ p = 1
+ do while( p<len(s) .and. .not.(iachar(s(p:p))==WS .or. iachar(s(p:p))==LF .or. iachar(s(p:p))==CR) )
+ p = p + 1
+ end do
+ end function
+
+end module stdlib_str2num
diff --git a/test/hashmaps/test_maps.fypp b/test/hashmaps/test_maps.fypp
index cd1e3a4ee..8e8311c96 100644
--- a/test/hashmaps/test_maps.fypp
+++ b/test/hashmaps/test_maps.fypp
@@ -1,3 +1,4 @@
+#: include "common.fypp"
#:set HASH_NAME = ["fnv_1_hasher", "fnv_1a_hasher", "seeded_nmhash32_hasher", "seeded_nmhash32x_hasher", "seeded_water_hasher"]
#:set SIZE_NAME = ["16", "256"]
module test_stdlib_chaining_maps
diff --git a/test/string/CMakeLists.txt b/test/string/CMakeLists.txt
index f8e3c2323..833471c9e 100644
--- a/test/string/CMakeLists.txt
+++ b/test/string/CMakeLists.txt
@@ -3,6 +3,7 @@
# Create a list of the files to be preprocessed
set(fppFiles
test_string_assignment.fypp
+ test_string_to_number.fypp
)
fypp_f90("${fyppFlags}" "${fppFiles}" outFiles)
@@ -14,4 +15,5 @@ ADDTEST(string_match)
ADDTEST(string_derivedtype_io)
ADDTEST(string_functions)
ADDTEST(string_strip_chomp)
+ADDTEST(string_to_number)
ADDTEST(string_to_string)
diff --git a/test/string/test_string_to_number.fypp b/test/string/test_string_to_number.fypp
new file mode 100644
index 000000000..62a0b5c1a
--- /dev/null
+++ b/test/string/test_string_to_number.fypp
@@ -0,0 +1,162 @@
+#: include "common.fypp"
+module test_string_to_number
+ use stdlib_kinds, only: sp, dp, xdp, qp
+ use stdlib_str2num, only: to_num
+ use testdrive, only : new_unittest, unittest_type, error_type, check
+ implicit none
+
+contains
+
+ !> Collect all exported unit tests
+ subroutine collect_string_to_number(testsuite)
+ !> Collection of tests
+ type(unittest_type), allocatable, intent(out) :: testsuite(:)
+
+ testsuite = [ &
+ new_unittest("to_sp", test_to_sp), &
+ new_unittest("to_dp", test_to_dp) &
+#:if WITH_QP
+ , new_unittest("to_qp", test_to_qp) &
+#:endif
+#:if WITH_XDP
+ , new_unittest("to_xdp", test_to_xdp) &
+#:endif
+ ]
+ end subroutine collect_string_to_number
+
+ #:for k1, t1 in REAL_KINDS_TYPES
+ subroutine test_to_${k1}$(error)
+ type(error_type), allocatable, intent(out) :: error
+ integer, parameter :: wp = ${k1}$
+
+ call check(error, ucheck("1.234"))
+ if (allocated(error)) return
+
+ call check(error, ucheck("1.E1"))
+ if (allocated(error)) return
+
+ call check(error, ucheck("1e0"))
+ if (allocated(error)) return
+
+ call check(error, ucheck("0.1234E0"))
+ if (allocated(error)) return
+
+ call check(error, ucheck("12.34E0"))
+ if (allocated(error)) return
+
+ call check(error, ucheck("0.34E2"))
+ if (allocated(error)) return
+
+ call check(error, ucheck(".34e0"))
+ if (allocated(error)) return
+
+ call check(error, ucheck("34.E1"))
+ if (allocated(error)) return
+
+ call check(error, ucheck("-34.5E1"))
+ if (allocated(error)) return
+
+ call check(error, ucheck("0.0021E10"))
+ if (allocated(error)) return
+
+ call check(error, ucheck("12.21e-1"))
+ if (allocated(error)) return
+
+ call check(error, ucheck("12.21e+001 "))
+ if (allocated(error)) return
+
+ call check(error, ucheck("-1"))
+ if (allocated(error)) return
+
+ call check(error, ucheck(" -0.23317260678539647E-01 "))
+ if (allocated(error)) return
+
+ call check(error, ucheck(" 2.5647869e-003 "//char(13)//char(10)))
+ if (allocated(error)) return
+
+ call check(error, ucheck("1.-3"))
+ if (allocated(error)) return
+
+ call check(error, ucheck("Inf"))
+ if (allocated(error)) return
+
+ call check(error, ucheck("-Inf"))
+ if (allocated(error)) return
+
+ call check(error, ucheck("NaN"))
+ if (allocated(error)) return
+
+ call check(error, ucheck("0.123456789123456789123456789123456789"))
+ if (allocated(error)) return
+
+ call check(error, ucheck("1234567890123456789012345678901234567890-9") )
+ if (allocated(error)) return
+
+ 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) :: to_num_out
+ real(wp) :: abs_err
+ real(wp) :: rel_err
+
+ ucheck = .true.
+ read(s,*) 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 k1 == "sp"
+ if(abs(rel_err) > 0.0_wp) then
+ #:elif k1 == "dp"
+ if(abs(rel_err) > epsilon(0.0_wp)) then
+ #:elif k1 == "xdp"
+ if(abs(rel_err) > 200*epsilon(0.0_wp)) then
+ #:elif k1 == "qp"
+ if(abs(rel_err) > 200*epsilon(0.0_wp)) then
+ #:endif
+ write(*,"('formatted read : ' g0)") formatted_read_out
+ write(*,"('to_num : ' g0)") to_num_out
+ write(*,"('difference abs : ' g0)") abs_err
+ write(*,"('difference rel : ' g0 '%')") rel_err * 100
+ ucheck = .false.
+ end if
+ end function
+ end subroutine
+
+ #:endfor
+
+end module test_string_to_number
+
+program tester
+ use, intrinsic :: iso_fortran_env, only : error_unit
+ use testdrive, only : run_testsuite, new_testsuite, testsuite_type
+ use test_string_to_number, only : collect_string_to_number
+ implicit none
+ integer :: stat, is
+ type(testsuite_type), allocatable :: testsuites(:)
+ character(len=*), parameter :: fmt = '("#", *(1x, a))'
+
+ stat = 0
+
+ testsuites = [ &
+ new_testsuite("string_to_number", collect_string_to_number) &
+ ]
+
+ do is = 1, size(testsuites)
+ write(error_unit, fmt) "Testing:", testsuites(is)%name
+ call run_testsuite(testsuites(is)%collect, error_unit, stat)
+ end do
+
+ if (stat > 0) then
+ write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!"
+ error stop
+ end if
+end program