blob: f7c8e53d6fd71e05665e7724c84bf80cf550c3d4 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
|
(import (scheme base)
(only (csc testing)
define-test
errorf
subtest)
(csc strings))
(define-test (test-str-prefix? t)
(define-record-type <test-case>
(test-case name prefix str want)
test-case?
(name name)
(prefix prefix)
(str str)
(want want))
(let ((tests (list
(test-case
"good"
"asdf"
"asdfjkl;"
#t)
(test-case
"bad"
"asdf"
"asdbjkl;"
#f)
(test-case
"too long"
"asdf"
"as"
#f))))
(for-each
(lambda (tc)
(subtest t (name tc)
(let ((got (str-prefix? (prefix tc) (str tc))))
(unless (eq? got (want tc))
(errorf t "(str-prefix? {} {}) = {}, want {}" (str-quote (prefix tc)) (str-quote (str tc)) got (want tc))))))
tests)))
(define-test (test-str-quote t)
(define-record-type <test-case>
(test-case name str want)
test-case?
(name name)
(str str)
(want want))
(let ((tests (list
(test-case
"simple"
"hello"
"\"hello\"")
(test-case
"escape"
"this string \" has a quote"
"\"this string \\\" has a quote\""))))
(for-each
(lambda (tc)
(subtest t (name tc)
(let ((got (str-quote (str tc))))
(unless (equal? got (want tc))
(errorf t "(str-quote {}) = {}, want {}" (str tc) (got tc) (want tc))))))
tests)))
(define-test (test-str-find t)
(define-record-type <test-case>
(test-case name match str want)
test-case?
(name name)
(match match)
(str str)
(want want))
(let ((tests (list
(test-case
"ok"
"abc"
"dabsadfdabcdfdfd"
8)
(test-case
"one letter"
"a"
"sdfdfdfsasdfe"
8))))
(for-each
(lambda (tc)
(subtest t (name tc)
(let ((got (str-find (match tc) (str tc))))
(unless (= got (want tc))
(errorf t "(str-find {} {}) = {}, want {}" (str-quote (match tc)) (str-quote (str tc)) got (want tc))))))
tests)))
(define-test (test-str-find-notfound t)
(let* ((match "a")
(str "def")
(got-exception '()))
(guard (e
((str-not-found-error? e) (set! got-exception e)))
(str-find match str))
(unless (str-not-found-error? got-exception)
(errorf t "str-find succeeded, wanted <str-not-found-error>"))))
|
