Skip to content

Commit 9e15dd5

Browse files
awvwgkawvwgk
committed
Add generated tests to cover more generic test cases
1 parent 738fcd3 commit 9e15dd5

File tree

1 file changed

+251
-1
lines changed

1 file changed

+251
-1
lines changed

‎src/tests/string/test_string_intrinsic.f90

Lines changed: 251 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -4,8 +4,100 @@ module test_string_intrinsic
44
use stdlib_string_type
55
implicit none
66

7+
abstract interface
8+
!> Actual tester working on a string type and a fixed length character
9+
!> representing the same character sequence
10+
subroutine check1_interface(str1, chr1)
11+
import :: string_type
12+
type(string_type), intent(in) :: str1
13+
character(len=*), intent(in) :: chr1
14+
end subroutine check1_interface
15+
16+
!> Actual tester working on two pairs of string type and fixed length
17+
!> character representing the same character sequences
18+
subroutine check2_interface(str1, chr1, str2, chr2)
19+
import :: string_type
20+
type(string_type), intent(in) :: str1, str2
21+
character(len=*), intent(in) :: chr1, chr2
22+
end subroutine check2_interface
23+
end interface
24+
725
contains
826

27+
!> Generate then checker both for the string type created from the character
28+
!> sequence by the contructor and the assignment operation
29+
subroutine check1(chr1, checker)
30+
character(len=*), intent(in) :: chr1
31+
procedure(check1_interface) :: checker
32+
call constructor_check1(chr1, checker)
33+
call assignment_check1(chr1, checker)
34+
end subroutine check1
35+
36+
!> Run the actual checker with a string type generated by the custom constructor
37+
subroutine constructor_check1(chr1, checker)
38+
character(len=*), intent(in) :: chr1
39+
procedure(check1_interface) :: checker
40+
call checker(string_type(chr1), chr1)
41+
end subroutine constructor_check1
42+
43+
!> Run the actual checker with a string type generated by assignment
44+
subroutine assignment_check1(chr1, checker)
45+
character(len=*), intent(in) :: chr1
46+
type(string_type) :: str1
47+
procedure(check1_interface) :: checker
48+
str1 = chr1
49+
call checker(str1, chr1)
50+
end subroutine assignment_check1
51+
52+
!> Generate then checker both for the string type created from the character
53+
!> sequence by the contructor and the assignment operation as well as the
54+
!> mixed assigment and constructor setup
55+
subroutine check2(chr1, chr2, checker)
56+
character(len=*), intent(in) :: chr1, chr2
57+
procedure(check2_interface) :: checker
58+
call constructor_check2(chr1, chr2, checker)
59+
call assignment_check2(chr1, chr2, checker)
60+
call mixed_check2(chr1, chr2, checker)
61+
end subroutine check2
62+
63+
!> Run the actual checker with both string types generated by the custom constructor
64+
subroutine constructor_check2(chr1, chr2, checker)
65+
character(len=*), intent(in) :: chr1, chr2
66+
procedure(check2_interface) :: checker
67+
call checker(string_type(chr1), chr1, string_type(chr2), chr2)
68+
end subroutine constructor_check2
69+
70+
!> Run the actual checker with one string type generated by the custom constructor
71+
!> and the other by assignment
72+
subroutine mixed_check2(chr1, chr2, checker)
73+
character(len=*), intent(in) :: chr1, chr2
74+
type(string_type) :: str1, str2
75+
procedure(check2_interface) :: checker
76+
str1 = chr1
77+
str2 = chr2
78+
call checker(str1, chr1, string_type(chr2), chr2)
79+
call checker(string_type(chr1), chr1, str2, chr2)
80+
end subroutine mixed_check2
81+
82+
!> Run the actual checker with both string types generated by assignment
83+
subroutine assignment_check2(chr1, chr2, checker)
84+
character(len=*), intent(in) :: chr1, chr2
85+
type(string_type) :: str1, str2
86+
procedure(check2_interface) :: checker
87+
str1 = chr1
88+
str2 = chr2
89+
call checker(str1, chr1, str2, chr2)
90+
end subroutine assignment_check2
91+
92+
!> Generator for checking the lexical comparison
93+
subroutine gen_lgt(str1, chr1, str2, chr2)
94+
type(string_type), intent(in) :: str1, str2
95+
character(len=*), intent(in) :: chr1, chr2
96+
call check(lgt(str1, str2) .eqv. lgt(chr1, chr2))
97+
call check(lgt(str1, chr2) .eqv. lgt(chr1, chr2))
98+
call check(lgt(chr1, str2) .eqv. lgt(chr1, chr2))
99+
end subroutine gen_lgt
100+
9101
subroutine test_lgt
10102
type(string_type) :: string
11103
logical :: res
@@ -19,8 +111,21 @@ subroutine test_lgt
19111

20112
res = lgt(string, "cde")
21113
call check(res .eqv. .false.)
114+
115+
call check2("bcd", "abc", gen_lgt)
116+
call check2("bcd", "bcd", gen_lgt)
117+
call check2("bcd", "cde", gen_lgt)
22118
end subroutine test_lgt
23119

120+
!> Generator for checking the lexical comparison
121+
subroutine gen_llt(str1, chr1, str2, chr2)
122+
type(string_type), intent(in) :: str1, str2
123+
character(len=*), intent(in) :: chr1, chr2
124+
call check(llt(str1, str2) .eqv. llt(chr1, chr2))
125+
call check(llt(str1, chr2) .eqv. llt(chr1, chr2))
126+
call check(llt(chr1, str2) .eqv. llt(chr1, chr2))
127+
end subroutine gen_llt
128+
24129
subroutine test_llt
25130
type(string_type) :: string
26131
logical :: res
@@ -34,8 +139,21 @@ subroutine test_llt
34139

35140
res = llt(string, "cde")
36141
call check(res .eqv. .true.)
142+
143+
call check2("bcd", "abc", gen_llt)
144+
call check2("bcd", "bcd", gen_llt)
145+
call check2("bcd", "cde", gen_llt)
37146
end subroutine test_llt
38147

148+
!> Generator for checking the lexical comparison
149+
subroutine gen_lge(str1, chr1, str2, chr2)
150+
type(string_type), intent(in) :: str1, str2
151+
character(len=*), intent(in) :: chr1, chr2
152+
call check(lge(str1, str2) .eqv. lge(chr1, chr2))
153+
call check(lge(str1, chr2) .eqv. lge(chr1, chr2))
154+
call check(lge(chr1, str2) .eqv. lge(chr1, chr2))
155+
end subroutine gen_lge
156+
39157
subroutine test_lge
40158
type(string_type) :: string
41159
logical :: res
@@ -49,8 +167,21 @@ subroutine test_lge
49167

50168
res = lge(string, "cde")
51169
call check(res .eqv. .false.)
170+
171+
call check2("bcd", "abc", gen_lge)
172+
call check2("bcd", "bcd", gen_lge)
173+
call check2("bcd", "cde", gen_lge)
52174
end subroutine test_lge
53175

176+
!> Generator for checking the lexical comparison
177+
subroutine gen_lle(str1, chr1, str2, chr2)
178+
type(string_type), intent(in) :: str1, str2
179+
character(len=*), intent(in) :: chr1, chr2
180+
call check(lle(str1, str2) .eqv. lle(chr1, chr2))
181+
call check(lle(str1, chr2) .eqv. lle(chr1, chr2))
182+
call check(lle(chr1, str2) .eqv. lle(chr1, chr2))
183+
end subroutine gen_lle
184+
54185
subroutine test_lle
55186
type(string_type) :: string
56187
logical :: res
@@ -64,16 +195,39 @@ subroutine test_lle
64195

65196
res = lle(string, "cde")
66197
call check(res .eqv. .true.)
198+
199+
call check2("bcd", "abc", gen_lle)
200+
call check2("bcd", "bcd", gen_lle)
201+
call check2("bcd", "cde", gen_lle)
67202
end subroutine test_lle
68203

204+
!> Generator for checking the trimming of whitespace
205+
subroutine gen_trim(str1, chr1)
206+
type(string_type), intent(in) :: str1
207+
character(len=*), intent(in) :: chr1
208+
call check(len(trim(str1)) == len(trim(chr1)))
209+
end subroutine gen_trim
210+
69211
subroutine test_trim
70212
type(string_type) :: string, trimmed_str
71213

72214
string = "Whitespace "
73215
trimmed_str = trim(string)
74216
call check(len(trimmed_str) == 10)
217+
218+
call check1(" Whitespace ", gen_trim)
219+
call check1(" W h i t e s p a ce ", gen_trim)
220+
call check1("SPACE SPACE", gen_trim)
221+
call check1(" ", gen_trim)
75222
end subroutine test_trim
76223

224+
!> Generator for checking the length of the character sequence
225+
subroutine gen_len(str1, chr1)
226+
type(string_type), intent(in) :: str1
227+
character(len=*), intent(in) :: chr1
228+
call check(len(str1) == len(chr1))
229+
end subroutine gen_len
230+
77231
subroutine test_len
78232
type(string_type) :: string
79233
integer :: length
@@ -85,8 +239,20 @@ subroutine test_len
85239
string = "Whitespace "
86240
length = len(string)
87241
call check(length == 38)
242+
243+
call check1("Example string", gen_len)
244+
call check1("S P A C E D S T R I N G", gen_len)
245+
call check1("With trailing whitespace ", gen_len)
246+
call check1(" centered ", gen_len)
88247
end subroutine test_len
89248

249+
!> Generator for checking the length of the character sequence without whitespace
250+
subroutine gen_len_trim(str1, chr1)
251+
type(string_type), intent(in) :: str1
252+
character(len=*), intent(in) :: chr1
253+
call check(len_trim(str1) == len_trim(chr1))
254+
end subroutine gen_len_trim
255+
90256
subroutine test_len_trim
91257
type(string_type) :: string
92258
integer :: length
@@ -98,24 +264,59 @@ subroutine test_len_trim
98264
string = "Whitespace "
99265
length = len_trim(string)
100266
call check(length == 10)
267+
268+
call check1("Example string", gen_len_trim)
269+
call check1("S P A C E D S T R I N G", gen_len_trim)
270+
call check1("With trailing whitespace ", gen_len_trim)
271+
call check1(" centered ", gen_len_trim)
101272
end subroutine test_len_trim
102273

274+
!> Generator for checking the left adjustment of the character sequence
275+
subroutine gen_adjustl(str1, chr1)
276+
type(string_type), intent(in) :: str1
277+
character(len=*), intent(in) :: chr1
278+
call check(adjustl(str1) == adjustl(chr1))
279+
end subroutine gen_adjustl
280+
103281
subroutine test_adjustl
104282
type(string_type) :: string
105283

106284
string = " Whitespace"
107285
string = adjustl(string)
108286
call check(char(string) == "Whitespace ")
287+
288+
call check1(" B L A N K S ", gen_adjustl)
109289
end subroutine test_adjustl
110290

291+
!> Generator for checking the right adjustment of the character sequence
292+
subroutine gen_adjustr(str1, chr1)
293+
type(string_type), intent(in) :: str1
294+
character(len=*), intent(in) :: chr1
295+
call check(adjustr(str1) == adjustr(chr1))
296+
end subroutine gen_adjustr
297+
111298
subroutine test_adjustr
112299
type(string_type) :: string
113300

114301
string = "Whitespace "
115302
string = adjustr(string)
116303
call check(char(string) == " Whitespace")
304+
305+
call check1(" B L A N K S ", gen_adjustr)
117306
end subroutine test_adjustr
118307

308+
!> Generator for checking the presence of a character set in a character sequence
309+
subroutine gen_scan(str1, chr1, str2, chr2)
310+
type(string_type), intent(in) :: str1, str2
311+
character(len=*), intent(in) :: chr1, chr2
312+
call check(scan(str1, str2) == scan(chr1, chr2))
313+
call check(scan(str1, chr2) == scan(chr1, chr2))
314+
call check(scan(chr1, str2) == scan(chr1, chr2))
315+
call check(scan(str1, str2, back=.true.) == scan(chr1, chr2, back=.true.))
316+
call check(scan(str1, chr2, back=.true.) == scan(chr1, chr2, back=.true.))
317+
call check(scan(chr1, str2, back=.true.) == scan(chr1, chr2, back=.true.))
318+
end subroutine gen_scan
319+
119320
subroutine test_scan
120321
type(string_type) :: string
121322
integer :: pos
@@ -129,8 +330,24 @@ subroutine test_scan
129330

130331
pos = scan(string, "c++")
131332
call check(pos == 0)
333+
334+
call check2("fortran", "ao", gen_scan)
335+
call check2("c++", "fortran", gen_scan)
336+
132337
end subroutine test_scan
133338

339+
!> Generator for checking the absence of a character set in a character sequence
340+
subroutine gen_verify(str1, chr1, str2, chr2)
341+
type(string_type), intent(in) :: str1, str2
342+
character(len=*), intent(in) :: chr1, chr2
343+
call check(verify(str1, str2) == verify(chr1, chr2))
344+
call check(verify(str1, chr2) == verify(chr1, chr2))
345+
call check(verify(chr1, str2) == verify(chr1, chr2))
346+
call check(verify(str1, str2, back=.true.) == verify(chr1, chr2, back=.true.))
347+
call check(verify(str1, chr2, back=.true.) == verify(chr1, chr2, back=.true.))
348+
call check(verify(chr1, str2, back=.true.) == verify(chr1, chr2, back=.true.))
349+
end subroutine gen_verify
350+
134351
subroutine test_verify
135352
type(string_type) :: string
136353
integer :: pos
@@ -150,16 +367,46 @@ subroutine test_verify
150367

151368
pos = verify(string, string)
152369
call check(pos == 0)
370+
371+
call check2("fortran", "ao", gen_verify)
372+
call check2("c++", "fortran", gen_verify)
373+
153374
end subroutine test_verify
154375

376+
!> Generator for the repeatition of a character sequence
377+
subroutine gen_repeat(str1, chr1)
378+
type(string_type), intent(in) :: str1
379+
character(len=*), intent(in) :: chr1
380+
integer :: i
381+
do i = 12, 3, -2
382+
call check(repeat(str1, i) == repeat(chr1, i))
383+
end do
384+
end subroutine gen_repeat
385+
155386
subroutine test_repeat
156387
type(string_type) :: string
157388

158389
string = "What? "
159390
string = repeat(string, 3)
160391
call check(string == "What? What? What? ")
392+
393+
call check1("!!1!", gen_repeat)
394+
call check1("This sentence is repeated multiple times. ", gen_repeat)
395+
161396
end subroutine test_repeat
162397

398+
!> Generator for checking the substring search in a character string
399+
subroutine gen_index(str1, chr1, str2, chr2)
400+
type(string_type), intent(in) :: str1, str2
401+
character(len=*), intent(in) :: chr1, chr2
402+
call check(index(str1, str2) == index(chr1, chr2))
403+
call check(index(str1, chr2) == index(chr1, chr2))
404+
call check(index(chr1, str2) == index(chr1, chr2))
405+
call check(index(str1, str2, back=.true.) == index(chr1, chr2, back=.true.))
406+
call check(index(str1, chr2, back=.true.) == index(chr1, chr2, back=.true.))
407+
call check(index(chr1, str2, back=.true.) == index(chr1, chr2, back=.true.))
408+
end subroutine gen_index
409+
163410
subroutine test_index
164411
type(string_type) :: string
165412
integer :: pos
@@ -173,6 +420,10 @@ subroutine test_index
173420

174421
pos = index(string, "This")
175422
call check(pos == 0)
423+
424+
call check2("Search this string for this expression", "this", gen_index)
425+
call check2("Search this string for this expression", "This", gen_index)
426+
176427
end subroutine test_index
177428

178429
subroutine test_char
@@ -236,4 +487,3 @@ program tester
236487
call test_iachar
237488

238489
end program tester
239-

0 commit comments

Comments
 (0)