source: project/release/5/string-utils/trunk/tests/string-utils-test.scm @ 39995

Last change on this file since 39995 was 39995, checked in by Kon Lovett, 2 months ago

check for buffer overflow (module was supposed to be unsafe but bad idea), add test

File size: 4.8 KB
Line 
1;;;; string-utils-test.scm  -*- Scheme -*-
2;;;; Kon Lovett, Jul '18
3;;;; Kon Lovett, Oct '17
4
5(import scheme utf8)
6
7(import test)
8
9(test-begin "String Utils")
10
11;;;
12
13(import unicode-utils to-hex string-hexadecimal)
14
15(test-group "Unicode"
16  (test-assert (ascii-codepoint? #\a))
17  (test "abc" (unicode-string #\a #\b #\c))
18  (test "cebb" (string->hex (char->unicode-string #\u03BB)))
19  (test "cebbcebbcebb" (string->hex (unicode-string #\u03BB #\u03BB #\u03BB)))
20  (test "cebbcebb" (string->hex (unicode-make-string 2 #\u03BB)))
21)
22
23(import memoized-string)
24
25(test-group "Memoized"
26  (test "a" (make-string+ 1 #\a))
27  (define a5 (make-string+ 5 #\a))
28  (test "aaaaa" a5)
29  (define spc5 (make-string+ 5))
30  (test "     " spc5)
31  (test-assert (eq? a5 (make-string+ 5 #\a)))
32  (test-assert (eq? spc5 (make-string+ 5 #\space)))
33  (define tststr1 (string+ #\我 #\䜠))
34  (test "(string+ #\\我 #\\䜠)" tststr1 "我䜠")
35  (test-assert (eq? tststr1 (string+ #\我 #\䜠)))
36  (define tststr2 "䞊海的䞜西埈䟿宜")
37  (test-assert (eq? tststr2 (global-string tststr2)))
38)
39
40(import string-hexadecimal (chicken blob) (srfi 4))
41
42(test-group "To Hex"
43
44  (let* ((len 3) (t (make-string (* 2 len))))
45                (test-error (begin (blob_to_hex t (string->blob "12abc34") 2 (+ 2 len)) t)) )
46
47        (let* ((len 3) (t (make-string (* 2 len))))
48                (blob_to_hex t (string->blob "12abc34") 2 len)
49                (test "616263" t) )
50  ;
51        (let* ((len 3) (t (make-string (* 2 len))))
52                (u8vec_to_hex t (u8vector 1 2 #x61 #x62 #x63 3 4) 2 len)
53                (test "616263" t) )
54  ;
55        (let* ((len 2) (t (make-string (* 2 len))))
56                (s8vec_to_hex t (s8vector 1 2 -45 -54 3 4) 2 len)
57                (test "d3ca" t) )
58)
59
60(test-group "String -> Hex"
61        (test "616263" (string->hex "12abc34" 2 5))
62        (test "414243444546" (string->hex "ABCDEF"))
63        (test "4243444546" (string->hex "ABCDEF" 1))
64        (test "4243" (string->hex "ABCDEF" 1 3))
65)
66
67(test-group "Hex -> String"
68        (test "abc" (hex->string "616263"))
69        (test "ABCDEF" (hex->string "414243444546"))
70        (test "BCDEF" (hex->string "4243444546"))
71        (test "BC" (hex->string "4243"))
72        (test "jkL]" (hex->string "6a6B4c5D"))
73        (test-error (hex->string "424"))
74)
75
76;;
77
78(import string-interpolation)
79
80(test-group "String Interpolation"
81  (let ((res '(##sys#print-to-string (list "foo " (+ 1 2) " bar"))))
82    (test res (string-interpolate "foo #(+ 1 2) bar"))
83    (test res (string-interpolate "foo #(+ 1 2) bar"))
84    (test res (string-interpolate "foo ${(+ 1 2)} bar" eval-tag: #\$))
85    (test res (string-interpolate "foo $(+ 1 2) bar" eval-tag: #\$)) )
86)
87
88(import (prefix utf8-string-interpolation utf8::))
89
90(test-group "String Interpolation (UTF-8)"
91  (let ((res '(##sys#print-to-string (list "听诎䞊海的 " (+ 1 2) " 䞜西埈莵"))))
92    (test res (utf8::string-interpolate "听诎䞊海的 #(+ 1 2) 䞜西埈莵"))
93    (test res (utf8::string-interpolate "听诎䞊海的 #(+ 1 2) 䞜西埈莵"))
94    (test res (utf8::string-interpolate "听诎䞊海的 ${(+ 1 2)} 䞜西埈莵" eval-tag: #\$))
95    (test res (utf8::string-interpolate "听诎䞊海的 $(+ 1 2) 䞜西埈莵" eval-tag: #\$)) )
96)
97
98(import string-interpolation-syntax (chicken port))
99
100;must be "top level"; cannot be test-group
101(test-begin "String Interpolation Syntax")
102  (set-sharp-string-interpolation-syntax string-interpolate)
103  (test
104    '((##sys#print-to-string (list "foo " (+ 1 2) " bar")))
105    (list (call-with-input-string "#\"foo #{(+ 1 2)} bar\"" read)))
106  (set-sharp-string-interpolation-syntax #f)
107
108  (set-sharp-string-interpolation-syntax
109    (cute string-interpolate <> eval-tag: #\$))
110  (test
111    '((##sys#print-to-string (list "foo " (+ 1 2) " bar")))
112    (list (call-with-input-string "#\"foo ${(+ 1 2)} bar\"" read)))
113  (set-sharp-string-interpolation-syntax #f)
114(test-end "String Interpolation Syntax")
115
116;;
117
118(import string-utils)
119
120(test-group "string-utils"
121
122  (test "foo" (string-fixed-length "abcde" 1 #:trailing "foo"))
123  (test "a..." (string-fixed-length "abcde" 4))
124  (test "abc " (string-fixed-length "abc" 4))
125  (test "👀..." (string-fixed-length "👀👩👚📷📺" 4))
126  (test "👀👩🎑🎍" (string-fixed-length "👀👩👚📷📺" 4 #:trailing "🎑🎍"))
127  #; ;FIXME char is not 24-bit
128  (test "👀👩👚📷📺🎋" (string-fixed-length "👀👩👚📷📺" 6 #:pad-char #\U0001F38B))
129
130  (test "foo" (string-trim-whitespace-both "  foo \t \n  \r "))
131  (test "(a b)" (list-as-string '(a b)))
132  (test "...27" (number->padded-string 23 5 #\. 8))
133
134  (test "foobar" (string-longest-prefix "foobarbaz" '("foobaz" "foobar" "barbaz" "barfoo" "bazfoo")))
135  (test "barbaz" (string-longest-suffix "foobarbaz" '("foobaz" "foobar" "barbaz" "barfoo" "bazfoo")))
136
137  (test "fooba" (string-longest-common-prefix '("foobaz" "foobar")))
138  (test "foo" (string-longest-common-suffix '("bazfoo" "barfoo")))
139
140  (test "a.b,c" (apply string-zip (receive (string-unzip "a.b,c" ",."))))
141)
142
143;;;
144
145(test-end "String Utils")
146
147(test-exit)
Note: See TracBrowser for help on using the repository browser.