Skip to content

Commit cbb8b37

Browse files
awvwgkawvwgk
committed
Rewrite string testsuites
1 parent d591157 commit cbb8b37

8 files changed

+1472
-733
lines changed

‎src/tests/string/test_string_assignment.f90

Lines changed: 85 additions & 40 deletions
Original file line numberDiff line numberDiff line change
@@ -1,72 +1,117 @@
11
! SPDX-Identifier: MIT
22
module test_string_assignment
3-
use stdlib_error, only : check
3+
use stdlib_test, only : new_unittest, unittest_type, error_type, check
44
use stdlib_kinds, only : int8, int16, int32, int64, lk, c_bool
55
use stdlib_string_type, only : string_type, assignment(=), operator(==), len
66
implicit none
77

88
contains
99

10-
subroutine test_assignment
10+
!> Collect all exported unit tests
11+
subroutine collect_string_assignment(testsuite)
12+
!> Collection of tests
13+
type(unittest_type), allocatable, intent(out) :: testsuite(:)
14+
15+
testsuite = [ &
16+
new_unittest("assignment", test_assignment), &
17+
new_unittest("constructor", test_constructor) &
18+
]
19+
end subroutine collect_string_assignment
20+
21+
subroutine test_assignment(error)
22+
!> Error handling
23+
type(error_type), allocatable, intent(out) :: error
1124
type(string_type) :: string
1225

13-
call check(len(string) == 0)
26+
call check(error, len(string) == 0)
27+
if (allocated(error)) return
1428

1529
string = "Sequence"
16-
call check(len(string) == 8)
30+
call check(error, len(string) == 8)
1731
end subroutine test_assignment
1832

19-
subroutine test_char_value
20-
character(len=128) :: flc
33+
subroutine test_constructor(error)
34+
!> Error handling
35+
type(error_type), allocatable, intent(out) :: error
36+
character(len=128) :: flc
2137

22-
write(flc, '(g0)') -1026191
23-
call check(string_type(-1026191) == trim(flc))
38+
write(flc, '(g0)') -1026191
39+
call check(error, string_type(-1026191) == trim(flc))
40+
if (allocated(error)) return
2441

25-
write(flc, '(g0)') 124787
26-
call check(string_type(124787) == trim(flc))
42+
write(flc, '(g0)') 124787
43+
call check(error, string_type(124787) == trim(flc))
44+
if (allocated(error)) return
2745

28-
write(flc, '(g0)') -2_int8
29-
call check(string_type(-2_int8) == trim(flc))
46+
write(flc, '(g0)') -2_int8
47+
call check(error, string_type(-2_int8) == trim(flc))
48+
if (allocated(error)) return
3049

31-
write(flc, '(g0)') 5_int8
32-
call check(string_type(5_int8) == trim(flc))
50+
write(flc, '(g0)') 5_int8
51+
call check(error, string_type(5_int8) == trim(flc))
52+
if (allocated(error)) return
3353

34-
write(flc, '(g0)') -72_int16
35-
call check(string_type(-72_int16) == trim(flc))
54+
write(flc, '(g0)') -72_int16
55+
call check(error, string_type(-72_int16) == trim(flc))
56+
if (allocated(error)) return
3657

37-
write(flc, '(g0)') -8924889_int32
38-
call check(string_type(-8924889_int32) == trim(flc))
58+
write(flc, '(g0)') -8924889_int32
59+
call check(error, string_type(-8924889_int32) == trim(flc))
60+
if (allocated(error)) return
3961

40-
write(flc, '(g0)') 2378405_int32
41-
call check(string_type(2378405_int32) == trim(flc))
62+
write(flc, '(g0)') 2378405_int32
63+
call check(error, string_type(2378405_int32) == trim(flc))
64+
if (allocated(error)) return
4265

43-
write(flc, '(g0)') 921092378411_int64
44-
call check(string_type(921092378411_int64) == trim(flc))
66+
write(flc, '(g0)') 921092378411_int64
67+
call check(error, string_type(921092378411_int64) == trim(flc))
68+
if (allocated(error)) return
4569

46-
write(flc, '(g0)') -1272835761_int64
47-
call check(string_type(-1272835761_int64) == trim(flc))
70+
write(flc, '(g0)') -1272835761_int64
71+
call check(error, string_type(-1272835761_int64) == trim(flc))
72+
if (allocated(error)) return
4873

49-
write(flc, '(g0)') .true.
50-
call check(string_type(.true.) == trim(flc))
74+
write(flc, '(g0)') .true.
75+
call check(error, string_type(.true.) == trim(flc))
76+
if (allocated(error)) return
5177

52-
write(flc, '(g0)') .false.
53-
call check(string_type(.false.) == trim(flc))
78+
write(flc, '(g0)') .false.
79+
call check(error, string_type(.false.) == trim(flc))
80+
if (allocated(error)) return
5481

55-
write(flc, '(g0)') .false._c_bool
56-
call check(string_type(.false._c_bool) == trim(flc))
82+
write(flc, '(g0)') .false._c_bool
83+
call check(error, string_type(.false._c_bool) == trim(flc))
84+
if (allocated(error)) return
5785

58-
write(flc, '(g0)') .true._lk
59-
call check(string_type(.true._lk) == trim(flc))
60-
end subroutine test_char_value
86+
write(flc, '(g0)') .true._lk
87+
call check(error, string_type(.true._lk) == trim(flc))
88+
end subroutine test_constructor
6189

6290
end module test_string_assignment
6391

92+
6493
program tester
65-
use test_string_assignment
94+
use, intrinsic :: iso_fortran_env, only : error_unit
95+
use stdlib_test, only : run_testsuite, new_testsuite, testsuite_type
96+
use test_string_assignment, only : collect_string_assignment
6697
implicit none
67-
68-
call test_assignment
69-
call test_char_value
70-
71-
end program tester
72-
98+
integer :: stat, is
99+
type(testsuite_type), allocatable :: testsuites(:)
100+
character(len=*), parameter :: fmt = '("#", *(1x, a))'
101+
102+
stat = 0
103+
104+
testsuites = [ &
105+
new_testsuite("string-assignment", collect_string_assignment) &
106+
]
107+
108+
do is = 1, size(testsuites)
109+
write(error_unit, fmt) "Testing:", testsuites(is)%name
110+
call run_testsuite(testsuites(is)%collect, error_unit, stat)
111+
end do
112+
113+
if (stat > 0) then
114+
write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!"
115+
error stop
116+
end if
117+
end program

‎src/tests/string/test_string_derivedtype_io.f90

Lines changed: 63 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -1,14 +1,29 @@
11
! SPDX-Identifer: MIT
22
module test_string_derivedtype_io
3-
use stdlib_error, only : check
3+
use stdlib_test, only : new_unittest, unittest_type, error_type, check
44
use stdlib_string_type, only : string_type, assignment(=), len, &
55
write(formatted), read(formatted), write(unformatted), read(unformatted), &
66
operator(==)
77
implicit none
88

99
contains
1010

11-
subroutine test_listdirected_io
11+
!> Collect all exported unit tests
12+
subroutine collect_string_derivedtype_io(testsuite)
13+
!> Collection of tests
14+
type(unittest_type), allocatable, intent(out) :: testsuite(:)
15+
16+
testsuite = [ &
17+
new_unittest("listdirected_io", test_listdirected_io), &
18+
new_unittest("formatted_io", test_formatted_io), &
19+
new_unittest("unformatted_io", test_unformatted_io) &
20+
]
21+
end subroutine collect_string_derivedtype_io
22+
23+
subroutine test_listdirected_io(error)
24+
!> Error handling
25+
type(error_type), allocatable, intent(out) :: error
26+
1227
type(string_type) :: string
1328
integer :: io, stat
1429
string = "Important saved value"
@@ -23,18 +38,22 @@ subroutine test_listdirected_io
2338
read(io, *, iostat=stat) string
2439
close(io)
2540

26-
call check(stat == 0)
27-
call check(len(string) == 21)
28-
call check(string == "Important saved value")
41+
call check(error, stat == 0)
42+
if (allocated(error)) return
43+
call check(error, len(string) == 21)
44+
if (allocated(error)) return
45+
call check(error, string == "Important saved value")
2946
end subroutine test_listdirected_io
3047

31-
subroutine test_formatted_io
48+
subroutine test_formatted_io(error)
49+
!> Error handling
50+
type(error_type), allocatable, intent(out) :: error
51+
3252
type(string_type) :: string
3353
integer :: io, stat
3454
string = "Important saved value"
3555

36-
!open(newunit=io, form="formatted", status="scratch")
37-
open(newunit=io, form="formatted", file="scratch.txt")
56+
open(newunit=io, form="formatted", status="scratch")
3857
write(io, '(dt)') string
3958
write(io, '(a)') ! Pad with a newline or we might run into EOF while reading
4059

@@ -44,12 +63,17 @@ subroutine test_formatted_io
4463
read(io, *, iostat=stat) string
4564
close(io)
4665

47-
call check(stat == 0)
48-
call check(len(string) == 21)
49-
call check(string == "Important saved value")
66+
call check(error, stat == 0)
67+
if (allocated(error)) return
68+
call check(error, len(string) == 21)
69+
if (allocated(error)) return
70+
call check(error, string == "Important saved value")
5071
end subroutine test_formatted_io
5172

52-
subroutine test_unformatted_io
73+
subroutine test_unformatted_io(error)
74+
!> Error handling
75+
type(error_type), allocatable, intent(out) :: error
76+
5377
type(string_type) :: string
5478
integer :: io
5579
string = "Important saved value"
@@ -63,18 +87,36 @@ subroutine test_unformatted_io
6387
read(io) string
6488
close(io)
6589

66-
call check(len(string) == 21)
67-
call check(string == "Important saved value")
90+
call check(error, len(string) == 21)
91+
if (allocated(error)) return
92+
call check(error, string == "Important saved value")
6893
end subroutine test_unformatted_io
6994

7095
end module test_string_derivedtype_io
7196

97+
7298
program tester
73-
use test_string_derivedtype_io
99+
use, intrinsic :: iso_fortran_env, only : error_unit
100+
use stdlib_test, only : run_testsuite, new_testsuite, testsuite_type
101+
use test_string_derivedtype_io, only : collect_string_derivedtype_io
74102
implicit none
75-
76-
call test_listdirected_io
77-
call test_formatted_io
78-
call test_unformatted_io
79-
80-
end program tester
103+
integer :: stat, is
104+
type(testsuite_type), allocatable :: testsuites(:)
105+
character(len=*), parameter :: fmt = '("#", *(1x, a))'
106+
107+
stat = 0
108+
109+
testsuites = [ &
110+
new_testsuite("string-derivedtype-io", collect_string_derivedtype_io) &
111+
]
112+
113+
do is = 1, size(testsuites)
114+
write(error_unit, fmt) "Testing:", testsuites(is)%name
115+
call run_testsuite(testsuites(is)%collect, error_unit, stat)
116+
end do
117+
118+
if (stat > 0) then
119+
write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!"
120+
error stop
121+
end if
122+
end program

0 commit comments

Comments
 (0)