Skip to content

Commit

Permalink
Merge pull request #1 from jvdp1/fypp_qp
Browse files Browse the repository at this point in the history
Addition of some fypp directives
  • Loading branch information
jalvesz authored Dec 31, 2023
2 parents ea6560b + 17d3dae commit d9ece9c
Show file tree
Hide file tree
Showing 4 changed files with 50 additions and 22 deletions.
2 changes: 1 addition & 1 deletion src/CMakeLists.txt
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -82,7 +83,6 @@ set(SRC
stdlib_specialfunctions_legendre.f90
stdlib_quadrature_gauss.f90
stdlib_stringlist_type.f90
stdlib_str2num.f90
${outFiles}
)

Expand Down
59 changes: 40 additions & 19 deletions src/stdlib_str2num.f90 → src/stdlib_str2num.fypp
Original file line number Diff line number Diff line change
@@ -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
!>
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -502,6 +522,7 @@ subroutine to_real_qp(s,v,p,stat)
end if
stat = 0
end subroutine
#:endif

!---------------------------------------------
! Internal Utility functions
Expand All @@ -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( p<len(s) .and. (iachar(s(p:p))==WS.or.iachar(s(p:p))==LF.or.iachar(s(p:p))==CR) )
Expand All @@ -529,4 +550,4 @@ elemental function mvs2wsp(s) result(p)
end do
end function

end module stdlib_str2num
end module stdlib_str2num
2 changes: 2 additions & 0 deletions test/string/CMakeLists.txt
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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)
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
module test_string_to_number
use iso_fortran_env, only: sp=>real32, 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
Expand All @@ -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

Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -313,6 +317,7 @@ logical function ucheck(s)
end if
end function
end subroutine
#:endif

end module test_string_to_number

Expand Down Expand Up @@ -340,4 +345,4 @@ program tester
write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!"
error stop
end if
end program
end program

0 comments on commit d9ece9c

Please sign in to comment.