]> gitweb.factorcode.org Git - factor.git/blob - core/strings/strings-tests.factor
strings: a few more peace-of-mind tests setting out-of-range code points in strings
[factor.git] / core / strings / strings-tests.factor
1 USING: continuations kernel math math.order namespaces make
2 strings strings.private sbufs tools.test sequences vectors
3 arrays memory prettyprint io.streams.null ;
4 IN: strings.tests
5
6 [ CHAR: b ] [ 1 >bignum "abc" nth ] unit-test
7
8 [ ] [ 10 [ [ -1000000 <sbuf> ] ignore-errors ] times ] unit-test
9
10 [ "abc" ] [ [ "a" "b" "c" ] [ [ % ] each ] "" make ] unit-test
11
12 [ "abc" ] [ "ab" "c" append ] unit-test
13 [ "abc" ] [ "a" "b" "c" 3append ] unit-test
14
15 [ 3 ] [ "a" "hola" start ] unit-test
16 [ f ] [ "x" "hola" start ] unit-test
17 [ 0 ] [ "" "a" start ] unit-test
18 [ 0 ] [ "" "" start ] unit-test
19 [ 0 ] [ "hola" "hola" start ] unit-test
20 [ 1 ] [ "ol" "hola" start ] unit-test
21 [ f ] [ "amigo" "hola" start ] unit-test
22 [ f ] [ "holaa" "hola" start ] unit-test
23
24 [ "Beginning" ] [ "Beginning and end" 9 head ] unit-test
25
26 [ f ] [ CHAR: I "team" member? ] unit-test
27 [ t ] [ "ea" "team" subseq? ] unit-test
28 [ f ] [ "actore" "Factor" subseq? ] unit-test
29
30 [ "end" ] [ "Beginning and end" 14 tail ] unit-test
31
32 [ t ] [ "abc" "abd" before? ] unit-test
33 [ t ] [ "z" "abd" after? ] unit-test
34 [ "abc" ] [ "abc" "abd" min ] unit-test
35 [ "z" ] [ "z" "abd" max ] unit-test
36
37 [ 0 10 "hello" subseq ] must-fail
38
39 [ "Replacing+spaces+with+plus" ]
40 [
41     "Replacing spaces with plus"
42     [ dup CHAR: \s = [ drop CHAR: + ] when ] map
43 ]
44 unit-test
45
46 [ "05" ] [ "5" 2 CHAR: 0 pad-head ] unit-test
47 [ "666" ] [ "666" 2 CHAR: 0 pad-head ] unit-test
48
49 [ 1 "" nth ] must-fail
50 [ -6 "hello" nth ] must-fail
51
52 [ t ] [ "hello world" dup >vector >string = ] unit-test 
53
54 [ "ab" ] [ 2 "abc" resize-string ] unit-test
55 [ "abc\0\0\0" ] [ 6 "abc" resize-string ] unit-test
56
57 [ "\u001234b" ] [ 2 "\u001234bc" resize-string ] unit-test
58 [ "\u001234bc\0\0\0" ] [ 6 "\u001234bc" resize-string ] unit-test
59
60 ! Random tester found this
61 [ 2 -7 resize-string ] [ { "kernel-error" 3 11 -7 } = ] must-fail-with
62
63 ! Make sure 24-bit strings work
64 "hello world" "s" set
65
66 [ ] [ HEX: 1234 1 "s" get set-nth ] unit-test
67 [ ] [ HEX: 4321 3 "s" get set-nth ] unit-test
68 [ ] [ HEX: 654321 5 "s" get set-nth ] unit-test
69
70 [ ] [ HEX: -1 5 "s" get set-nth ] unit-test
71 [ ] [ HEX: 80,0000 5 "s" get set-nth ] unit-test
72 [ ] [ HEX: 100,0000 5 "s" get set-nth ] unit-test
73
74 [
75     {
76         CHAR: h
77         HEX: 1234
78         CHAR: l
79         HEX: 4321
80         CHAR: o
81         HEX: 654321
82         CHAR: w
83         CHAR: o
84         CHAR: r
85         CHAR: l
86         CHAR: d
87     }
88 ] [
89     "s" get >array
90 ] unit-test
91
92 ! Make sure string initialization works
93 [ HEX: 123456 ] [ 100 HEX: 123456 <string> first ] unit-test
94
95 ! Make sure we clear aux vector when storing octets
96 [ "\u123456hi" ] [ "ih\u123456" clone reverse! ] unit-test
97
98 ! Make sure aux vector is not shared
99 [ "\udeadbe" ] [
100     "\udeadbe" clone
101     CHAR: \u123456 over clone set-first
102 ] unit-test
103
104 ! Regressions
105 [ ] [
106     [
107         4 [
108             100 [ "obdurak" clone ] replicate
109             gc
110             dup [
111                 1234 0 rot set-string-nth
112             ] each
113             1000 [
114                 1000 f <array> drop
115             ] times
116             .
117         ] times
118     ] with-null-writer
119 ] unit-test
120
121 [ t ] [
122     10000 [
123         drop
124         300 100 CHAR: \u123456
125         [ <string> clone resize-string first ] keep =
126     ] all-integers?
127 ] unit-test