Skip to content

Commit 327a84f

Browse files
jalveszjalvesz
authored
Update stdlib_str2num.fypp
Refactor function naming using fypp preprocessing
1 parent ab8c7da commit 327a84f

File tree

1 file changed

+36
-134
lines changed

1 file changed

+36
-134
lines changed

‎src/stdlib_str2num.fypp

Lines changed: 36 additions & 134 deletions
Original file line numberDiff line numberDiff line change
@@ -29,51 +29,35 @@ module stdlib_str2num
2929
private
3030
public :: to_num, to_num_p
3131

32-
integer, parameter :: ikind = selected_int_kind(2)
33-
integer(kind=ikind), parameter :: digit_0 = ichar('0',kind=ikind)
34-
integer(kind=ikind), parameter :: period = ichar('.',kind=ikind) - digit_0
35-
integer(kind=ikind), parameter :: comma = ichar(',',kind=ikind) - digit_0
36-
integer(kind=ikind), parameter :: minus_sign = ichar('-',kind=ikind) - digit_0
37-
integer(kind=ikind), parameter :: plus_sign = ichar('+',kind=ikind) - digit_0
38-
integer(kind=ikind), parameter :: Inf = ichar('I',kind=ikind)
39-
integer(kind=ikind), parameter :: NaN = ichar('N',kind=ikind)
40-
integer(kind=ikind), parameter :: le = ichar('e',kind=ikind) - digit_0
41-
integer(kind=ikind), parameter :: BE = ichar('E',kind=ikind) - digit_0
42-
integer(kind=ikind), parameter :: ld = ichar('d',kind=ikind) - digit_0
43-
integer(kind=ikind), parameter :: BD = ichar('D',kind=ikind) - digit_0
44-
integer(kind=ikind), parameter :: LF = 10, CR = 13, WS = 32
32+
integer(int8), parameter :: digit_0 = ichar('0',int8)
33+
integer(int8), parameter :: period = ichar('.',int8) - digit_0
34+
integer(int8), parameter :: comma = ichar(',',int8) - digit_0
35+
integer(int8), parameter :: minus_sign = ichar('-',int8) - digit_0
36+
integer(int8), parameter :: plus_sign = ichar('+',int8) - digit_0
37+
integer(int8), parameter :: Inf = ichar('I',int8)
38+
integer(int8), parameter :: NaN = ichar('N',int8)
39+
integer(int8), parameter :: le = ichar('e',int8) - digit_0
40+
integer(int8), parameter :: BE = ichar('E',int8) - digit_0
41+
integer(int8), parameter :: ld = ichar('d',int8) - digit_0
42+
integer(int8), parameter :: BD = ichar('D',int8) - digit_0
43+
integer(int8), parameter :: LF = 10, CR = 13, WS = 32
4544

4645
interface to_num
47-
#:for k1, t1 in INT_KINDS_TYPES
46+
#:for k1, t1 in (INT_KINDS_TYPES + REAL_KINDS_TYPES)
4847
module procedure to_${k1}$
4948
#:endfor
50-
module procedure to_float
51-
module procedure to_double
52-
#:if WITH_QP
53-
module procedure to_quad
54-
#:endif
5549
end interface
5650

5751
interface to_num_p
58-
#:for k1, t1 in INT_KINDS_TYPES
52+
#:for k1, t1 in (INT_KINDS_TYPES + REAL_KINDS_TYPES)
5953
module procedure to_${k1}$_p
6054
#:endfor
61-
module procedure to_float_p
62-
module procedure to_double_p
63-
#:if WITH_QP
64-
module procedure to_quad_p
65-
#:endif
6655
end interface
6756

6857
interface to_num_base
69-
#:for k1, t1 in INT_KINDS_TYPES
70-
module procedure to_int_${k1}$
58+
#:for k1, t1 in (INT_KINDS_TYPES + REAL_KINDS_TYPES)
59+
module procedure to_${k1}$_base
7160
#:endfor
72-
module procedure to_real_sp
73-
module procedure to_real_dp
74-
#:if WITH_QP
75-
module procedure to_real_qp
76-
#:endif
7761
end interface
7862

7963
contains
@@ -82,12 +66,12 @@ module stdlib_str2num
8266
! String To Number interfaces
8367
!---------------------------------------------
8468

85-
#:for k1, t1 in INT_KINDS_TYPES
69+
#:for k1, t1 in (INT_KINDS_TYPES + REAL_KINDS_TYPES)
8670
elemental function to_${k1}$(s,mold) result(v)
8771
! -- In/out Variables
8872
character(*), intent(in) :: s !> input string
8973
${t1}$, intent(in) :: mold !> dummy argument to disambiguate at compile time the generic interface
90-
${t1}$ :: v !> Output integer 32 value
74+
${t1}$ :: v !> Output ${t1}$ value
9175
! -- Internal Variables
9276
integer(int8) :: p !> position within the number
9377
integer(int8) :: stat !> error status
@@ -110,100 +94,14 @@ module stdlib_str2num
11094
s => s(p:)
11195
if(present(stat)) stat = err
11296
end function
113-
#:endfor
114-
115-
elemental function to_float(s,mold) result(r)
116-
! -- In/out Variables
117-
character(*), intent(in) :: s !> input string
118-
real(sp), intent(in) :: mold !> dummy argument to disambiguate at compile time the generic interface
119-
real(sp) :: r !> Output real value
120-
! -- Internal Variables
121-
integer(int8) :: p !> position within the number
122-
integer(int8) :: stat ! error status
123-
!----------------------------------------------
124-
call to_num_base(s,r,p,stat)
125-
end function
126-
127-
function to_float_p(s,mold,stat) result(r)
128-
! -- In/out Variables
129-
character(len=:), pointer :: s !> input string
130-
real(sp), intent(in) :: mold !> dummy argument to disambiguate at compile time the generic interface
131-
real(sp) :: r !> Output real value
132-
integer(int8), intent(inout), optional :: stat
133-
! -- Internal Variables
134-
integer(int8) :: p !> position within the number
135-
integer(int8) :: err
136-
!----------------------------------------------
137-
call to_num_base(s,r,p,err)
138-
p = min( p , len(s) )
139-
s => s(p:)
140-
if(present(stat)) stat = err
141-
end function
142-
143-
elemental function to_double(s,mold) result(r)
144-
! -- In/out Variables
145-
character(*), intent(in) :: s !> input string
146-
real(dp), intent(in) :: mold !> dummy argument to disambiguate at compile time the generic interface
147-
real(dp) :: r !> Output real value
148-
! -- Internal Variables
149-
integer(int8) :: p !> position within the number
150-
integer(int8) :: stat ! error status
151-
!----------------------------------------------
152-
call to_num_base(s,r,p,stat)
153-
end function
154-
155-
function to_double_p(s,mold,stat) result(r)
156-
! -- In/out Variables
157-
character(len=:), pointer :: s !> input string
158-
real(dp), intent(in) :: mold !> dummy argument to disambiguate at compile time the generic interface
159-
real(dp) :: r !> Output real value
160-
integer(int8),intent(inout), optional :: stat
161-
! -- Internal Variables
162-
integer(int8) :: p !> position within the number
163-
integer(int8) :: err
164-
!----------------------------------------------
165-
call to_num_base(s,r,p,err)
166-
p = min( p , len(s) )
167-
s => s(p:)
168-
if(present(stat)) stat = err
169-
end function
170-
171-
#:if WITH_QP
172-
function to_quad(s,mold) result(r)
173-
! -- In/out Variables
174-
character(*), intent(in) :: s !> input string
175-
real(qp), intent(in) :: mold !> dummy argument to disambiguate at compile time the generic interface
176-
real(qp) :: r !> Output real value
177-
! -- Internal Variables
178-
integer(1) :: p !> position within the number
179-
integer(1) :: stat ! error status
180-
!----------------------------------------------
181-
call to_num_base(s,r,p,stat)
182-
end function
183-
184-
function to_quad_p(s,mold,stat) result(r)
185-
! -- In/out Variables
186-
character(len=:), pointer :: s !> input string
187-
real(qp), intent(in) :: mold !> dummy argument to disambiguate at compile time the generic interface
188-
real(qp) :: r !> Output real value
189-
integer(int8),intent(inout), optional :: stat
190-
! -- Internal Variables
191-
integer(int8) :: p !> position within the number
192-
integer(int8) :: err
193-
!----------------------------------------------
194-
call to_num_base(s,r,p,err)
195-
p = min( p , len(s) )
196-
s => s(p:)
197-
if(present(stat)) stat = err
198-
end function
199-
#:endif
20097

98+
#:endfor
20199
!---------------------------------------------
202100
! String To Number Implementations
203101
!---------------------------------------------
204102

205103
#:for k1, t1 in INT_KINDS_TYPES
206-
elemental subroutine to_int_${k1}$(s,v,p,stat)
104+
elemental subroutine to_${k1}$_base(s,v,p,stat)
207105
!> Return an unsigned 32-bit integer
208106
! -- In/out Variables
209107
character(*), intent(in) :: s !> input string
@@ -229,9 +127,10 @@ module stdlib_str2num
229127
end do
230128
stat = 0
231129
end subroutine
130+
232131
#:endfor
233132

234-
elemental subroutine to_real_sp(s,v,p,stat)
133+
elemental subroutine to_sp_base(s,v,p,stat)
235134
integer, parameter :: wp = sp
236135
!> Sequentially unroll the character and get the sub integers composing the whole number, fraction and exponent
237136
! -- In/out Variables
@@ -241,9 +140,12 @@ module stdlib_str2num
241140
integer(int8), intent(out) :: stat !> status upon success or failure to read
242141

243142
! -- Internal Variables
244-
integer(kind=ikind), parameter :: nwnb = 39 !> number of whole number factors
245-
integer(kind=ikind), parameter :: nfnb = 37 !> number of fractional number factors
143+
integer(int8), parameter :: nwnb = 39 !> number of whole number factors
144+
integer(int8), parameter :: nfnb = 37 !> number of fractional number factors
246145
integer :: e
146+
! Notice: We use dp here to obtain exact precision for sp.
147+
! Otherwise errors may appear in comparison to formatted read.
148+
! See https://github.com/fortran-lang/stdlib/pull/743#issuecomment-1791953430 for more details
247149
real(dp), parameter :: whole_number_base(nwnb) = [(10._dp**(nwnb-e),e=1,nwnb)]
248150
real(dp), parameter :: fractional_base(nfnb) = [(10._dp**(-e),e=1,nfnb)]
249151
real(dp), parameter :: expbase(nwnb+nfnb) = [whole_number_base, fractional_base]
@@ -310,7 +212,7 @@ module stdlib_str2num
310212
do while( p<=len(s) )
311213
val = iachar(s(p:p))-digit_0
312214
if( val >= 0 .and. val <= 9) then
313-
i_exp = i_exp*10_ikind + val ; p = p + 1
215+
i_exp = i_exp*10_int8 + val ; p = p + 1
314216
else
315217
exit
316218
end if
@@ -325,7 +227,7 @@ module stdlib_str2num
325227
stat = 0
326228
end subroutine
327229

328-
elemental subroutine to_real_dp(s,v,p,stat)
230+
elemental subroutine to_dp_base(s,v,p,stat)
329231
integer, parameter :: wp = dp
330232
!> Sequentially unroll the character and get the sub integers composing the whole number, fraction and exponent
331233
! -- In/out Variables
@@ -335,8 +237,8 @@ module stdlib_str2num
335237
integer(int8), intent(out) :: stat !> status upon success or failure to read
336238

337239
! -- Internal Variables
338-
integer(kind=ikind), parameter :: nwnb = 40 !> number of whole number factors
339-
integer(kind=ikind), parameter :: nfnb = 64 !> number of fractional number factors
240+
integer(int8), parameter :: nwnb = 40 !> number of whole number factors
241+
integer(int8), parameter :: nfnb = 64 !> number of fractional number factors
340242
integer :: e
341243
real(wp), parameter :: whole_number_base(nwnb) = [(10._wp**(nwnb-e),e=1,nwnb)]
342244
real(wp), parameter :: fractional_base(nfnb) = [(10._wp**(-e),e=1,nfnb)]
@@ -404,7 +306,7 @@ module stdlib_str2num
404306
do while( p<=len(s) )
405307
val = iachar(s(p:p))-digit_0
406308
if( val >= 0 .and. val <= 9) then
407-
i_exp = i_exp*10_ikind + val ; p = p + 1
309+
i_exp = i_exp*10_int8 + val ; p = p + 1
408310
else
409311
exit
410312
end if
@@ -420,7 +322,7 @@ module stdlib_str2num
420322
end subroutine
421323

422324
#:if WITH_QP
423-
subroutine to_real_qp(s,v,p,stat)
325+
subroutine to_qp_base(s,v,p,stat)
424326
integer, parameter :: wp = qp
425327
!> Sequentially unroll the character and get the sub integers composing the whole number, fraction and exponent
426328
! -- In/out Variables
@@ -430,8 +332,8 @@ module stdlib_str2num
430332
integer(int8), intent(out) :: stat !> status upon success or failure to read
431333

432334
! -- Internal Variables
433-
integer(kind=ikind), parameter :: nwnb = 50 !> number of whole number factors
434-
integer(kind=ikind), parameter :: nfnb = 64 !> number of fractional number factors
335+
integer(int8), parameter :: nwnb = 50 !> number of whole number factors
336+
integer(int8), parameter :: nfnb = 64 !> number of fractional number factors
435337
integer :: e
436338
real(wp), parameter :: whole_number_base(nwnb) = [(10._wp**(nwnb-e),e=1,nwnb)]
437339
real(wp), parameter :: fractional_base(nfnb) = [(10._wp**(-e),e=1,nfnb)]
@@ -504,7 +406,7 @@ module stdlib_str2num
504406
do while( p<=len(s) )
505407
val = iachar(s(p:p))-digit_0
506408
if( val >= 0 .and. val <= 9) then
507-
i_exp = i_exp*10_ikind + val ; p = p + 1
409+
i_exp = i_exp*10_int8 + val ; p = p + 1
508410
else
509411
exit
510412
end if

0 commit comments

Comments
 (0)