1:
2:
3:
4:
5: (use gauche.test)
6: (test-start "text utilities")
7:
8:
9: (test-section "csv")
10: (use text.csv)
11: (test-module 'text.csv)
12:
13: (test* "csv-reader" '("abc" "def" "" "ghi")
14: (call-with-input-string "abc , def ,, ghi "
15: (make-csv-reader #\,)))
16:
17: (test* "csv-reader" '("abc" "def" "" ", ghi")
18: (call-with-input-string "abc : def :: , ghi "
19: (make-csv-reader #\:)))
20:
21: (test* "csv-reader" '("abc" "def" "ghi")
22: (call-with-input-string "abc , \"def\" , \"ghi\" "
23: (make-csv-reader #\,)))
24:
25: (test* "csv-reader" '("abc" " de,f " "gh\ni" "jkl")
26: (call-with-input-string " abc, \" de,f \" , \"gh\ni\", \"jkl\""
27: (make-csv-reader #\,)))
28:
29: (test* "csv-reader" '("ab\nc" "de \n\n \nf " "" "" "gh\"\n\"i")
30: (call-with-input-string " \"ab\nc\" , \"de \n\n \nf \" , , \"\" , \"gh\"\"\n\"\"i\""
31: (make-csv-reader #\,)))
32:
33: (test* "csv-reader" *test-error*
34: (call-with-input-string " abc, def , \"ghi\"\"\n\n"
35: (make-csv-reader #\,)))
36:
37: (test* "csv-reader" #t
38: (eof-object?
39: (call-with-input-string "" (make-csv-reader #\,))))
40:
41: (test* "csv-writer"
42: "abc,def,123,\"what's up?\",\"he said, \"\"nothing new.\"\"\"\n"
43: (call-with-output-string
44: (lambda (out)
45: ((make-csv-writer #\,)
46: out
47: '("abc" "def" "123" "what's up?" "he said, \"nothing new.\""))))
48: )
49:
50: (test* "csv-writer"
51: "abc,def,123,\"what's up?\",\"he said, \"\"nothing new.\"\"\"\r\n"
52: (call-with-output-string
53: (lambda (out)
54: ((make-csv-writer #\, "\r\n")
55: out
56: '("abc" "def" "123" "what's up?" "he said, \"nothing new.\""))))
57: )
58:
59: (test* "csv-writer" "\n"
60: (call-with-output-string
61: (lambda (out)
62: ((make-csv-writer #\,) out '()))))
63:
64:
65: (test-section "diff")
66: (use text.diff)
67: (test-module 'text.diff)
68:
69: (define diff-a "foo
70: bar
71: bar
72: baz
73: baz
74: hoge
75: ")
76: (define diff-b "foo
77: bar
78: baz
79: fuga
80: hoge
81: fuga
82: ")
83:
84: (test* "diff-report"
85: " foo\n bar\n- bar\n baz\n- baz\n+ fuga\n hoge\n+ fuga\n"
86: (with-output-to-string
87: (lambda () (diff-report diff-a diff-b))))
88:
89:
90: (test-section "html-lite")
91: (use text.html-lite)
92: (use srfi-13)
93: (test-module 'text.html-lite)
94:
95: (test* "html-escape-string"
96: "<a href="http://abc/def?ghi&jkl">"
97: (html-escape-string "<a href=\"http://abc/def?ghi&jkl\">"))
98:
99: (test* "html-escape-string"
100: "<class>"
101: (html-escape-string '<class>))
102:
103: (test* "html-doctype"
104: '("<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01//EN\""
105: "\"http://www.w3.org/TR/html4/strict.dtd\">" "")
106: (map string-trim-both (string-split (html-doctype) #\newline)))
107:
108: (test* "html-doctype"
109: '("<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\""
110: "\"http://www.w3.org/TR/html4/loose.dtd\">" "")
111: (map string-trim-both
112: (string-split (html-doctype :type :transitional) #\newline)))
113:
114: (test* "html-doctype"
115: '("<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Frameset//EN\""
116: "\"http://www.w3.org/TR/html4/frameset.dtd\">" "")
117: (map string-trim-both
118: (string-split (html-doctype :type :frameset) #\newline)))
119:
120: (test* "html-doctype"
121: '("<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\""
122: "\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">" "")
123: (map string-trim-both
124: (string-split (html-doctype :type :xhtml-1.0) #\newline)))
125:
126: (use srfi-13)
127:
128: (let ()
129:
130: (define (tos x) (string-delete (string-downcase (x->string x)) #\newline))
131: (define (flatten-rec x r)
132: (cond ((null? x) r)
133: ((not (pair? x)) (cons (tos x) r))
134: ((pair? (car x))
135: (flatten-rec (cdr x) (flatten-rec (car x) r)))
136: ((null? (car x)) (flatten-rec (cdr x) r))
137: (else (flatten-rec (cdr x) (cons (tos (car x)) r)))))
138: (define (flatten x) (string-concatenate-reverse (flatten-rec x '())))
139:
140: (test* "html, head, body"
141: "<html><head><title>foo</title></head><body>foo</body></html>"
142: (flatten (html:html (html:head (html:title "foo"))
143: (html:body "foo"))))
144: (test* "attributes"
145: "<a href=\"http://foo/bar?a&b\" id=\"aabb\">zzdd</a>"
146: (flatten (html:a :href "http://foo/bar?a&b" :id "aabb" "zzdd")))
147:
148: (test* "empty element"
149: "<img src=\"foo\" alt=\"bar baz\" />"
150: (flatten (html:img :src "foo" :alt "bar baz")))
151: )
152:
153:
154: (test-section "parse")
155: (use text.parse)
156: (test-module 'text.parse)
157:
158:
159:
160:
161: (define (test-find-string input pattern . max-chars)
162: (call-with-input-string input
163: (lambda (p)
164: (let* ((n (apply find-string-from-port? pattern p max-chars))
165: (c (read-char p)))
166: (list n (if (eof-object? c) 'eof c))))))
167:
168: (test* "find-string-from-port?" '(7 #\d)
169: (test-find-string "bacacabd" "acab"))
170: (test* "find-string-from-port?" '(7 #\d)
171: (test-find-string "bacacabd" "acab" 100))
172: (test* "find-string-from-port?" '(#f eof)
173: (test-find-string "bacacabd" "acad"))
174: (test* "find-string-from-port?" '(#f eof)
175: (test-find-string "bacacabd" "acad" 100))
176: (test* "find-string-from-port?" '(#f #\a)
177: (test-find-string "bacacabd" "bd" 5))
178: (test* "find-string-from-port?" '(8 eof)
179: (test-find-string "bacacabd" "bd" 9))
180: (test* "find-string-from-port?" '(8 eof)
181: (test-find-string "bacacabd" "bd"))
182: (test* "find-string-from-port?" '(8 eof)
183: (test-find-string "bacacabd" "bd" 8))
184: (test* "find-string-from-port?" '(#f eof)
185: (test-find-string "bacacabd" "be" 20))
186:
187:
188: (define (test-parseutil proc input . args)
189: (call-with-input-string input
190: (lambda (p)
191: (let* ((c (apply proc (append args (list p))))
192: (n (read-char p)))
193: (list (if (eof-object? c) 'eof c)
194: (if (eof-object? n) 'eof n))))))
195:
196: (define (test-assert-curr-char str clist)
197: (test-parseutil assert-curr-char str clist "zz"))
198:
199: (test* "assert-curr-char" '(#\space #\a)
200: (test-assert-curr-char " abcd" '(#\a #\space)))
201: (test* "assert-curr-char" '(#\space #\a)
202: (test-assert-curr-char " abcd" #[a ]))
203: (test* "assert-curr-char" '(#\space #\a)
204: (test-assert-curr-char " abcd" #[a\s]))
205: (test* "assert-curr-char" '(#\space #\a)
206: (test-assert-curr-char " abcd" '(#\a #[\s])))
207: (test* "assert-curr-char" '(#\a #\space)
208: (test-assert-curr-char "a bcd" '(#\a #\space)))
209: (test* "assert-curr-char" '(#\a #\space)
210: (test-assert-curr-char "a bcd" #[a ]))
211: (test* "assert-curr-char" *test-error*
212: (test-assert-curr-char "bcd" #[a ]))
213: (test* "assert-curr-char" *test-error*
214: (test-assert-curr-char "" #[a ]))
215: (test* "assert-curr-char" '(eof eof)
216: (test-assert-curr-char "" '(#\a #\space *eof*)))
217:
218: (test* "skip-until number" '(#f #\a)
219: (test-parseutil skip-until " abcd" 1))
220: (test* "skip-until number" *test-error*
221: (test-parseutil skip-until " abcd" 10))
222: (test* "skip-until number" '(#f eof)
223: (test-parseutil skip-until " abcd" 5))
224: (test* "skip-until cset" '(#\space #\a)
225: (test-parseutil skip-until " abcd" '(#\a #\space)))
226: (test* "skip-until cset" '(#\space #\a)
227: (test-parseutil skip-until " abcd" #[a ]))
228: (test* "skip-until cset" '(#\c #\space)
229: (test-parseutil skip-until "xxxc bcd" #[abc ]))
230: (test* "skip-until cset" '(#\c eof)
231: (test-parseutil skip-until "xxxc" #[abc ]))
232: (test* "skip-until cset" *test-error*
233: (test-parseutil skip-until "xxxc" #[def]))
234: (test* "skip-until cset" '(eof eof)
235: (test-parseutil skip-until "xxxc" '(#[def] *eof*)))
236: (test* "skip-until cset" '(#\c eof)
237: (test-parseutil skip-until "xxxc" '(#[c-f] *eof*)))
238: (test* "skip-until proc" '(#\c #\space)
239: (test-parseutil skip-until "xxxc bcd"
240: (lambda (x) (not (eqv? x #\x)))))
241: (test* "skip-until proc" '(eof eof)
242: (test-parseutil skip-until "xxx"
243: (lambda (x) (not (eqv? x #\x)))))
244: (test* "skip-until proc" *test-error*
245: (test-parseutil skip-until "yyyy"
246: (lambda (x) (eqv? x #\x))))
247: (test* "skip-while" '(#\d #\d)
248: (test-parseutil skip-while "xxxd" '(#\a #\space #\x)))
249: (test* "skip-while" '(#\d #\d)
250: (test-parseutil skip-while "xxxd" #[ax ]))
251: (test* "skip-while" '(#\y #\y)
252: (test-parseutil skip-while "yxxxd" #[ax ]))
253: (test* "skip-while" '(eof eof)
254: (test-parseutil skip-while "xxxa" #[ax ]))
255: (test* "skip-while" '(#\d #\d)
256: (test-parseutil skip-while "xxxd"
257: (lambda (x) (eqv? x #\x))))
258: (test* "skip-while" '(#\y #\y)
259: (test-parseutil skip-while "yxxxd"
260: (lambda (x) (eqv? x #\x))))
261: (test* "skip-while" '(eof eof)
262: (test-parseutil skip-while "yxxxd"
263: (lambda (x) (and (char? x)
264: (char-alphabetic? x)))))
265:
266: (test* "next-token" '("" #\d)
267: (test-parseutil next-token "xxxd" #[ax ] #[d] "next token"))
268: (test* "next-token" '("bc" #\d)
269: (test-parseutil next-token "xxxabcd" #[ax ] #[d] "next token"))
270: (test* "next-token" '("aeio" #\tab)
271: (test-parseutil next-token " aeio\tnjj" #[\s] #[\s] "next token"))
272: (test* "next-token" *test-error*
273: (test-parseutil next-token " aeio" #[\s] #[\s] "next token"))
274: (test* "next-token" '("aeio" eof)
275: (test-parseutil next-token " aeio" #[\s] '(#[\s] *eof*) "next token"))
276: (test* "next-token" '("aeio" #\tab)
277: (test-parseutil next-token " aeio\tnjj"
278: (lambda (x) (and (char? x)
279: (char-whitespace? x)))
280: (lambda (x) (or (eof-object? x)
281: (char-whitespace? x)))
282: "next token"
283: ))
284:
285: (test* "next-token-of" '("" #\x)
286: (test-parseutil next-token-of "xxxd" #[a-c]))
287: (test* "next-token-of" '("" #\x)
288: (test-parseutil next-token-of "xxxd" #[a-d]))
289: (test* "next-token-of" '("xxx" #\d)
290: (test-parseutil next-token-of "xxxd" #[ax]))
291: (test* "next-token-of" '("anmb" #\-)
292: (test-parseutil next-token-of "anmb-runge" #[\w]))
293: (test* "next-token-of" '("rnge!rg0#$@" #\space)
294: (test-parseutil next-token-of "rnge!rg0#$@ bag" #[\S]))
295: (test* "next-token-of" '("xxx" #\d)
296: (test-parseutil next-token-of "xxxd"
297: (lambda (x) (eqv? x #\x))))
298: (test* "next-token-of" '("xxxx" eof)
299: (test-parseutil next-token-of "xxxx"
300: (lambda (x) (eqv? x #\x))))
301:
302: (test* "read-string" '("aaaa" #\a)
303: (test-parseutil read-string "aaaaa" 4))
304: (test* "read-string" '("aaaaa" eof)
305: (test-parseutil read-string "aaaaa" 5))
306: (test* "read-string" '("aaaaa" eof)
307: (test-parseutil read-string "aaaaa" 6))
308: (test* "read-string" '("" #\a)
309: (test-parseutil read-string "aaaaa" 0))
310: (test* "read-string" '("" #\a)
311: (test-parseutil read-string "aaaaa" -1))
312: (test* "read-string" '("" eof)
313: (test-parseutil read-string "" 7))
314:
315:
316: (test-section "progress")
317: (use text.progress)
318: (test-module 'text.progress)
319:
320:
321:
322:
323: (test-section "sql")
324: (use text.sql)
325: (test-module 'text.sql)
326:
327: (test* "sql-tokenize" '("select" "tab" #\. "x" #\, "tab" #\. "y" "as" "foo"
328: "from" "tab" "where" "tab" #\. "z" < (number "30"))
329: (sql-tokenize "select tab.x, tab.y as foo from tab\nwhere tab.z<30"))
330:
331: (test* "sql-tokenize (literal numberes)" '((number "0")
332: (number "-12")
333: (number "+12")
334: (number ".123")
335: (number "123.")
336: (number "123.45")
337: (number "-.123")
338: (number "-123.")
339: (number "-123.45")
340: (number "+.123")
341: (number "+123.")
342: (number "+123.45")
343: (number "0E0")
344: (number "-1E3")
345: (number "-1.E3")
346: (number "-.1E3")
347: (number "-1.2E3")
348: (number "1E-3")
349: (number "1.E-3")
350: (number ".1E-3")
351: - #\. "E" (number "-3")
352: (number "1.2") (number ".3")
353: )
354:
355: (sql-tokenize "0 -12 +12 .123 123. 123.45 -.123 -123. -123.45
356: +.123 +123. +123.45 0E0 -1E3 -1.E3 -.1E3
357: -1.2E3 1E-3 1.E-3 .1E-3 -.E-3 1.2.3"))
358:
359: (test* "sql-tokenize (literal strings)" '((string "abc")
360: (string "ab'c")
361: (string "'abc")
362: (string "abc'")
363: (string "")
364: (string "'")
365: (string "a'b'c'"))
366: (sql-tokenize "'abc' 'ab''c' '''abc' 'abc''' '' '''' 'a''b''c'''"))
367:
368: (test* "sql-tokenize (unterminated literal)" #t
369: (guard (e ((<sql-parse-error> e) #t))
370: (sql-tokenize "'abc def")))
371:
372: (test* "sql-tokenize (unterminated literal)" #t
373: (guard (e ((<sql-parse-error> e) #t))
374: (sql-tokenize "'abc''def")))
375:
376: (test* "sql-tokenize (other stuff)" '((bitstring "0")
377: (bitstring "010101")
378: (hexstring "0")
379: (hexstring "1aBc9")
380: (delimited "run \"run\" run"))
381: (sql-tokenize "B'0' B'010101' X'0' X'1aBc9' \"run \"\"run\"\" run\""))
382:
383: (test* "sql-tokenize (parameters)" '((parameter 0) #\,
384: (parameter 1) #\,
385: (parameter "foo") #\,
386: (parameter "bar") #\,
387: (parameter 2))
388: (sql-tokenize "?,?,:foo, :bar , ?"))
389:
390:
391: (test-section "tr")
392: (use text.tr)
393: (test-module 'text.tr)
394:
395: (test* "basic" "hELLO, wORLD!"
396: (string-tr "Hello, World!" "A-Za-z" "a-zA-Z"))
397: (test* "repeat" "h????, w????!"
398: (string-tr "Hello, World!" "A-Za-z" "a-z?*"))
399: (test* "repeat" "h????, w????!"
400: (string-tr "Hello, World!" "A-Za-z" "a-z?*0"))
401: (test* "repeat" "h???!, w!!??!"
402: (string-tr "Hello, World!" "A-Za-z" "a-z?*13!*13"))
403: (test* "repeat - error" *test-error*
404: (string-tr "Hello, World!" "A*10" "a-z?*13!*13"))
405: (test* "delete" ", !"
406: (string-tr "Hello, World!" "A-Za-z" "" :delete #t))
407: (test* "delete" "H, W!"
408: (string-tr "Hello, World!" "a-z" "" :delete #t))
409: (test* "delete" "h, w!"
410: (string-tr "Hello, World!" "A-Za-z" "a-z" :delete #t))
411: (test* "complement" "Hello??World?"
412: (string-tr "Hello, World!" "A-Za-z" "?*" :complement #t))
413: (test* "complement" "H??????W?????"
414: (string-tr "Hello, World!" "A-Z" "?*" :complement #t))
415: (test* "complement & delete" "HelloWorld"
416: (string-tr "Hello, World!" "A-Za-z" ""
417: :complement #t :delete #t))
418: (test* "squeeze" "helo, world!!!!"
419: (string-tr "Hello, World!!!!" "A-Za-z" "a-z" :squeeze #t))
420: (test* "squeeze & complement" "Hello, World!"
421: (string-tr "Hello, World!!!!" "A-Za-z" ""
422: :squeeze #t :complement #t))
423:
424:
425: (test* "basic, table-size" "hELLO, wORLD!"
426: (string-tr "Hello, World!" "A-Za-z" "a-zA-Z" :table-size 65))
427: (test* "repeat, table-size" "h????, w????!"
428: (string-tr "Hello, World!" "A-Za-z" "a-z?*" :table-size 66))
429: (test* "repeat, table-size" "h????, w????!"
430: (string-tr "Hello, World!" "A-Za-z" "a-z?*0" :table-size 98))
431: (test* "repeat, table-size" "h???!, w!!??!"
432: (string-tr "Hello, World!" "A-Za-z" "a-z?*13!*13" :table-size 99))
433: (test* "delete, table-size" ", !"
434: (string-tr "Hello, World!" "A-Za-z" ""
435: :delete #t :table-size 32))
436: (test* "delete, table-size" "H, W!"
437: (string-tr "Hello, World!" "a-z" ""
438: :delete #t :table-size 64))
439: (test* "delete, table-size" "h, w!"
440: (string-tr "Hello, World!" "A-Za-z" "a-z"
441: :delete #t :table-size 68))
442: (test* "complement, table-size" "Hello??World?"
443: (string-tr "Hello, World!" "A-Za-z" "?*"
444: :complement #t :table-size 87))
445: (test* "complement, table-size" "H??????W?????"
446: (string-tr "Hello, World!" "A-Z" "?*"
447: :complement #t :table-size 2))
448: (test* "complement & delete, table-size" "HelloWorld"
449: (string-tr "Hello, World!" "A-Za-z" ""
450: :complement #t :delete #t :table-size 70))
451: (test* "squeeze, table-size" "helo, world!!!!"
452: (string-tr "Hello, World!!!!" "A-Za-z" "a-z"
453: :squeeze #t :table-size 65))
454: (test* "squeeze & complement, table-size" "Hello, World!"
455: (string-tr "Hello, World!!!!" "A-Za-z" ""
456: :squeeze #t :complement #t :table-size 103))
457:
458: (test* "escape in spec" "*ello, World!"
459: (string-tr "Hello,-World!" "A\\-H" "_ \\*"))
460:
461:
462: (test-section "tree")
463: (use text.tree)
464: (test-module 'text.tree)
465:
466: (test* "tree->string" "" (tree->string '()))
467: (test* "tree->string" "" (tree->string ""))
468: (test* "tree->string" "ab" (tree->string "ab"))
469: (test* "tree->string" "ab" (tree->string 'ab))
470: (test* "tree->string" "ab" (tree->string '(a . b)))
471: (test* "tree->string" "ab" (tree->string '(a b)))
472: (test* "tree->string" "Ab" (tree->string '(|A| . :b)))
473: (test* "tree->string" "ab" (tree->string '((((() ())) . a) ((((b)))))))
474:
475: (test-end)
