diff --git a/src/CMakeLists.txt b/src/CMakeLists.txt index 4fdf49b64..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 @@ -82,7 +83,6 @@ set(SRC stdlib_specialfunctions_legendre.f90 stdlib_quadrature_gauss.f90 stdlib_stringlist_type.f90 - stdlib_str2num.f90 ${outFiles} ) diff --git a/src/stdlib_str2num.f90 b/src/stdlib_str2num.fypp similarity index 93% rename from src/stdlib_str2num.f90 rename to src/stdlib_str2num.fypp index 68f1e9510..fd9b241c8 100644 --- a/src/stdlib_str2num.f90 +++ b/src/stdlib_str2num.fypp @@ -1,3 +1,4 @@ +#:include "common.fypp" !> The `stdlib_str2num` module provides procedures and interfaces for conversion !> of characters to numerical types. Currently supported: int32, real32 and real64 !> @@ -22,7 +23,7 @@ !> difference rel : 0.3300E-029% module stdlib_str2num - use iso_fortran_env, only: sp => real32, dp => real64, qp => real128 + use stdlib_kinds, only: sp, dp, qp, int8, int16, int32, int64 use ieee_arithmetic implicit none private @@ -43,24 +44,36 @@ module stdlib_str2num integer(kind=ikind), parameter :: LF = 10, CR = 13, WS = 32 interface to_num - module procedure to_int + #:for k1, t1 in INT_KINDS_TYPES + module procedure to_${k1}$ + #:endfor module procedure to_float module procedure to_double +#:if WITH_QP module procedure to_quad +#:endif end interface interface to_num_p - module procedure to_int_p + #:for k1, t1 in INT_KINDS_TYPES + module procedure to_${k1}$_p + #:endfor module procedure to_float_p module procedure to_double_p +#:if WITH_QP module procedure to_quad_p +#:endif end interface interface to_num_base - module procedure to_int_32 + #:for k1, t1 in INT_KINDS_TYPES + module procedure to_int_${k1}$ + #:endfor module procedure to_real_sp module procedure to_real_dp +#:if WITH_QP module procedure to_real_qp +#:endif end interface contains @@ -69,33 +82,35 @@ module stdlib_str2num ! String To Number interfaces !--------------------------------------------- - elemental function to_int(s,mold) result(v) + #:for k1, t1 in INT_KINDS_TYPES + elemental function to_${k1}$(s,mold) result(v) ! -- In/out Variables character(*), intent(in) :: s !> input string - integer, intent(in) :: mold !> dummy argument to disambiguate at compile time the generic interface - integer :: v !> Output integer 32 value + ${t1}$, intent(in) :: mold !> dummy argument to disambiguate at compile time the generic interface + ${t1}$ :: v !> Output integer 32 value ! -- Internal Variables - integer(1) :: p !> position within the number - integer(1) :: stat !> error status + integer(int8) :: p !> position within the number + integer(int8) :: stat !> error status !---------------------------------------------- call to_num_base(s,v,p,stat) end function - function to_int_p(s,mold,stat) result(v) + function to_${k1}$_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 + ${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(1) :: p !> position within the number - integer(1) :: err + 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 elemental function to_float(s,mold) result(r) ! -- In/out Variables @@ -153,6 +168,7 @@ function to_double_p(s,mold,stat) result(r) if(present(stat)) stat = err end function +#:if WITH_QP function to_quad(s,mold) result(r) ! -- In/out Variables character(*), intent(in) :: s !> input string @@ -180,16 +196,18 @@ function to_quad_p(s,mold,stat) result(r) s => s(p:) if(present(stat)) stat = err end function +#:endif !--------------------------------------------- ! String To Number Implementations !--------------------------------------------- - elemental subroutine to_int_32(s,v,p,stat) + #:for k1, t1 in INT_KINDS_TYPES + elemental subroutine to_int_${k1}$(s,v,p,stat) !> Return an unsigned 32-bit integer ! -- In/out Variables character(*), intent(in) :: s !> input string - integer(int32), intent(inout) :: v !> Output real value + ${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 @@ -211,6 +229,7 @@ elemental subroutine to_int_32(s,v,p,stat) end do stat = 0 end subroutine + #:endfor elemental subroutine to_real_sp(s,v,p,stat) integer, parameter :: wp = sp @@ -400,6 +419,7 @@ elemental subroutine to_real_dp(s,v,p,stat) stat = 0 end subroutine +#:if WITH_QP subroutine to_real_qp(s,v,p,stat) integer, parameter :: wp = qp !> Sequentially unroll the character and get the sub integers composing the whole number, fraction and exponent @@ -502,6 +522,7 @@ subroutine to_real_qp(s,v,p,stat) end if stat = 0 end subroutine +#:endif !--------------------------------------------- ! Internal Utility functions @@ -510,7 +531,7 @@ subroutine to_real_qp(s,v,p,stat) elemental function mvs2nwsp(s) result(p) !> move string to position of the next non white space character character(*),intent(in) :: s !> character chain - integer(1) :: p !> position + integer(int8) :: p !> position !---------------------------------------------- p = 1 do while( preal32, dp=>real64, qp=>real128 + use stdlib_kinds, only: sp, dp, qp use stdlib_str2num use testdrive, only : new_unittest, unittest_type, error_type, check implicit none @@ -14,6 +14,9 @@ subroutine collect_string_to_number(testsuite) testsuite = [ & new_unittest("to_float", test_to_float), & new_unittest("to_double", test_to_double) & +#:if WITH_QP + , new_unittest("to_quadruple", test_to_quadruple) & +#:endif ] end subroutine collect_string_to_number @@ -215,6 +218,7 @@ logical function ucheck(s) end function end subroutine +#:if WITH_QP subroutine test_to_quadruple(error) use stdlib_str2num type(error_type), allocatable, intent(out) :: error @@ -313,6 +317,7 @@ logical function ucheck(s) end if end function end subroutine +#:endif end module test_string_to_number @@ -340,4 +345,4 @@ program tester write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!" error stop end if -end program \ No newline at end of file +end program