Skip to content

Commit 94bf4a8

Browse files
jalveszjalvesz
committed
rewrite test_string_to_number using fypp for real kinds
1 parent b00895a commit 94bf4a8

File tree

1 file changed

+14
-201
lines changed

1 file changed

+14
-201
lines changed

‎test/string/test_string_to_number.fypp

Lines changed: 14 additions & 201 deletions
Original file line numberDiff line numberDiff line change
@@ -13,17 +13,19 @@ contains
1313
type(unittest_type), allocatable, intent(out) :: testsuite(:)
1414

1515
testsuite = [ &
16-
new_unittest("to_float", test_to_float), &
17-
new_unittest("to_double", test_to_double) &
16+
new_unittest("to_sp", test_to_sp), &
17+
new_unittest("to_dp", test_to_dp) &
1818
#:if WITH_QP
19-
, new_unittest("to_quadruple", test_to_quadruple) &
19+
, new_unittest("to_qp", test_to_qp) &
2020
#:endif
2121
]
2222
end subroutine collect_string_to_number
2323

24-
subroutine test_to_float(error)
24+
#:for k1, t1 in REAL_KINDS_TYPES
25+
#:if k1 != "xdp"
26+
subroutine test_to_${k1}$(error)
2527
type(error_type), allocatable, intent(out) :: error
26-
integer, parameter :: wp = sp
28+
integer, parameter :: wp = ${k1}$
2729

2830
call check(error, ucheck("1.234"))
2931
if (allocated(error)) return
@@ -109,204 +111,13 @@ contains
109111
abs_err = to_num_out - formatted_read_out
110112
rel_err = abs_err / formatted_read_out
111113

114+
#:if k1 == "sp"
112115
if(abs(rel_err) > 0.0_wp) then
113-
write(*,"('formatted read : ' g0)") formatted_read_out
114-
write(*,"('to_num : ' g0)") to_num_out
115-
write(*,"('difference abs : ' g0)") abs_err
116-
write(*,"('difference rel : ' g0 '%')") rel_err * 100
117-
ucheck = .false.
118-
end if
119-
end function
120-
end subroutine
121-
122-
subroutine test_to_double(error)
123-
type(error_type), allocatable, intent(out) :: error
124-
integer, parameter :: wp = dp
125-
126-
call check(error, ucheck("1.234"))
127-
if (allocated(error)) return
128-
129-
call check(error, ucheck("1.E1"))
130-
if (allocated(error)) return
131-
132-
call check(error, ucheck("1e0"))
133-
if (allocated(error)) return
134-
135-
call check(error, ucheck("0.1234E0"))
136-
if (allocated(error)) return
137-
138-
call check(error, ucheck("12.34E0"))
139-
if (allocated(error)) return
140-
141-
call check(error, ucheck("0.34E2"))
142-
if (allocated(error)) return
143-
144-
call check(error, ucheck(".34e0"))
145-
if (allocated(error)) return
146-
147-
call check(error, ucheck("34.E1"))
148-
if (allocated(error)) return
149-
150-
call check(error, ucheck("-34.5E1"))
151-
if (allocated(error)) return
152-
153-
call check(error, ucheck("0.0021E10"))
154-
if (allocated(error)) return
155-
156-
call check(error, ucheck("12.21e-1"))
157-
if (allocated(error)) return
158-
159-
call check(error, ucheck("12.21e+001 "))
160-
if (allocated(error)) return
161-
162-
call check(error, ucheck("-1"))
163-
if (allocated(error)) return
164-
165-
call check(error, ucheck(" -0.23317260678539647E-01 "))
166-
if (allocated(error)) return
167-
168-
call check(error, ucheck(" 2.5647869e-003 "//char(13)//char(10)))
169-
if (allocated(error)) return
170-
171-
call check(error, ucheck("1.-3"))
172-
if (allocated(error)) return
173-
174-
call check(error, ucheck("Inf"))
175-
if (allocated(error)) return
176-
177-
call check(error, ucheck("-Inf"))
178-
if (allocated(error)) return
179-
180-
call check(error, ucheck("NaN"))
181-
if (allocated(error)) return
182-
183-
call check(error, ucheck("0.123456789123456789123456789123456789"))
184-
if (allocated(error)) return
185-
186-
call check(error, ucheck("1234567890123456789012345678901234567890-9") )
187-
if (allocated(error)) return
188-
189-
call check(error, ucheck("123456.78901234567890123456789012345678901234567890+2") )
190-
if (allocated(error)) return
191-
192-
call check(error, ucheck("0.140129846432481707092372958328991613128026194187651577"//&
193-
& "175706828388979108268586060148663818836212158203125E-44"))
194-
if (allocated(error)) return
195-
196-
contains
197-
logical function ucheck(s)
198-
character(*), intent(in) :: s
199-
real(wp) :: formatted_read_out
200-
real(wp) :: to_num_out
201-
real(wp) :: abs_err
202-
real(wp) :: rel_err
203-
204-
ucheck = .true.
205-
read(s,*) formatted_read_out
206-
to_num_out = to_num(s, to_num_out)
207-
abs_err = to_num_out - formatted_read_out
208-
rel_err = abs_err / formatted_read_out
209-
116+
#:elif k1 == "dp"
210117
if(abs(rel_err) > epsilon(0.0_wp)) then
211-
write(*,"('formatted read : ' g0)") formatted_read_out
212-
write(*,"('to_num : ' g0)") to_num_out
213-
write(*,"('difference abs : ' g0)") abs_err
214-
write(*,"('difference rel : ' g0 '%')") rel_err * 100
215-
ucheck = .false.
216-
end if
217-
end function
218-
end subroutine
219-
220-
#:if WITH_QP
221-
subroutine test_to_quadruple(error)
222-
type(error_type), allocatable, intent(out) :: error
223-
integer, parameter :: wp = qp
224-
225-
call check(error, ucheck("1.234"))
226-
if (allocated(error)) return
227-
228-
call check(error, ucheck("1.E1"))
229-
if (allocated(error)) return
230-
231-
call check(error, ucheck("1e0"))
232-
if (allocated(error)) return
233-
234-
call check(error, ucheck("0.1234E0"))
235-
if (allocated(error)) return
236-
237-
call check(error, ucheck("12.34E0"))
238-
if (allocated(error)) return
239-
240-
call check(error, ucheck("0.34E2"))
241-
if (allocated(error)) return
242-
243-
call check(error, ucheck(".34e0"))
244-
if (allocated(error)) return
245-
246-
call check(error, ucheck("34.E1"))
247-
if (allocated(error)) return
248-
249-
call check(error, ucheck("-34.5E1"))
250-
if (allocated(error)) return
251-
252-
call check(error, ucheck("0.0021E10"))
253-
if (allocated(error)) return
254-
255-
call check(error, ucheck("12.21e-1"))
256-
if (allocated(error)) return
257-
258-
call check(error, ucheck("12.21e+001 "))
259-
if (allocated(error)) return
260-
261-
call check(error, ucheck("-1"))
262-
if (allocated(error)) return
263-
264-
call check(error, ucheck(" -0.23317260678539647E-01 "))
265-
if (allocated(error)) return
266-
267-
call check(error, ucheck(" 2.5647869e-003 "//char(13)//char(10)))
268-
if (allocated(error)) return
269-
270-
call check(error, ucheck("1.-3"))
271-
if (allocated(error)) return
272-
273-
call check(error, ucheck("Inf"))
274-
if (allocated(error)) return
275-
276-
call check(error, ucheck("-Inf"))
277-
if (allocated(error)) return
278-
279-
call check(error, ucheck("NaN"))
280-
if (allocated(error)) return
281-
282-
call check(error, ucheck("0.123456789123456789123456789123456789"))
283-
if (allocated(error)) return
284-
285-
call check(error, ucheck("1234567890123456789012345678901234567890-9") )
286-
if (allocated(error)) return
287-
288-
call check(error, ucheck("123456.78901234567890123456789012345678901234567890+2") )
289-
if (allocated(error)) return
290-
291-
call check(error, ucheck("0.140129846432481707092372958328991613128026194187651577"//&
292-
& "175706828388979108268586060148663818836212158203125E-44"))
293-
if (allocated(error)) return
294-
295-
contains
296-
logical function ucheck(s)
297-
character(*), intent(in) :: s
298-
real(wp) :: formatted_read_out
299-
real(wp) :: to_num_out
300-
real(wp) :: abs_err
301-
real(wp) :: rel_err
302-
303-
ucheck = .true.
304-
read(s,*) formatted_read_out
305-
to_num_out = to_num(s, to_num_out)
306-
abs_err = to_num_out - formatted_read_out
307-
rel_err = abs_err / formatted_read_out
308-
118+
#:elif k1 == "qp"
309119
if(abs(rel_err) > 200*epsilon(0.0_wp)) then
120+
#:endif
310121
write(*,"('formatted read : ' g0)") formatted_read_out
311122
write(*,"('to_num : ' g0)") to_num_out
312123
write(*,"('difference abs : ' g0)") abs_err
@@ -315,7 +126,9 @@ contains
315126
end if
316127
end function
317128
end subroutine
318-
#:endif
129+
130+
#:endif
131+
#:endfor
319132

320133
end module test_string_to_number
321134

0 commit comments

Comments
 (0)