mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-19 21:59:17 +02:00
3007 lines
104 KiB
Scheme
3007 lines
104 KiB
Scheme
|
|
;; Adapted from the reference implementation test suite.
|
|
|
|
;;; Copyright (C) William D Clinger (2016).
|
|
;;;
|
|
;;; Permission is hereby granted, free of charge, to any person
|
|
;;; obtaining a copy of this software and associated documentation
|
|
;;; files (the "Software"), to deal in the Software without
|
|
;;; restriction, including without limitation the rights to use,
|
|
;;; copy, modify, merge, publish, distribute, sublicense, and/or
|
|
;;; sell copies of the Software, and to permit persons to whom the
|
|
;;; Software is furnished to do so, subject to the following
|
|
;;; conditions:
|
|
;;;
|
|
;;; The above copyright notice and this permission notice shall be
|
|
;;; included in all copies or substantial portions of the Software.
|
|
;;;
|
|
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
|
|
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
|
|
;;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
|
|
;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
|
|
;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
|
|
;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
|
;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
|
|
;;; OTHER DEALINGS IN THE SOFTWARE.
|
|
|
|
(define-library (srfi 135 test)
|
|
(import (scheme base)
|
|
(scheme write)
|
|
(scheme char)
|
|
(srfi 135)
|
|
(chibi test))
|
|
(export run-tests)
|
|
(begin
|
|
(define (run-tests)
|
|
;; Help functions for testing.
|
|
(define (as-text . args)
|
|
(textual-concatenate
|
|
(map (lambda (x)
|
|
(cond ((text? x) x)
|
|
((string? x) (string->text x))
|
|
((char? x) (text x))
|
|
(else
|
|
(error "as-text: illegal argument" x))))
|
|
args)))
|
|
(define (result=? str txt)
|
|
(and (text? txt)
|
|
(textual=? str txt)))
|
|
|
|
(define-syntax test-text
|
|
(syntax-rules ()
|
|
((test-text expect expr)
|
|
(test-equal result=? expect expr))))
|
|
|
|
;; Unicode is a strong motivation for immutable texts, so we ought
|
|
;; to use at least some non-ASCII strings for testing.
|
|
;; Some systems would blow up if this file were to contain non-ASCII
|
|
;; characters, however, so we have to be careful here.
|
|
;;
|
|
;; FIXME: need more tests with really high code points
|
|
|
|
(cond-expand
|
|
((or sagittarius
|
|
chibi
|
|
full-unicode-strings)
|
|
(define ABC
|
|
(as-text
|
|
(list->string (map integer->char
|
|
'(#x3b1 #x3b2 #x3b3)))))
|
|
(define ABCDEF
|
|
(as-text
|
|
(list->string (map integer->char
|
|
'(#x0c0 #x062 #x0c7 #x064 #x0c9 #x066)))))
|
|
(define DEFABC
|
|
(as-text
|
|
(list->string (map integer->char
|
|
'(#x064 #x0c9 #x066 #x0c0 #x062 #x0c7)))))
|
|
(define eszett (integer->char #xDF))
|
|
(define fuss (text #\F #\u eszett))
|
|
(define chaos0
|
|
(as-text
|
|
(list->string (map integer->char
|
|
'(#x39E #x391 #x39F #x3A3)))))
|
|
(define chaos1
|
|
(as-text
|
|
(list->string (map integer->char
|
|
'(#x3BE #x3B1 #x3BF #x3C2)))))
|
|
(define chaos2
|
|
(as-text
|
|
(list->string (map integer->char
|
|
'(#x3BE #x3B1 #x3BF #x3C3)))))
|
|
(define beyondBMP
|
|
(as-text
|
|
(list->string (map integer->char
|
|
'(#x61 #xc0 #x3bf
|
|
#x1d441 #x1d113 #x1d110 #x7a))))))
|
|
(else
|
|
(define ABC (as-text "abc"))
|
|
(define ABCDEF (as-text "ABCdef"))
|
|
(define DEFABC (as-text "defabc"))))
|
|
|
|
(test-begin "srfi-135: immutable texts")
|
|
|
|
;; Predicates
|
|
|
|
(test-assert (text? (text)))
|
|
(test-assert (not (text? (string))))
|
|
(test-not (text? #\a))
|
|
(test-assert (textual? (text)))
|
|
(test-assert (textual? (string)))
|
|
(test-not (textual? #\a))
|
|
(test-assert (textual-null? (text)))
|
|
(test-not (textual-null? ABC))
|
|
|
|
(test-assert (textual-every (lambda (c) (if (char? c) c #f))
|
|
(text)))
|
|
|
|
(test #\c (textual-every (lambda (c) (if (char? c) c #f))
|
|
(as-text "abc")))
|
|
|
|
(test-not (textual-every (lambda (c) (if (char>? c #\b) c #f))
|
|
(as-text "abc")))
|
|
|
|
(test #\c (textual-every (lambda (c) (if (char>? c #\b) c #f))
|
|
(as-text "abc") 2))
|
|
|
|
(test-assert (textual-every (lambda (c) (if (char>? c #\b) c #f))
|
|
(as-text "abc") 1 1))
|
|
|
|
(test-not (textual-any (lambda (c) (if (char? c) c #f))
|
|
(text)))
|
|
|
|
(test #\a (textual-any (lambda (c) (if (char? c) c #f))
|
|
(as-text "abc")))
|
|
|
|
(test #\c (textual-any (lambda (c) (if (char>? c #\b) c #f))
|
|
(as-text "abc")))
|
|
|
|
(test #\c (textual-any (lambda (c) (if (char>? c #\b) c #f))
|
|
(as-text "abc") 2))
|
|
|
|
(test-not (textual-any (lambda (c) (if (char>? c #\b) c #f))
|
|
(as-text "abc") 0 2))
|
|
|
|
(test-assert (textual-every (lambda (c) (if (char? c) c #f)) ""))
|
|
|
|
(test #\c (textual-every (lambda (c) (if (char? c) c #f)) "abc"))
|
|
|
|
(test-not (textual-every (lambda (c) (if (char>? c #\b) c #f)) "abc"))
|
|
|
|
(test #\c (textual-every (lambda (c) (if (char>? c #\b) c #f)) "abc" 2))
|
|
|
|
(test-assert (textual-every (lambda (c) (if (char>? c #\b) c #f)) "abc" 1 1))
|
|
|
|
(test-not (textual-any (lambda (c) (if (char? c) c #f)) ""))
|
|
|
|
(test-assert #\a (textual-any (lambda (c) (if (char? c) c #f)) "abc"))
|
|
|
|
(test #\c (textual-any (lambda (c) (if (char>? c #\b) c #f)) "abc"))
|
|
|
|
(test #\c (textual-any (lambda (c) (if (char>? c #\b) c #f)) "abc" 2))
|
|
|
|
(test-not (textual-any (lambda (c) (if (char>? c #\b) c #f)) "abc" 0 2))
|
|
|
|
;; Constructors
|
|
|
|
(test-text ""
|
|
(text-tabulate (lambda (i)
|
|
(integer->char (+ i (char->integer #\a))))
|
|
0))
|
|
|
|
(test-text "abc"
|
|
(text-tabulate (lambda (i)
|
|
(integer->char (+ i (char->integer #\a))))
|
|
3))
|
|
|
|
(test-text "abc"
|
|
(let ((p (open-input-string "abc")))
|
|
(text-unfold eof-object?
|
|
values
|
|
(lambda (x) (read-char p))
|
|
(read-char p))))
|
|
|
|
(test-text "" (text-unfold null? car cdr '()))
|
|
|
|
(test-text "abc"
|
|
(text-unfold null? car cdr (string->list "abc")))
|
|
|
|
(test-text "def"
|
|
(text-unfold null? car cdr '() (string->text "def")))
|
|
|
|
(test-text "defabcG"
|
|
(text-unfold null?
|
|
car
|
|
cdr
|
|
(string->list "abc")
|
|
(string->text "def")
|
|
(lambda (x) (if (null? x) (text #\G) ""))))
|
|
|
|
(test-text "" (text-unfold-right null? car cdr '()))
|
|
|
|
(test-text "cba"
|
|
(text-unfold-right null? car cdr (string->list "abc")))
|
|
|
|
(test-text "def"
|
|
(text-unfold-right null? car cdr '() (string->text "def")))
|
|
|
|
(test-text "Gcbadef"
|
|
(text-unfold-right null?
|
|
car
|
|
cdr
|
|
(string->list "abc")
|
|
(string->text "def")
|
|
(lambda (x) (if (null? x) (text #\G) ""))))
|
|
|
|
|
|
(test-text "def"
|
|
(text-unfold null? car cdr '() "def"))
|
|
|
|
(test-text "defabcG"
|
|
(text-unfold null?
|
|
car
|
|
cdr
|
|
(string->list "abc")
|
|
"def"
|
|
(lambda (x) (if (null? x) "G" ""))))
|
|
|
|
(test-text "dabcG"
|
|
(text-unfold null?
|
|
car
|
|
cdr
|
|
(string->list "abc")
|
|
#\d
|
|
(lambda (x) (if (null? x) "G" ""))))
|
|
|
|
(test-text (string-append "%="
|
|
(make-string 200 #\*)
|
|
"A B C D E F G H I J K L M "
|
|
"N O P Q R S T U V W X Y Z "
|
|
(make-string (* 200 (- (char->integer #\a)
|
|
(char->integer #\Z)
|
|
1))
|
|
#\*)
|
|
"abcdefghijklmnopqrstuvwxyz"
|
|
" ")
|
|
(text-unfold (lambda (n) (char>? (integer->char n) #\z))
|
|
(lambda (n)
|
|
(let ((c (integer->char n)))
|
|
(cond ((char<=? #\a c #\z) c)
|
|
((char<=? #\A c #\Z) (text c #\space))
|
|
(else (make-string 200 #\*)))))
|
|
(lambda (n) (+ n 1))
|
|
(char->integer #\@)
|
|
"%="
|
|
(lambda (n) #\space)))
|
|
|
|
(test-text "def"
|
|
(text-unfold-right null? car cdr '() "def"))
|
|
|
|
(test-text "Gcbadef"
|
|
(text-unfold-right null?
|
|
car
|
|
cdr
|
|
(string->list "abc")
|
|
"def"
|
|
(lambda (x) (if (null? x) "G" ""))))
|
|
|
|
(test-text "Gcbad"
|
|
(text-unfold-right null?
|
|
car
|
|
cdr
|
|
(string->list "abc")
|
|
#\d
|
|
(lambda (x) (if (null? x) "G" ""))))
|
|
|
|
(test-text (string-append " "
|
|
(list->string
|
|
(reverse
|
|
(string->list "abcdefghijklmnopqrstuvwxyz")))
|
|
(make-string (* 200 (- (char->integer #\a)
|
|
(char->integer #\Z)
|
|
1))
|
|
#\*)
|
|
"Z Y X W V U T S R Q P O N "
|
|
"M L K J I H G F E D C B A "
|
|
(make-string 200 #\*)
|
|
"%=")
|
|
(text-unfold-right
|
|
(lambda (n) (char>? (integer->char n) #\z))
|
|
(lambda (n)
|
|
(let ((c (integer->char n)))
|
|
(cond ((char<=? #\a c #\z) c)
|
|
((char<=? #\A c #\Z) (text c #\space))
|
|
(else (make-string 200 #\*)))))
|
|
(lambda (n) (+ n 1))
|
|
(char->integer #\@)
|
|
"%="
|
|
(lambda (n) #\space)))
|
|
|
|
(test-text " The English alphabet: abcdefghijklmnopqrstuvwxyz "
|
|
(text-unfold-right (lambda (n) (< n (char->integer #\A)))
|
|
(lambda (n)
|
|
(char-downcase (integer->char n)))
|
|
(lambda (n) (- n 1))
|
|
(char->integer #\Z)
|
|
#\space
|
|
(lambda (n) " The English alphabet: ")))
|
|
|
|
|
|
;; Conversion
|
|
|
|
(test-text "str" (textual->text "str"))
|
|
|
|
(test-text "str" (textual->text (text #\s #\t #\r)))
|
|
|
|
(test-text "str" (textual->text "str" "not a textual"))
|
|
|
|
(test-text "str" (textual->text (text #\s #\t #\r) "bad textual"))
|
|
|
|
|
|
(test "" (textual->string (text)))
|
|
|
|
(test "" (textual->string (text) 0))
|
|
|
|
(test "" (textual->string (text) 0 0))
|
|
|
|
(test "abc" (textual->string (text #\a #\b #\c)))
|
|
|
|
(test "" (textual->string (text #\a #\b #\c) 3))
|
|
|
|
(test "bc" (textual->string (text #\a #\b #\c) 1 3))
|
|
|
|
|
|
(test "" (textual->string ""))
|
|
|
|
(test "" (textual->string "" 0))
|
|
|
|
(test "" (textual->string "" 0 0))
|
|
|
|
(test "abc" (textual->string "abc"))
|
|
|
|
(test "" (textual->string "abc" 3))
|
|
|
|
(test "bc" (textual->string "abc" 1 3))
|
|
|
|
|
|
(test '#() (textual->vector (text)))
|
|
|
|
(test '#() (textual->vector (text) 0))
|
|
|
|
(test '#() (textual->vector (text) 0 0))
|
|
|
|
(test '#(#\a #\b #\c) (textual->vector (text #\a #\b #\c)))
|
|
|
|
(test '#() (textual->vector (text #\a #\b #\c) 3))
|
|
|
|
(test '#(#\b #\c) (textual->vector (text #\a #\b #\c) 1 3))
|
|
|
|
|
|
(test '#() (textual->vector ""))
|
|
|
|
(test '#() (textual->vector "" 0))
|
|
|
|
(test '#() (textual->vector "" 0 0))
|
|
|
|
(test '#(#\a #\b #\c) (textual->vector "abc"))
|
|
|
|
(test '#() (textual->vector "abc" 3))
|
|
|
|
(test '#(#\b #\c) (textual->vector "abc" 1 3))
|
|
|
|
|
|
(test '() (textual->list (text)))
|
|
|
|
(test '() (textual->list (text) 0))
|
|
|
|
(test '() (textual->list (text) 0 0))
|
|
|
|
(test '(#\a #\b #\c) (textual->list (text #\a #\b #\c)))
|
|
|
|
(test '() (textual->list (text #\a #\b #\c) 3))
|
|
|
|
(test '(#\b #\c) (textual->list (text #\a #\b #\c) 1 3))
|
|
|
|
|
|
(test '() (textual->list ""))
|
|
|
|
(test '() (textual->list "" 0))
|
|
|
|
(test '() (textual->list "" 0 0))
|
|
|
|
(test '(#\a #\b #\c) (textual->list "abc"))
|
|
|
|
(test '() (textual->list "abc" 3))
|
|
|
|
(test '(#\b #\c) (textual->list "abc" 1 3))
|
|
|
|
|
|
(test-text "" (string->text ""))
|
|
|
|
(test-text "" (string->text "" 0))
|
|
|
|
(test-text "" (string->text "" 0 0))
|
|
|
|
(test-text "abc" (string->text "abc"))
|
|
|
|
(test-text "bc" (string->text "abc" 1))
|
|
|
|
(test-text "" (string->text "abc" 3))
|
|
|
|
(test-text "b" (string->text "abc" 1 2))
|
|
|
|
(test-text "bc" (string->text "abc" 1 3))
|
|
|
|
|
|
(test-text "" (vector->text '#()))
|
|
|
|
(test-text "" (vector->text '#() 0))
|
|
|
|
(test-text "" (vector->text '#() 0 0))
|
|
|
|
(test-text "abc" (vector->text '#(#\a #\b #\c)))
|
|
|
|
(test-text "bc" (vector->text '#(#\a #\b #\c) 1))
|
|
|
|
(test-text "" (vector->text '#(#\a #\b #\c) 3))
|
|
|
|
(test-text "b" (vector->text '#(#\a #\b #\c) 1 2))
|
|
|
|
(test-text "bc" (vector->text '#(#\a #\b #\c) 1 3))
|
|
|
|
|
|
(test-text "" (list->text '()))
|
|
|
|
(test-text "" (list->text '() 0))
|
|
|
|
(test-text "" (list->text '() 0 0))
|
|
|
|
(test-text "abc" (list->text '(#\a #\b #\c)))
|
|
|
|
(test-text "bc" (list->text '(#\a #\b #\c) 1))
|
|
|
|
(test-text "" (list->text '(#\a #\b #\c) 3))
|
|
|
|
(test-text "b" (list->text '(#\a #\b #\c) 1 2))
|
|
|
|
(test-text "bc" (list->text '(#\a #\b #\c) 1 3))
|
|
|
|
|
|
(test-text "" (reverse-list->text '()))
|
|
|
|
(test-text "cba" (reverse-list->text '(#\a #\b #\c)))
|
|
|
|
|
|
(test '#u8(97 98 99)
|
|
(textual->utf8 (as-text "abc")))
|
|
|
|
(test '#u8(97 98 99)
|
|
(textual->utf8 "abc"))
|
|
|
|
(test '#u8(97 98 99 121 121 121 122 122 122)
|
|
(textual->utf8 (as-text "xxxabcyyyzzz") 3))
|
|
|
|
(test '#u8(97 98 99 121 121 121 122 122 122)
|
|
(textual->utf8 "xxxabcyyyzzz" 3))
|
|
|
|
(test '#u8(97 98 99)
|
|
(textual->utf8 (as-text "xxxabcyyyzzz") 3 6))
|
|
|
|
(test '#u8(97 98 99)
|
|
(textual->utf8 "xxxabcyyyzzz" 3 6))
|
|
|
|
|
|
(test '#u8(254 255 0 97 0 98 0 99)
|
|
(textual->utf16 (as-text "abc")))
|
|
|
|
(test '#u8(254 255 0 97 0 98 0 99)
|
|
(textual->utf16 "abc"))
|
|
|
|
(test '#u8(254 255 0 97 0 98 0 99 0 121 0 121 0 121 0 122 0 122 0 122)
|
|
(textual->utf16 (as-text "xxxabcyyyzzz") 3))
|
|
|
|
(test '#u8(254 255 0 97 0 98 0 99 0 121 0 121 0 121 0 122 0 122 0 122)
|
|
(textual->utf16 "xxxabcyyyzzz" 3))
|
|
|
|
(test '#u8(254 255 0 97 0 98 0 99)
|
|
(textual->utf16 (as-text "xxxabcyyyzzz") 3 6))
|
|
|
|
(test '#u8(254 255 0 97 0 98 0 99)
|
|
(textual->utf16 "xxxabcyyyzzz" 3 6))
|
|
|
|
|
|
(test '#u8(0 97 0 98 0 99)
|
|
(textual->utf16be (as-text "abc")))
|
|
|
|
(test '#u8(0 97 0 98 0 99)
|
|
(textual->utf16be "abc"))
|
|
|
|
(test '#u8(0 97 0 98 0 99 0 121 0 121 0 121 0 122 0 122 0 122)
|
|
(textual->utf16be (as-text "xxxabcyyyzzz") 3))
|
|
|
|
(test '#u8(0 97 0 98 0 99 0 121 0 121 0 121 0 122 0 122 0 122)
|
|
(textual->utf16be "xxxabcyyyzzz" 3))
|
|
|
|
(test '#u8(0 97 0 98 0 99)
|
|
(textual->utf16be (as-text "xxxabcyyyzzz") 3 6))
|
|
|
|
(test '#u8(0 97 0 98 0 99)
|
|
(textual->utf16be "xxxabcyyyzzz" 3 6))
|
|
|
|
|
|
(test '#u8(97 0 98 0 99 0)
|
|
(textual->utf16le (as-text "abc")))
|
|
|
|
(test '#u8(97 0 98 0 99 0)
|
|
(textual->utf16le "abc"))
|
|
|
|
(test '#u8(97 0 98 0 99 0 121 0 121 0 121 0 122 0 122 0 122 0)
|
|
(textual->utf16le (as-text "xxxabcyyyzzz") 3))
|
|
|
|
(test '#u8(97 0 98 0 99 0 121 0 121 0 121 0 122 0 122 0 122 0)
|
|
(textual->utf16le "xxxabcyyyzzz" 3))
|
|
|
|
(test '#u8(97 0 98 0 99 0)
|
|
(textual->utf16le (as-text "xxxabcyyyzzz") 3 6))
|
|
|
|
(test '#u8(97 0 98 0 99 0)
|
|
(textual->utf16le "xxxabcyyyzzz" 3 6))
|
|
|
|
|
|
(test-text "abc"
|
|
(utf8->text '#u8(97 98 99)))
|
|
|
|
(test-text "abcyyyzzz"
|
|
(utf8->text '#u8(0 1 2 97 98 99 121 121 121 122 122 122) 3))
|
|
|
|
(test-text "abc"
|
|
(utf8->text '#u8(41 42 43 97 98 99 100 101 102) 3 6))
|
|
|
|
|
|
(test-text "abc"
|
|
(utf16->text '#u8(254 255 0 97 0 98 0 99)))
|
|
|
|
(test-text "abc"
|
|
(utf16->text '#u8(255 254 97 0 98 0 99 0)))
|
|
|
|
(test-text "abc"
|
|
(utf16->text (textual->utf16 "abc") 2))
|
|
|
|
(test-text "bcdef"
|
|
(utf16->text (textual->utf16 "abcdef") 4))
|
|
|
|
(test-text "bcd"
|
|
(utf16->text (textual->utf16 "abcdef") 4 10))
|
|
|
|
|
|
(test-text "abc"
|
|
(utf16be->text '#u8(0 97 0 98 0 99)))
|
|
|
|
(test-text "bc"
|
|
(utf16be->text (textual->utf16be "abc") 2))
|
|
|
|
(test-text "bcd"
|
|
(utf16be->text (textual->utf16be "abcdef") 2 8))
|
|
|
|
|
|
(test-text "abc"
|
|
(utf16le->text '#u8(97 0 98 0 99 0)))
|
|
|
|
(test-text "bc"
|
|
(utf16le->text (textual->utf16le "abc") 2))
|
|
|
|
(test-text "bcd"
|
|
(utf16le->text (textual->utf16le "abcdef") 2 8))
|
|
|
|
|
|
(cond-expand
|
|
((or sagittarius
|
|
chibi
|
|
full-unicode-strings)
|
|
|
|
(test
|
|
'#u8(97 195 128 206 191
|
|
240 157 145 129 240 157 132 147 240 157 132 144 122)
|
|
(textual->utf8 beyondBMP))
|
|
|
|
(let ((bv (textual->utf16 beyondBMP)))
|
|
(test-assert
|
|
(or (equal? bv
|
|
'#u8(254 255 0 97 0 192 3 191
|
|
216 53 220 65 216 52 221 19 216 52 221 16 0 122))
|
|
(equal? bv
|
|
'#u8(255 254 97 0 192 0 191 3
|
|
53 216 65 220 52 216 19 221 52 216 16 221 122 0)))))
|
|
|
|
(test
|
|
'#u8(0 97 0 192 3 191 216 53 220 65 216 52 221 19 216 52 221 16 0 122)
|
|
(textual->utf16be beyondBMP))
|
|
|
|
(test
|
|
'#u8(97 0 192 0 191 3 53 216 65 220 52 216 19 221 52 216 16 221 122 0)
|
|
(textual->utf16le beyondBMP))
|
|
|
|
(test-assert
|
|
(textual=?
|
|
beyondBMP
|
|
(utf8->text
|
|
'#u8(97 195 128 206 191
|
|
240 157 145 129 240 157 132 147 240 157 132 144 122))))
|
|
|
|
(test-assert (textual=? beyondBMP (utf16->text (textual->utf16 beyondBMP))))
|
|
|
|
(test-assert (textual=? beyondBMP
|
|
(utf16->text (textual->utf16 beyondBMP) 2)))
|
|
|
|
(test-assert (textual=? beyondBMP (utf16be->text (textual->utf16be beyondBMP))))
|
|
|
|
(test-assert (textual=? beyondBMP (utf16le->text (textual->utf16le beyondBMP))))
|
|
|
|
(test-assert (result=? (string-append (string (integer->char #xfeff)) "abc")
|
|
(utf16be->text '#u8(254 255 0 97 0 98 0 99))))
|
|
|
|
(test-assert (result=? (string-append (string (integer->char #xfeff)) "abc")
|
|
(utf16le->text '#u8(255 254 97 0 98 0 99 0))))
|
|
)
|
|
|
|
(else))
|
|
|
|
;; Selection
|
|
|
|
(test 0 (text-length (text)))
|
|
|
|
(test 6 (text-length ABCDEF))
|
|
|
|
(test 1234 (text-length (make-text 1234 (text-ref ABC 0))))
|
|
|
|
|
|
(test #\a (text-ref (text #\a #\b #\c) 0))
|
|
|
|
(test #\c (text-ref (text #\a #\b #\c) 2))
|
|
|
|
(test (string-ref (textual->string ABCDEF) 3)
|
|
(text-ref ABCDEF 3))
|
|
|
|
|
|
(test 0 (textual-length (text)))
|
|
|
|
(test 6 (textual-length ABCDEF))
|
|
|
|
(test 1234 (textual-length (make-text 1234 (text-ref ABC 0))))
|
|
|
|
|
|
(test #\a (textual-ref (text #\a #\b #\c) 0))
|
|
|
|
(test #\c (textual-ref (text #\a #\b #\c) 2))
|
|
|
|
(test (string-ref (textual->string ABCDEF) 3)
|
|
(textual-ref ABCDEF 3))
|
|
|
|
|
|
(test-text ""
|
|
(subtext (text) 0 0))
|
|
|
|
(test-text ""
|
|
(subtext (string->text "abcdef") 0 0))
|
|
|
|
(test-text ""
|
|
(subtext (string->text "abcdef") 4 4))
|
|
|
|
(test-text ""
|
|
(subtext (string->text "abcdef") 6 6))
|
|
|
|
(test-text "abcd"
|
|
(subtext (string->text "abcdef") 0 4))
|
|
|
|
(test-text "cde"
|
|
(subtext (string->text "abcdef") 2 5))
|
|
|
|
(test-text "cdef"
|
|
(subtext (string->text "abcdef") 2 6))
|
|
|
|
(test-text "abcdef"
|
|
(subtext (string->text "abcdef") 0 6))
|
|
|
|
|
|
(test-text ""
|
|
(subtextual (text) 0 0))
|
|
|
|
(test-text ""
|
|
(subtextual (string->text "abcdef") 0 0))
|
|
|
|
(test-text ""
|
|
(subtextual (string->text "abcdef") 4 4))
|
|
|
|
(test-text ""
|
|
(subtextual (string->text "abcdef") 6 6))
|
|
|
|
(test-text "abcd"
|
|
(subtextual (string->text "abcdef") 0 4))
|
|
|
|
(test-text "cde"
|
|
(subtextual (string->text "abcdef") 2 5))
|
|
|
|
(test-text "cdef"
|
|
(subtextual (string->text "abcdef") 2 6))
|
|
|
|
(test-text "abcdef"
|
|
(subtextual (string->text "abcdef") 0 6))
|
|
|
|
|
|
(test-text ""
|
|
(subtextual "" 0 0))
|
|
|
|
(test-text ""
|
|
(subtextual "abcdef" 0 0))
|
|
|
|
(test-text ""
|
|
(subtextual "abcdef" 4 4))
|
|
|
|
(test-text ""
|
|
(subtextual "abcdef" 6 6))
|
|
|
|
(test-text "abcd"
|
|
(subtextual "abcdef" 0 4))
|
|
|
|
(test-text "cde"
|
|
(subtextual "abcdef" 2 5))
|
|
|
|
(test-text "cdef"
|
|
(subtextual "abcdef" 2 6))
|
|
|
|
(test-text "abcdef"
|
|
(subtextual "abcdef" 0 6))
|
|
|
|
|
|
(test-text ""
|
|
(textual-copy (text)))
|
|
|
|
(test-assert (let* ((txt (string->text "abcdef"))
|
|
(copy (textual-copy txt)))
|
|
(and (result=? "abcdef"
|
|
copy)
|
|
(not (eqv? txt copy)))))
|
|
|
|
|
|
(test-text ""
|
|
(textual-copy ""))
|
|
|
|
(test-text "abcdef"
|
|
(textual-copy "abcdef"))
|
|
|
|
|
|
(test-text ""
|
|
(textual-copy (text) 0))
|
|
|
|
(test-text "abcdef"
|
|
(textual-copy (string->text "abcdef") 0))
|
|
|
|
(test-text "ef"
|
|
(textual-copy (string->text "abcdef") 4))
|
|
|
|
(test-text ""
|
|
(textual-copy (string->text "abcdef") 6))
|
|
|
|
|
|
(test-text ""
|
|
(textual-copy "" 0))
|
|
|
|
(test-text "abcdef"
|
|
(textual-copy "abcdef" 0))
|
|
|
|
(test-text "ef"
|
|
(textual-copy "abcdef" 4))
|
|
|
|
(test-text ""
|
|
(textual-copy "abcdef" 6))
|
|
|
|
|
|
(test-text ""
|
|
(textual-copy (text) 0 0))
|
|
|
|
(test-text ""
|
|
(textual-copy (string->text "abcdef") 0 0))
|
|
|
|
(test-text ""
|
|
(textual-copy (string->text "abcdef") 4 4))
|
|
|
|
(test-text ""
|
|
(textual-copy (string->text "abcdef") 6 6))
|
|
|
|
(test-text "abcd"
|
|
(textual-copy (string->text "abcdef") 0 4))
|
|
|
|
(test-text "cde"
|
|
(textual-copy (string->text "abcdef") 2 5))
|
|
|
|
(test-text "cdef"
|
|
(textual-copy (string->text "abcdef") 2 6))
|
|
|
|
(test-text "abcdef"
|
|
(textual-copy (string->text "abcdef") 0 6))
|
|
|
|
|
|
(test-text ""
|
|
(textual-copy "" 0 0))
|
|
|
|
(test-text ""
|
|
(textual-copy "abcdef" 0 0))
|
|
|
|
(test-text ""
|
|
(textual-copy "abcdef" 4 4))
|
|
|
|
(test-text ""
|
|
(textual-copy "abcdef" 6 6))
|
|
|
|
(test-text "abcd"
|
|
(textual-copy "abcdef" 0 4))
|
|
|
|
(test-text "cde"
|
|
(textual-copy "abcdef" 2 5))
|
|
|
|
(test-text "cdef"
|
|
(textual-copy "abcdef" 2 6))
|
|
|
|
(test-text "abcdef"
|
|
(textual-copy "abcdef" 0 6))
|
|
|
|
|
|
(test-text "" (textual-take (text) 0))
|
|
|
|
(test-text "" (textual-take (string->text "abcdef") 0))
|
|
|
|
(test-text "ab" (textual-take (string->text "abcdef") 2))
|
|
|
|
(test-text "" (textual-drop (string->text "") 0))
|
|
|
|
(test-text "abcdef" (textual-drop (string->text "abcdef") 0))
|
|
|
|
(test-text "cdef" (textual-drop (string->text "abcdef") 2))
|
|
|
|
(test-text "" (textual-take-right (text) 0))
|
|
|
|
(test-text "" (textual-take-right (string->text "abcdef") 0))
|
|
|
|
(test-text "ef" (textual-take-right (string->text "abcdef") 2))
|
|
|
|
(test-text "" (textual-drop-right (text) 0))
|
|
|
|
(test-text "abcdef"
|
|
(textual-drop-right (string->text "abcdef") 0))
|
|
|
|
(test-text "abcd"
|
|
(textual-drop-right (string->text "abcdef") 2))
|
|
|
|
|
|
(test-text "" (textual-take "" 0))
|
|
|
|
(test-text "" (textual-take "abcdef" 0))
|
|
|
|
(test-text "ab" (textual-take "abcdef" 2))
|
|
|
|
(test-text "" (textual-drop "" 0))
|
|
|
|
(test-text "abcdef" (textual-drop "abcdef" 0))
|
|
|
|
(test-text "cdef" (textual-drop "abcdef" 2))
|
|
|
|
(test-text "" (textual-take-right "" 0))
|
|
|
|
(test-text "" (textual-take-right "abcdef" 0))
|
|
|
|
(test-text "ef" (textual-take-right "abcdef" 2))
|
|
|
|
(test-text "" (textual-drop-right "" 0))
|
|
|
|
(test-text "abcdef" (textual-drop-right "abcdef" 0))
|
|
|
|
(test-text "abcd" (textual-drop-right "abcdef" 2))
|
|
|
|
|
|
(test-text ""
|
|
(textual-pad (string->text "") 0))
|
|
|
|
(test-text " "
|
|
(textual-pad (string->text "") 5))
|
|
|
|
(test-text " 325"
|
|
(textual-pad (string->text "325") 5))
|
|
|
|
(test-text "71325"
|
|
(textual-pad (string->text "71325") 5))
|
|
|
|
(test-text "71325"
|
|
(textual-pad (string->text "8871325") 5))
|
|
|
|
(test-text ""
|
|
(textual-pad (string->text "") 0 #\*))
|
|
|
|
(test-text "*****"
|
|
(textual-pad (string->text "") 5 #\*))
|
|
|
|
(test-text "**325"
|
|
(textual-pad (string->text "325") 5 #\*))
|
|
|
|
(test-text "71325"
|
|
(textual-pad (string->text "71325") 5 #\*))
|
|
|
|
(test-text "71325"
|
|
(textual-pad (string->text "8871325") 5 #\*))
|
|
|
|
(test-text ""
|
|
(textual-pad (string->text "") 0 #\* 0))
|
|
|
|
(test-text "*****"
|
|
(textual-pad (string->text "") 5 #\* 0))
|
|
|
|
(test-text "**325"
|
|
(textual-pad (string->text "325") 5 #\* 0))
|
|
|
|
(test-text "71325"
|
|
(textual-pad (string->text "71325") 5 #\* 0))
|
|
|
|
(test-text "71325"
|
|
(textual-pad (string->text "8871325") 5 #\* 0))
|
|
|
|
(test-text "***25"
|
|
(textual-pad (string->text "325") 5 #\* 1))
|
|
|
|
(test-text "*1325"
|
|
(textual-pad (string->text "71325") 5 #\* 1))
|
|
|
|
(test-text "71325"
|
|
(textual-pad (string->text "8871325") 5 #\* 1))
|
|
|
|
(test-text ""
|
|
(textual-pad (string->text "") 0 #\* 0 0))
|
|
|
|
(test-text "*****"
|
|
(textual-pad (string->text "") 5 #\* 0 0))
|
|
|
|
(test-text "**325"
|
|
(textual-pad (string->text "325") 5 #\* 0 3))
|
|
|
|
(test-text "**713"
|
|
(textual-pad (string->text "71325") 5 #\* 0 3))
|
|
|
|
(test-text "**887"
|
|
(textual-pad (string->text "8871325") 5 #\* 0 3))
|
|
|
|
(test-text "***25"
|
|
(textual-pad (string->text "325") 5 #\* 1 3))
|
|
|
|
(test-text "**132"
|
|
(textual-pad (string->text "71325") 5 #\* 1 4))
|
|
|
|
(test-text "*8713"
|
|
(textual-pad (string->text "8871325") 5 #\* 1 5))
|
|
|
|
(test-text ""
|
|
(textual-pad-right (string->text "") 0))
|
|
|
|
(test-text " "
|
|
(textual-pad-right (string->text "") 5))
|
|
|
|
(test-text "325 "
|
|
(textual-pad-right (string->text "325") 5))
|
|
|
|
(test-text "71325"
|
|
(textual-pad-right (string->text "71325") 5))
|
|
|
|
(test-text "88713"
|
|
(textual-pad-right (string->text "8871325") 5))
|
|
|
|
(test-text ""
|
|
(textual-pad-right (string->text "") 0 #\*))
|
|
|
|
(test-text "*****"
|
|
(textual-pad-right (string->text "") 5 #\*))
|
|
|
|
(test-text "325**"
|
|
(textual-pad-right (string->text "325") 5 #\*))
|
|
|
|
(test-text "71325"
|
|
(textual-pad-right (string->text "71325") 5 #\*))
|
|
|
|
(test-text "88713"
|
|
(textual-pad-right (string->text "8871325") 5 #\*))
|
|
|
|
(test-text ""
|
|
(textual-pad-right (string->text "") 0 #\* 0))
|
|
|
|
(test-text "*****"
|
|
(textual-pad-right (string->text "") 5 #\* 0))
|
|
|
|
(test-text "325**"
|
|
(textual-pad-right (string->text "325") 5 #\* 0))
|
|
|
|
(test-text "71325"
|
|
(textual-pad-right (string->text "71325") 5 #\* 0))
|
|
|
|
(test-text "88713"
|
|
(textual-pad-right (string->text "8871325") 5 #\* 0))
|
|
|
|
(test-text "25***"
|
|
(textual-pad-right (string->text "325") 5 #\* 1))
|
|
|
|
(test-text "1325*"
|
|
(textual-pad-right (string->text "71325") 5 #\* 1))
|
|
|
|
(test-text "87132"
|
|
(textual-pad-right (string->text "8871325") 5 #\* 1))
|
|
|
|
(test-text ""
|
|
(textual-pad-right (string->text "") 0 #\* 0 0))
|
|
|
|
(test-text "*****"
|
|
(textual-pad-right (string->text "") 5 #\* 0 0))
|
|
|
|
(test-text "325**"
|
|
(textual-pad-right (string->text "325") 5 #\* 0 3))
|
|
|
|
(test-text "713**"
|
|
(textual-pad-right (string->text "71325") 5 #\* 0 3))
|
|
|
|
(test-text "887**"
|
|
|
|
(textual-pad-right (string->text "8871325") 5 #\* 0 3))
|
|
|
|
(test-text "25***"
|
|
(textual-pad-right (string->text "325") 5 #\* 1 3))
|
|
|
|
(test-text "132**"
|
|
(textual-pad-right (string->text "71325") 5 #\* 1 4))
|
|
|
|
(test-text "8713*"
|
|
|
|
(textual-pad-right (string->text "8871325") 5 #\* 1 5))
|
|
|
|
|
|
(test-text "" (textual-pad "" 0))
|
|
|
|
(test-text " " (textual-pad "" 5))
|
|
|
|
(test-text " 325" (textual-pad "325" 5))
|
|
|
|
(test-text "71325" (textual-pad "71325" 5))
|
|
|
|
(test-text "71325" (textual-pad "8871325" 5))
|
|
|
|
(test-text "" (textual-pad "" 0 #\*))
|
|
|
|
(test-text "*****" (textual-pad "" 5 #\*))
|
|
|
|
(test-text "**325" (textual-pad "325" 5 #\*))
|
|
|
|
(test-text "71325" (textual-pad "71325" 5 #\*))
|
|
|
|
(test-text "71325" (textual-pad "8871325" 5 #\*))
|
|
|
|
(test-text "" (textual-pad "" 0 #\* 0))
|
|
|
|
(test-text "*****" (textual-pad "" 5 #\* 0))
|
|
|
|
(test-text "**325" (textual-pad "325" 5 #\* 0))
|
|
|
|
(test-text "71325" (textual-pad "71325" 5 #\* 0))
|
|
|
|
(test-text "71325" (textual-pad "8871325" 5 #\* 0))
|
|
|
|
(test-text "***25" (textual-pad "325" 5 #\* 1))
|
|
|
|
(test-text "*1325" (textual-pad "71325" 5 #\* 1))
|
|
|
|
(test-text "71325" (textual-pad "8871325" 5 #\* 1))
|
|
|
|
(test-text "" (textual-pad "" 0 #\* 0 0))
|
|
|
|
(test-text "*****" (textual-pad "" 5 #\* 0 0))
|
|
|
|
(test-text "**325" (textual-pad "325" 5 #\* 0 3))
|
|
|
|
(test-text "**713" (textual-pad "71325" 5 #\* 0 3))
|
|
|
|
(test-text "**887" (textual-pad "8871325" 5 #\* 0 3))
|
|
|
|
(test-text "***25" (textual-pad "325" 5 #\* 1 3))
|
|
|
|
(test-text "**132" (textual-pad "71325" 5 #\* 1 4))
|
|
|
|
(test-text "*8713" (textual-pad "8871325" 5 #\* 1 5))
|
|
|
|
(test-text "" (textual-pad-right "" 0))
|
|
|
|
(test-text " " (textual-pad-right "" 5))
|
|
|
|
(test-text "325 " (textual-pad-right "325" 5))
|
|
|
|
(test-text "71325" (textual-pad-right "71325" 5))
|
|
|
|
(test-text "88713" (textual-pad-right "8871325" 5))
|
|
|
|
(test-text "" (textual-pad-right "" 0 #\*))
|
|
|
|
(test-text "*****" (textual-pad-right "" 5 #\*))
|
|
|
|
(test-text "325**" (textual-pad-right "325" 5 #\*))
|
|
|
|
(test-text "71325" (textual-pad-right "71325" 5 #\*))
|
|
|
|
(test-text "88713" (textual-pad-right "8871325" 5 #\*))
|
|
|
|
(test-text "" (textual-pad-right "" 0 #\* 0))
|
|
|
|
(test-text "*****" (textual-pad-right "" 5 #\* 0))
|
|
|
|
(test-text "325**" (textual-pad-right "325" 5 #\* 0))
|
|
|
|
(test-text "71325" (textual-pad-right "71325" 5 #\* 0))
|
|
|
|
(test-text "88713" (textual-pad-right "8871325" 5 #\* 0))
|
|
|
|
(test-text "25***" (textual-pad-right "325" 5 #\* 1))
|
|
|
|
(test-text "1325*" (textual-pad-right "71325" 5 #\* 1))
|
|
|
|
(test-text "87132" (textual-pad-right "8871325" 5 #\* 1))
|
|
|
|
(test-text "" (textual-pad-right "" 0 #\* 0 0))
|
|
|
|
(test-text "*****" (textual-pad-right "" 5 #\* 0 0))
|
|
|
|
(test-text "325**" (textual-pad-right "325" 5 #\* 0 3))
|
|
|
|
(test-text "713**" (textual-pad-right "71325" 5 #\* 0 3))
|
|
|
|
(test-text "887**" (textual-pad-right "8871325" 5 #\* 0 3))
|
|
|
|
(test-text "25***" (textual-pad-right "325" 5 #\* 1 3))
|
|
|
|
(test-text "132**" (textual-pad-right "71325" 5 #\* 1 4))
|
|
|
|
(test-text "8713*" (textual-pad-right "8871325" 5 #\* 1 5))
|
|
|
|
|
|
(test-text ""
|
|
(textual-trim (string->text "")))
|
|
|
|
(test-text "a b c "
|
|
(textual-trim (string->text " a b c ")))
|
|
|
|
(test-text ""
|
|
(textual-trim (string->text "") char-whitespace?))
|
|
|
|
(test-text "a b c "
|
|
(textual-trim (string->text " a b c ") char-whitespace?))
|
|
|
|
(test-text ""
|
|
(textual-trim (string->text " a b c ") char?))
|
|
|
|
(test-text ""
|
|
(textual-trim (string->text "") char-whitespace? 0))
|
|
|
|
(test-text "a b c "
|
|
(textual-trim (string->text " a b c ") char-whitespace? 0))
|
|
|
|
(test-text ""
|
|
(textual-trim (string->text " a b c ") char? 0))
|
|
|
|
(test-text "b c "
|
|
(textual-trim (string->text " a b c ") char-whitespace? 3))
|
|
|
|
(test-text ""
|
|
(textual-trim (string->text " a b c ") char? 3))
|
|
|
|
(test-text ""
|
|
(textual-trim (string->text " a b c ") char? 0 11))
|
|
|
|
(test-text "b c "
|
|
(textual-trim (string->text " a b c ")
|
|
char-whitespace? 3 11))
|
|
|
|
(test-text ""
|
|
(textual-trim (string->text " a b c ") char? 3 11))
|
|
|
|
(test-text ""
|
|
(textual-trim (string->text " a b c ") char? 0 8))
|
|
|
|
(test-text "b "
|
|
(textual-trim (string->text " a b c ")
|
|
char-whitespace? 3 8))
|
|
|
|
(test-text ""
|
|
(textual-trim (string->text " a b c ") char? 3 8))
|
|
|
|
|
|
(test-text ""
|
|
(textual-trim-right (string->text "")))
|
|
|
|
(test-text " a b c"
|
|
(textual-trim-right (string->text " a b c ")))
|
|
|
|
(test-text ""
|
|
(textual-trim-right (string->text "") char-whitespace?))
|
|
|
|
(test-text " a b c"
|
|
(textual-trim-right (string->text " a b c ")
|
|
char-whitespace?))
|
|
|
|
(test-text ""
|
|
(textual-trim-right (string->text " a b c ") char?))
|
|
|
|
(test-text ""
|
|
(textual-trim-right (string->text "") char-whitespace? 0))
|
|
|
|
(test-text " a b c"
|
|
(textual-trim-right (string->text " a b c ")
|
|
char-whitespace? 0))
|
|
|
|
(test-text ""
|
|
(textual-trim-right (string->text " a b c ") char? 0))
|
|
|
|
(test-text " b c"
|
|
(textual-trim-right (string->text " a b c ")
|
|
char-whitespace? 3))
|
|
|
|
(test-text ""
|
|
(textual-trim-right (string->text " a b c ") char? 3))
|
|
|
|
(test-text ""
|
|
(textual-trim-right (string->text " a b c ") char? 0 11))
|
|
|
|
(test-text " b c"
|
|
(textual-trim-right (string->text " a b c ")
|
|
char-whitespace? 3 11))
|
|
|
|
(test-text ""
|
|
(textual-trim-right (string->text " a b c ") char? 3 11))
|
|
|
|
(test-text ""
|
|
(textual-trim-right (string->text " a b c ") char? 0 8))
|
|
|
|
(test-text " b"
|
|
(textual-trim-right (string->text " a b c ")
|
|
char-whitespace? 3 8))
|
|
|
|
(test-text ""
|
|
(textual-trim-right (string->text " a b c ") char? 3 8))
|
|
|
|
|
|
(test-text ""
|
|
(textual-trim-both (string->text "")))
|
|
|
|
(test-text "a b c"
|
|
(textual-trim-both (string->text " a b c ")))
|
|
|
|
(test-text ""
|
|
(textual-trim-both (string->text "") char-whitespace?))
|
|
|
|
(test-text "a b c"
|
|
(textual-trim-both (string->text " a b c ")
|
|
char-whitespace?))
|
|
|
|
(test-text ""
|
|
(textual-trim-both (string->text " a b c ") char?))
|
|
|
|
(test-text ""
|
|
(textual-trim-both (string->text "") char-whitespace? 0))
|
|
|
|
(test-text "a b c"
|
|
(textual-trim-both (string->text " a b c ")
|
|
char-whitespace? 0))
|
|
|
|
(test-text ""
|
|
(textual-trim-both (string->text " a b c ") char? 0))
|
|
|
|
(test-text "b c"
|
|
(textual-trim-both (string->text " a b c ")
|
|
char-whitespace? 3))
|
|
|
|
(test-text ""
|
|
(textual-trim-both (string->text " a b c ") char? 3))
|
|
|
|
(test-text ""
|
|
(textual-trim-both (string->text " a b c ") char? 0 11))
|
|
|
|
(test-text "b c"
|
|
(textual-trim-both (string->text " a b c ")
|
|
char-whitespace? 3 11))
|
|
|
|
(test-text ""
|
|
(textual-trim-both (string->text " a b c ") char? 3 11))
|
|
|
|
(test-text ""
|
|
(textual-trim-both (string->text " a b c ") char? 0 8))
|
|
|
|
(test-text "b"
|
|
(textual-trim-both (string->text " a b c ")
|
|
char-whitespace? 3 8))
|
|
|
|
(test-text ""
|
|
(textual-trim-both (string->text " a b c ") char? 3 8))
|
|
|
|
|
|
(test-text ""
|
|
(textual-trim ""))
|
|
|
|
(test-text "a b c "
|
|
(textual-trim " a b c "))
|
|
|
|
(test-text ""
|
|
(textual-trim "" char-whitespace?))
|
|
|
|
(test-text "a b c "
|
|
(textual-trim " a b c " char-whitespace?))
|
|
|
|
(test-text ""
|
|
(textual-trim " a b c " char?))
|
|
|
|
(test-text ""
|
|
(textual-trim "" char-whitespace? 0))
|
|
|
|
(test-text "a b c "
|
|
(textual-trim " a b c " char-whitespace? 0))
|
|
|
|
(test-text ""
|
|
(textual-trim " a b c " char? 0))
|
|
|
|
(test-text "b c "
|
|
(textual-trim " a b c " char-whitespace? 3))
|
|
|
|
(test-text ""
|
|
(textual-trim " a b c " char? 3))
|
|
|
|
(test-text ""
|
|
(textual-trim " a b c " char? 0 11))
|
|
|
|
(test-text "b c "
|
|
(textual-trim " a b c " char-whitespace? 3 11))
|
|
|
|
(test-text ""
|
|
(textual-trim " a b c " char? 3 11))
|
|
|
|
(test-text ""
|
|
(textual-trim " a b c " char? 0 8))
|
|
|
|
(test-text "b "
|
|
(textual-trim " a b c " char-whitespace? 3 8))
|
|
|
|
(test-text ""
|
|
(textual-trim " a b c " char? 3 8))
|
|
|
|
|
|
(test-text ""
|
|
(textual-trim-right ""))
|
|
|
|
(test-text " a b c"
|
|
(textual-trim-right " a b c "))
|
|
|
|
(test-text ""
|
|
(textual-trim-right "" char-whitespace?))
|
|
|
|
(test-text " a b c"
|
|
(textual-trim-right " a b c " char-whitespace?))
|
|
|
|
(test-text ""
|
|
(textual-trim-right " a b c " char?))
|
|
|
|
(test-text ""
|
|
(textual-trim-right "" char-whitespace? 0))
|
|
|
|
(test-text " a b c"
|
|
(textual-trim-right " a b c " char-whitespace? 0))
|
|
|
|
(test-text ""
|
|
(textual-trim-right " a b c " char? 0))
|
|
|
|
(test-text " b c"
|
|
(textual-trim-right " a b c " char-whitespace? 3))
|
|
|
|
(test-text ""
|
|
(textual-trim-right " a b c " char? 3))
|
|
|
|
(test-text ""
|
|
(textual-trim-right " a b c " char? 0 11))
|
|
|
|
(test-text " b c"
|
|
(textual-trim-right " a b c " char-whitespace? 3 11))
|
|
|
|
(test-text ""
|
|
(textual-trim-right " a b c " char? 3 11))
|
|
|
|
(test-text ""
|
|
(textual-trim-right " a b c " char? 0 8))
|
|
|
|
(test-text " b"
|
|
(textual-trim-right " a b c " char-whitespace? 3 8))
|
|
|
|
(test-text ""
|
|
(textual-trim-right " a b c " char? 3 8))
|
|
|
|
|
|
(test-text ""
|
|
(textual-trim-both ""))
|
|
|
|
(test-text "a b c"
|
|
(textual-trim-both " a b c "))
|
|
|
|
(test-text ""
|
|
(textual-trim-both "" char-whitespace?))
|
|
|
|
(test-text "a b c"
|
|
(textual-trim-both " a b c " char-whitespace?))
|
|
|
|
(test-text ""
|
|
(textual-trim-both " a b c " char?))
|
|
|
|
(test-text ""
|
|
(textual-trim-both "" char-whitespace? 0))
|
|
|
|
(test-text "a b c"
|
|
(textual-trim-both " a b c " char-whitespace? 0))
|
|
|
|
(test-text ""
|
|
(textual-trim-both " a b c " char? 0))
|
|
|
|
(test-text "b c"
|
|
(textual-trim-both " a b c " char-whitespace? 3))
|
|
|
|
(test-text ""
|
|
(textual-trim-both " a b c " char? 3))
|
|
|
|
(test-text ""
|
|
(textual-trim-both " a b c " char? 0 11))
|
|
|
|
(test-text "b c"
|
|
(textual-trim-both " a b c " char-whitespace? 3 11))
|
|
|
|
(test-text ""
|
|
(textual-trim-both " a b c " char? 3 11))
|
|
|
|
(test-text ""
|
|
(textual-trim-both " a b c " char? 0 8))
|
|
|
|
(test-text "b"
|
|
(textual-trim-both " a b c " char-whitespace? 3 8))
|
|
|
|
(test-text ""
|
|
(textual-trim-both " a b c " char? 3 8))
|
|
|
|
|
|
;; Replacement
|
|
|
|
(test-text "It's lots of fun to code it up in Scheme."
|
|
(textual-replace (as-text "It's easy to code it up in Scheme.")
|
|
(as-text "lots of fun")
|
|
5 9))
|
|
|
|
(test-text "The miserable perl programmer endured daily ridicule."
|
|
(textual-replace "The TCL programmer endured daily ridicule."
|
|
(as-text "another miserable perl drone")
|
|
4 7 8 22))
|
|
|
|
(test-text "It's really easy to code it up in Scheme."
|
|
(textual-replace (as-text "It's easy to code it up in Scheme.")
|
|
"really "
|
|
5 5))
|
|
|
|
(test-text "Runs in O(1) time." ; for texts (using sample implementations)
|
|
(textual-replace "Runs in O(n) time." (text #\1) 10 11))
|
|
|
|
;; Comparison
|
|
;;
|
|
;; The comparison tests aren't perfectly black-box because the
|
|
;; specification of these comparison procedures allows them to
|
|
;; use an ordering other than the usual lexicographic ordering.
|
|
;; The sample implementations use lexicographic ordering, however,
|
|
;; and a test program that discourages implementations from using
|
|
;; orderings that differ from the usual on such simple cases is
|
|
;; probably doing a public service.
|
|
|
|
(test #t (textual=? (as-text "Strasse") (as-text "Strasse")))
|
|
|
|
(test #t (textual=? "Strasse" (as-text "Strasse") "Strasse"))
|
|
|
|
(test #f (textual<? (as-text "z") (as-text "z")))
|
|
(test #t (textual<? (as-text "z") "zz"))
|
|
(test #f (textual<? (as-text "z") (as-text "Z")))
|
|
(test #t (textual<=? (as-text "z") "zz"))
|
|
(test #f (textual<=? "z" "Z"))
|
|
(test #t (textual<=? "z" (as-text "z")))
|
|
|
|
(test #f (textual<? "z" (as-text "z")))
|
|
(test #f (textual>? (as-text "z") "zz"))
|
|
(test #t (textual>? "z" (as-text "Z")))
|
|
(test #f (textual>=? (as-text "z") "zz"))
|
|
(test #t (textual>=? "z" "Z"))
|
|
(test #t (textual>=? (as-text "z") (as-text "z")))
|
|
|
|
|
|
(let* ((w "a")
|
|
(x "abc")
|
|
(y "def")
|
|
(z (text #\a #\b #\c)))
|
|
|
|
(test #f (textual=? x y z))
|
|
(test #t (textual=? x x z))
|
|
(test #f (textual=? w x y))
|
|
(test #f (textual=? y x w))
|
|
|
|
(test #f (textual<? x y z))
|
|
(test #f (textual<? x x z))
|
|
(test #t (textual<? w x y))
|
|
(test #f (textual<? y x w))
|
|
|
|
(test #f (textual>? x y z))
|
|
(test #f (textual>? x x z))
|
|
(test #f (textual>? w x y))
|
|
(test #t (textual>? y x w))
|
|
|
|
(test #f (textual<=? x y z))
|
|
(test #t (textual<=? x x z))
|
|
(test #t (textual<=? w x y))
|
|
(test #f (textual<=? y x w))
|
|
|
|
(test #f (textual>=? x y z))
|
|
(test #t (textual>=? x x z))
|
|
(test #f (textual>=? w x y))
|
|
(test #t (textual>=? y x w))
|
|
|
|
|
|
(test #t (textual=? x x))
|
|
(test #f (textual=? w x))
|
|
(test #f (textual=? y x))
|
|
|
|
(test #f (textual<? x x))
|
|
(test #t (textual<? w x))
|
|
(test #f (textual<? y x))
|
|
|
|
(test #f (textual>? x x))
|
|
(test #f (textual>? w x))
|
|
(test #t (textual>? y x))
|
|
|
|
(test #t (textual<=? x x))
|
|
(test #t (textual<=? w x))
|
|
(test #f (textual<=? y x))
|
|
|
|
(test #t (textual>=? x x))
|
|
(test #f (textual>=? w x))
|
|
(test #t (textual>=? y x)))
|
|
|
|
|
|
(test #t (textual-ci<? "a" "Z"))
|
|
(test #t (textual-ci<? "A" "z"))
|
|
(test #f (textual-ci<? "Z" "a"))
|
|
(test #f (textual-ci<? "z" "A"))
|
|
(test #f (textual-ci<? "z" "Z"))
|
|
(test #f (textual-ci<? "Z" "z"))
|
|
(test #f (textual-ci>? "a" "Z"))
|
|
(test #f (textual-ci>? "A" "z"))
|
|
(test #t (textual-ci>? "Z" "a"))
|
|
(test #t (textual-ci>? "z" "A"))
|
|
(test #f (textual-ci>? "z" "Z"))
|
|
(test #f (textual-ci>? "Z" "z"))
|
|
(test #t (textual-ci=? "z" "Z"))
|
|
(test #f (textual-ci=? "z" "a"))
|
|
(test #t (textual-ci<=? "a" "Z"))
|
|
(test #t (textual-ci<=? "A" "z"))
|
|
(test #f (textual-ci<=? "Z" "a"))
|
|
(test #f (textual-ci<=? "z" "A"))
|
|
(test #t (textual-ci<=? "z" "Z"))
|
|
(test #t (textual-ci<=? "Z" "z"))
|
|
(test #f (textual-ci>=? "a" "Z"))
|
|
(test #f (textual-ci>=? "A" "z"))
|
|
(test #t (textual-ci>=? "Z" "a"))
|
|
(test #t (textual-ci>=? "z" "A"))
|
|
(test #t (textual-ci>=? "z" "Z"))
|
|
(test #t (textual-ci>=? "Z" "z"))
|
|
|
|
;; The full-unicode feature doesn't imply full Unicode in strings,
|
|
;; so these tests might fail even in a conforming implementation.
|
|
;; Implementations that support full Unicode strings often have
|
|
;; this feature, however, even though it isn't listed in the R7RS.
|
|
|
|
(cond-expand
|
|
(full-unicode-strings
|
|
(test #f (textual=? ABCDEF DEFABC))
|
|
(test #f (textual=? DEFABC ABCDEF))
|
|
(test #t (textual=? DEFABC DEFABC))
|
|
|
|
(test #f (textual<? ABCDEF DEFABC))
|
|
(test #t (textual<? DEFABC ABCDEF))
|
|
(test #f (textual<? DEFABC DEFABC))
|
|
|
|
(test #t (textual>? ABCDEF DEFABC))
|
|
(test #f (textual>? DEFABC ABCDEF))
|
|
(test #f (textual>? DEFABC DEFABC))
|
|
|
|
(test #f (textual<=? ABCDEF DEFABC))
|
|
(test #t (textual<=? DEFABC ABCDEF))
|
|
(test #t (textual<=? DEFABC DEFABC))
|
|
|
|
(test #t (textual>=? ABCDEF DEFABC))
|
|
(test #f (textual>=? DEFABC ABCDEF))
|
|
(test #t (textual>=? DEFABC DEFABC))
|
|
|
|
(test #f (textual=? "Fuss" fuss))
|
|
(test #f (textual=? "Fuss" "Fuss" fuss))
|
|
(test #f (textual=? "Fuss" fuss "Fuss"))
|
|
(test #f (textual=? fuss "Fuss" "Fuss"))
|
|
(test #t (textual<? "z" (as-text eszett)))
|
|
(test #f (textual<? (as-text eszett) "z"))
|
|
(test #t (textual<=? "z" (as-text eszett)))
|
|
(test #f (textual<=? (as-text eszett) "z"))
|
|
(test #f (textual>? "z" (as-text eszett)))
|
|
(test #t (textual>? (as-text eszett) "z"))
|
|
(test #f (textual>=? "z" (as-text eszett)))
|
|
(test #t (textual>=? (as-text eszett) "z"))
|
|
(test-assert (textual-ci=? fuss "Fuss"))
|
|
(test-assert (textual-ci=? fuss "FUSS"))
|
|
(test-assert (textual-ci=? chaos0 chaos1 chaos2)))
|
|
(else))
|
|
|
|
;; Prefixes and suffixes
|
|
|
|
(test 0 (textual-prefix-length ABC ABCDEF))
|
|
|
|
(test 0 (textual-prefix-length ABCDEF ABC))
|
|
|
|
(test 0 (textual-prefix-length ABCDEF DEFABC))
|
|
|
|
(test 6 (textual-prefix-length DEFABC DEFABC))
|
|
|
|
(test 6 (textual-prefix-length (textual->string DEFABC) DEFABC))
|
|
|
|
(test 6 (textual-prefix-length DEFABC (textual->string DEFABC)))
|
|
|
|
(test 6 (textual-prefix-length (textual->string DEFABC)
|
|
(textual->string DEFABC)))
|
|
|
|
(test 0 (textual-prefix-length (as-text "") (as-text "")))
|
|
|
|
(test 0 (textual-prefix-length (as-text "") (as-text "aabbccddee")))
|
|
|
|
(test 0 (textual-prefix-length (as-text "aisle") (as-text "")))
|
|
|
|
(test 0 (textual-prefix-length (as-text "") (as-text "aabbccddee")))
|
|
|
|
(test 1 (textual-prefix-length (as-text "aisle") (as-text "aabbccddee")))
|
|
|
|
(test 0 (textual-prefix-length (as-text "bail") (as-text "aabbccddee")))
|
|
|
|
(test 4 (textual-prefix-length (as-text "prefix") (as-text "preface")))
|
|
|
|
(test 0 (textual-prefix-length (as-text "") (as-text "") 0))
|
|
|
|
(test 0 (textual-prefix-length (as-text "") (as-text "aabbccddee") 0))
|
|
|
|
(test 0 (textual-prefix-length (as-text "aisle") (as-text "") 0))
|
|
|
|
(test 1 (textual-prefix-length (as-text "aisle") (as-text "aabbccddee") 0))
|
|
|
|
(test 0 (textual-prefix-length (as-text "bail") (as-text "aabbccddee") 0))
|
|
|
|
(test 4 (textual-prefix-length (as-text "prefix") (as-text "preface") 0))
|
|
|
|
(test 0 (textual-prefix-length (as-text "aisle") (as-text "") 1))
|
|
|
|
(test 0 (textual-prefix-length (as-text "aisle") (as-text "aabbccddee") 1))
|
|
|
|
(test 1 (textual-prefix-length (as-text "bail") (as-text "aabbccddee") 1))
|
|
|
|
(test 0 (textual-prefix-length (as-text "prefix") (as-text "preface") 1))
|
|
|
|
(test 0 (textual-prefix-length (as-text "") (as-text "") 0 0))
|
|
|
|
(test 0 (textual-prefix-length (as-text "") (as-text "aabbccddee") 0 0))
|
|
|
|
(test 0 (textual-prefix-length (as-text "aisle") (as-text "") 0 4))
|
|
|
|
(test 1 (textual-prefix-length (as-text "aisle") (as-text "aabbccddee") 0 4))
|
|
|
|
(test 0 (textual-prefix-length (as-text "bail") (as-text "aabbccddee") 0 1))
|
|
|
|
(test 0 (textual-prefix-length (as-text "aisle") (as-text "") 1 4))
|
|
|
|
(test 0 (textual-prefix-length (as-text "aisle") (as-text "aabbccddee") 1 4))
|
|
|
|
(test 1 (textual-prefix-length (as-text "bail") (as-text "aabbccddee") 1 4))
|
|
|
|
(test 0 (textual-prefix-length (as-text "prefix") (as-text "preface") 1 5))
|
|
|
|
(test 0 (textual-prefix-length (as-text "") (as-text "") 0 0 0))
|
|
|
|
(test 0 (textual-prefix-length (as-text "") (as-text "aabbccddee") 0 0 0))
|
|
|
|
(test 0 (textual-prefix-length (as-text "aisle") (as-text "") 0 4 0))
|
|
|
|
(test 0 (textual-prefix-length (as-text "aisle") (as-text "aabbccddee") 0 4 2))
|
|
|
|
(test 1 (textual-prefix-length (as-text "bail") (as-text "aabbccddee") 0 1 2))
|
|
|
|
(test 0 (textual-prefix-length (as-text "prefix") (as-text "preface") 0 5 1))
|
|
|
|
(test 0 (textual-prefix-length (as-text "aisle") (as-text "") 1 4 0))
|
|
|
|
(test 0 (textual-prefix-length (as-text "aisle") (as-text "aabbccddee") 1 4 3))
|
|
|
|
(test 0 (textual-prefix-length (as-text "bail") (as-text "aabbccddee") 1 4 3))
|
|
|
|
(test 3 (textual-prefix-length (as-text "prefix") (as-text "preface") 1 5 1))
|
|
|
|
(test 0 (textual-prefix-length (as-text "") (as-text "") 0 0 0 0))
|
|
|
|
(test 0 (textual-prefix-length (as-text "") (as-text "aabbccddee") 0 0 0 0))
|
|
|
|
(test 0 (textual-prefix-length (as-text "aisle") (as-text "") 0 4 0 0))
|
|
|
|
(test 0 (textual-prefix-length (as-text "aisle") "aabbccddee" 0 4 2 10))
|
|
|
|
(test 1 (textual-prefix-length (as-text "bail") (as-text "aabbccddee") 0 1 2 10))
|
|
|
|
(test 0 (textual-prefix-length (as-text "prefix") (as-text "preface") 0 5 1 6))
|
|
|
|
(test 0 (textual-prefix-length (as-text "aisle") (as-text "") 1 4 0 0))
|
|
|
|
(test 0 (textual-prefix-length (as-text "aisle") (as-text "aabbccddee") 1 4 3 3))
|
|
|
|
(test 0 (textual-prefix-length (as-text "bail") (as-text "aabbccddee") 1 4 3 6))
|
|
|
|
(test 3 (textual-prefix-length (as-text "prefix") (as-text "preface") 1 5 1 7))
|
|
|
|
|
|
(test 0 (textual-suffix-length ABC ABCDEF))
|
|
|
|
(test 0 (textual-suffix-length ABCDEF ABC))
|
|
|
|
(test 0 (textual-suffix-length ABCDEF DEFABC))
|
|
|
|
(test 6 (textual-suffix-length DEFABC DEFABC))
|
|
|
|
(test 6 (textual-suffix-length (textual->string DEFABC) DEFABC))
|
|
|
|
(test 6 (textual-suffix-length DEFABC (textual->string DEFABC)))
|
|
|
|
(test 6 (textual-suffix-length (textual->string DEFABC) (textual->string DEFABC)))
|
|
|
|
(test 0 (textual-suffix-length (as-text "") (as-text "")))
|
|
|
|
(test 0 (textual-suffix-length (as-text "") (as-text "aabbccddee")))
|
|
|
|
(test 0 (textual-suffix-length (as-text "aisle") (as-text "")))
|
|
|
|
(test 0 (textual-suffix-length (as-text "") (as-text "aabbccddee")))
|
|
|
|
(test 1 (textual-suffix-length (as-text "aisle") (as-text "aabbccddee")))
|
|
|
|
(test 0 (textual-suffix-length (as-text "bail") (as-text "aabbccddee")))
|
|
|
|
(test 3 (textual-suffix-length (as-text "place") (as-text "preface")))
|
|
|
|
(test 0 (textual-suffix-length (as-text "") (as-text "") 0))
|
|
|
|
(test 0 (textual-suffix-length (as-text "") (as-text "aabbccddee") 0))
|
|
|
|
(test 0 (textual-suffix-length (as-text "aisle") (as-text "") 0))
|
|
|
|
(test 1 (textual-suffix-length (as-text "aisle") (as-text "aabbccddee") 0))
|
|
|
|
(test 0 (textual-suffix-length (as-text "bail") (as-text "aabbccddee") 0))
|
|
|
|
(test 3 (textual-suffix-length (as-text "place") (as-text "preface") 0))
|
|
|
|
(test 0 (textual-suffix-length (as-text "aisle") (as-text "") 1))
|
|
|
|
(test 1 (textual-suffix-length (as-text "aisle") (as-text "aabbccddee") 1))
|
|
|
|
(test 0 (textual-suffix-length (as-text "bail") (as-text "aabbccddee") 1))
|
|
|
|
(test 3 (textual-suffix-length (as-text "place") (as-text "preface") 1))
|
|
|
|
(test 0 (textual-suffix-length (as-text "") (as-text "") 0 0))
|
|
|
|
(test 0 (textual-suffix-length (as-text "") (as-text "aabbccddee") 0 0))
|
|
|
|
(test 0 (textual-suffix-length (as-text "aisle") (as-text "") 0 4))
|
|
|
|
(test 0 (textual-suffix-length (as-text "aisle") (as-text "aabbccddee") 0 4))
|
|
|
|
(test 0 (textual-suffix-length (as-text "bail") (as-text "aabbccddee") 0 1))
|
|
|
|
(test 0 (textual-suffix-length (as-text "aisle") (as-text "") 1 4))
|
|
|
|
(test 0 (textual-suffix-length (as-text "aisle") (as-text "aabbccddee") 1 4))
|
|
|
|
(test 1 (textual-suffix-length (as-text "aisle") (as-text "aabbccddee") 1 5))
|
|
|
|
(test 0 (textual-suffix-length (as-text "bail") (as-text "aabbccddee") 1 4))
|
|
|
|
(test 3 (textual-suffix-length (as-text "place") (as-text "preface") 1 5))
|
|
|
|
(test 0 (textual-suffix-length (as-text "") (as-text "") 0 0 0))
|
|
|
|
(test 0 (textual-suffix-length (as-text "") (as-text "aabbccddee") 0 0 0))
|
|
|
|
(test 0 (textual-suffix-length (as-text "aisle") (as-text "") 0 4 0))
|
|
|
|
(test 0 (textual-suffix-length (as-text "aisle") (as-text "aabbccddee") 0 4 2))
|
|
|
|
(test 0 (textual-suffix-length (as-text "bail") (as-text "aabbccddee") 0 1 2))
|
|
|
|
(test 3 (textual-suffix-length (as-text "place") (as-text "preface") 0 5 1))
|
|
|
|
(test 0 (textual-suffix-length (as-text "aisle") (as-text "") 1 4 0))
|
|
|
|
(test 0 (textual-suffix-length (as-text "aisle") (as-text "aabbccddee") 1 4 3))
|
|
|
|
(test 0 (textual-suffix-length (as-text "bail") (as-text "aabbccddee") 1 4 3))
|
|
|
|
(test 3 (textual-suffix-length (as-text "place") (as-text "preface") 1 5 1))
|
|
|
|
(test 0 (textual-suffix-length (as-text "") (as-text "") 0 0 0 0))
|
|
|
|
(test 0 (textual-suffix-length (as-text "") (as-text "aabbccddee") 0 0 0 0))
|
|
|
|
(test 0 (textual-suffix-length (as-text "aisle") (as-text "") 0 4 0 0))
|
|
|
|
(test 1 (textual-suffix-length "aisle" (as-text "aabbccddee") 0 5 2 10))
|
|
|
|
(test 1 (textual-suffix-length (as-text "bail") (as-text "aabbccddee") 0 1 2 4))
|
|
|
|
(test 0 (textual-suffix-length (as-text "place") (as-text "preface") 0 5 1 6))
|
|
|
|
(test 2 (textual-suffix-length (as-text "place") (as-text "preface") 0 4 1 6))
|
|
|
|
(test 0 (textual-suffix-length (as-text "aisle") (as-text "") 1 4 0 0))
|
|
|
|
(test 0 (textual-suffix-length (as-text "aisle") (as-text "aabbccddee") 1 4 3 3))
|
|
|
|
(test 0 (textual-suffix-length (as-text "bail") (as-text "aabbccddee") 1 4 3 6))
|
|
|
|
(test 3 (textual-suffix-length (as-text "place") (as-text "preface") 1 5 1 7))
|
|
|
|
|
|
(test-assert (eq? #f (textual-prefix? ABC ABCDEF)))
|
|
|
|
(test-assert (eq? #f (textual-prefix? ABCDEF ABC)))
|
|
|
|
(test-assert (eq? #f (textual-prefix? ABCDEF DEFABC)))
|
|
|
|
(test-assert (eq? #t (textual-prefix? DEFABC DEFABC)))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (textual->string DEFABC) DEFABC)))
|
|
|
|
(test-assert (eq? #t (textual-prefix? DEFABC (textual->string DEFABC))))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (textual->string DEFABC) (textual->string DEFABC))))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "") (as-text ""))))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "") (as-text "abc"))))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "a") (as-text "abc"))))
|
|
|
|
(test-assert (eq? #f (textual-prefix? (as-text "c") (as-text "abc"))))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "ab") (as-text "abc"))))
|
|
|
|
(test-assert (eq? #f (textual-prefix? (as-text "ac") (as-text "abc"))))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "abc") (as-text "abc"))))
|
|
|
|
(test-assert (eq? #f (textual-suffix? ABC ABCDEF)))
|
|
|
|
(test-assert (eq? #f (textual-suffix? ABCDEF ABC)))
|
|
|
|
(test-assert (eq? #f (textual-suffix? ABCDEF DEFABC)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? DEFABC DEFABC)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (textual->string DEFABC) DEFABC)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? DEFABC (textual->string DEFABC))))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "") (as-text ""))))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "") (as-text "abc"))))
|
|
|
|
(test-assert (eq? #f (textual-suffix? (as-text "a") (as-text "abc"))))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "c") (as-text "abc"))))
|
|
|
|
(test-assert (eq? #f (textual-suffix? (as-text "ac") (as-text "abc"))))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "bc") (as-text "abc"))))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "abc") (as-text "abc"))))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "") (as-text "") 0)))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "") (as-text "abc") 0)))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "a") (as-text "abc") 0)))
|
|
|
|
(test-assert (eq? #f (textual-prefix? (as-text "c") (as-text "abc") 0)))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "ab") (as-text "abc") 0)))
|
|
|
|
(test-assert (eq? #f (textual-prefix? (as-text "ac") (as-text "abc") 0)))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "abc") (as-text "abc") 0)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "") (as-text "") 0)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "") (as-text "abc") 0)))
|
|
|
|
(test-assert (eq? #f (textual-suffix? (as-text "a") (as-text "abc") 0)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "c") (as-text "abc") 0)))
|
|
|
|
(test-assert (eq? #f (textual-suffix? (as-text "ac") (as-text "abc") 0)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "bc") (as-text "abc") 0)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "abc") (as-text "abc") 0)))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "ab") (as-text "abc") 2)))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "ac") (as-text "abc") 2)))
|
|
|
|
(test-assert (eq? #f (textual-prefix? (as-text "abc") (as-text "abc") 2)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "ac") (as-text "abc") 2)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "bc") (as-text "abc") 2)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "abc") (as-text "abc") 2)))
|
|
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "") (as-text "") 0 0)))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "") (as-text "abc") 0 0)))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "a") (as-text "abc") 0 0)))
|
|
|
|
(test-assert (eq? #f (textual-prefix? (as-text "c") (as-text "abc") 0 1)))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "ab") (as-text "abc") 0 1)))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "ab") (as-text "abc") 0 2)))
|
|
|
|
(test-assert (eq? #f (textual-prefix? (as-text "ac") (as-text "abc") 0 2)))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "abc") (as-text "abc") 0 3)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "") (as-text "") 0 0)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "") (as-text "abc") 0 0)))
|
|
|
|
(test-assert (eq? #f (textual-suffix? (as-text "a") (as-text "abc") 0 1)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "c") (as-text "abc") 0 1)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "ac") (as-text "abc") 1 2)))
|
|
|
|
(test-assert (eq? #f (textual-suffix? (as-text "ac") (as-text "abc") 0 2)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "bc") (as-text "abc") 0 2)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "abc") (as-text "abc") 0 3)))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "ab") (as-text "abc") 2 2)))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "ac") (as-text "abc") 2 2)))
|
|
|
|
(test-assert (eq? #f (textual-prefix? (as-text "abc") (as-text "abc") 2 3)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "ac") (as-text "abc") 2 2)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "bc") (as-text "abc") 2 2)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "abc") (as-text "abc") 2 3)))
|
|
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "") (as-text "") 0 0 0)))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "") (as-text "abc") 0 0 0)))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "a") (as-text "abc") 0 0 0)))
|
|
|
|
(test-assert (eq? #f (textual-prefix? (as-text "c") (as-text "abc") 0 1 0)))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "ab") (as-text "abc") 0 1 0)))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "ab") (as-text "abc") 0 2 0)))
|
|
|
|
(test-assert (eq? #f (textual-prefix? (as-text "ac") (as-text "abc") 0 2 0)))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "abc") (as-text "abc") 0 3 0)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "") (as-text "") 0 0 0)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "") (as-text "abc") 0 0 0)))
|
|
|
|
(test-assert (eq? #f (textual-suffix? (as-text "a") (as-text "abc") 0 1 0)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "c") (as-text "abc") 0 1 0)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "ac") (as-text "abc") 1 2 0)))
|
|
|
|
(test-assert (eq? #f (textual-suffix? (as-text "ac") (as-text "abc") 0 2 0)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "bc") (as-text "abc") 0 2 0)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "abc") (as-text "abc") 0 3 0)))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "ab") (as-text "abc") 2 2 0)))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "ac") (as-text "abc") 2 2 0)))
|
|
|
|
(test-assert (eq? #f (textual-prefix? (as-text "abc") (as-text "abc") 2 3 0)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "ac") (as-text "abc") 2 2 0)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "bc") (as-text "abc") 2 2 0)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "abc") (as-text "abc") 2 3 0)))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "") (as-text "abc") 0 0 1)))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "a") (as-text "abc") 0 0 1)))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "c") (as-text "abc") 0 1 2)))
|
|
|
|
(test-assert (eq? #f (textual-prefix? (as-text "ab") (as-text "abc") 0 1 2)))
|
|
|
|
(test-assert (eq? #f (textual-prefix? (as-text "ab") (as-text "abc") 0 2 1)))
|
|
|
|
(test-assert (eq? #f (textual-prefix? (as-text "ac") (as-text "abc") 0 2 1)))
|
|
|
|
(test-assert (eq? #f (textual-prefix? (as-text "abc") (as-text "abc") 0 3 1)))
|
|
|
|
(test-assert (eq? #f (textual-suffix? (as-text "a") (as-text "abc") 0 1 2)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "c") (as-text "abc") 0 1 1)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "ac") (as-text "abc") 1 2 2)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "bc") (as-text "abc") 0 2 1)))
|
|
|
|
(test-assert (eq? #f (textual-suffix? (as-text "bc") (as-text "abc") 0 2 2)))
|
|
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "") (as-text "") 0 0 0 0)))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "") (as-text "abc") 0 0 0 3)))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "a") (as-text "abc") 0 0 0 3)))
|
|
|
|
(test-assert (eq? #f (textual-prefix? (as-text "c") (as-text "abc") 0 1 0 3)))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "ab") (as-text "abc") 0 1 0 3)))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "ab") (as-text "abc") 0 2 0 3)))
|
|
|
|
(test-assert (eq? #f (textual-prefix? (as-text "ac") (as-text "abc") 0 2 0 3)))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "abc") (as-text "abc") 0 3 0 3)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "") (as-text "abc") 0 0 0 3)))
|
|
|
|
(test-assert (eq? #f (textual-suffix? (as-text "a") (as-text "abc") 0 1 0 3)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "c") (as-text "abc") 0 1 0 3)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "ac") (as-text "abc") 1 2 0 3)))
|
|
|
|
(test-assert (eq? #f (textual-suffix? (as-text "ac") (as-text "abc") 0 2 0 3)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "bc") (as-text "abc") 0 2 0 3)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "abc") (as-text "abc") 0 3 0 3)))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "ab") (as-text "abc") 2 2 0 3)))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "ac") (as-text "abc") 2 2 0 3)))
|
|
|
|
(test-assert (eq? #f (textual-prefix? (as-text "abc") (as-text "abc") 2 3 0 3)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "ac") (as-text "abc") 2 2 0 3)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "bc") (as-text "abc") 2 2 0 3)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "abc") (as-text "abc") 2 3 0 3)))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "") (as-text "abc") 0 0 1 3)))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "a") (as-text "abc") 0 0 1 3)))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "c") (as-text "abc") 0 1 2 3)))
|
|
|
|
(test-assert (eq? #f (textual-prefix? (as-text "ab") (as-text "abc") 0 1 2 3)))
|
|
|
|
(test-assert (eq? #f (textual-prefix? (as-text "ab") (as-text "abc") 0 2 1 3)))
|
|
|
|
(test-assert (eq? #f (textual-prefix? (as-text "ac") (as-text "abc") 0 2 1 3)))
|
|
|
|
(test-assert (eq? #f (textual-prefix? (as-text "abc") (as-text "abc") 0 3 1 3)))
|
|
|
|
(test-assert (eq? #f (textual-suffix? (as-text "a") (as-text "abc") 0 1 2 3)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "c") (as-text "abc") 0 1 1 3)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "ac") (as-text "abc") 1 2 2 3)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "bc") (as-text "abc") 0 2 1 3)))
|
|
|
|
(test-assert (eq? #f (textual-suffix? (as-text "bc") (as-text "abc") 0 2 2 3)))
|
|
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "") (as-text "abc") 0 0 0 2)))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "a") (as-text "abc") 0 0 0 2)))
|
|
|
|
(test-assert (eq? #f (textual-prefix? (as-text "c") (as-text "abc") 0 1 0 2)))
|
|
|
|
(test-assert (eq? #t (textual-prefix? (as-text "ab") (as-text "abc") 0 1 0 2)))
|
|
|
|
(test-assert (eq? #f (textual-prefix? (as-text "abc") (as-text "abc") 0 3 0 2)))
|
|
|
|
(test-assert (eq? #t (textual-suffix? (as-text "") (as-text "abc") 0 0 0 2)))
|
|
|
|
(test-assert (eq? #f (textual-suffix? (as-text "c") (as-text "abc") 0 1 0 2)))
|
|
|
|
(test-assert (eq? #f (textual-suffix? (as-text "ac") (as-text "abc") 1 2 0 2)))
|
|
|
|
;; Searching
|
|
|
|
(test-assert (eqv? #f (textual-index (as-text "") char?)))
|
|
|
|
(test-assert (eqv? 0 (textual-index (as-text "abcdef") char?)))
|
|
|
|
(test-assert (eqv? 4 (textual-index (as-text "abcdef") (lambda (c) (char>? c #\d)))))
|
|
|
|
(test-assert (eqv? #f (textual-index (as-text "abcdef") char-whitespace?)))
|
|
|
|
(test-assert (eqv? #f (textual-index-right (as-text "") char?)))
|
|
|
|
(test-assert (eqv? 5 (textual-index-right (as-text "abcdef") char?)))
|
|
|
|
(test-assert (eqv? 5 (textual-index-right (as-text "abcdef")
|
|
(lambda (c) (char>? c #\d)))))
|
|
|
|
|
|
(test-assert (eqv? #f (textual-index-right (as-text "abcdef") char-whitespace?)))
|
|
|
|
(test-assert (eqv? #f (textual-skip (as-text "") string?)))
|
|
|
|
(test-assert (eqv? 0 (textual-skip (as-text "abcdef") string?)))
|
|
|
|
(test-assert (eqv? 4 (textual-skip (as-text "abcdef") (lambda (c) (char<=? c #\d)))))
|
|
|
|
(test-assert (eqv? #f (textual-skip (as-text "abcdef") char?)))
|
|
|
|
(test-assert (eqv? #f (textual-skip-right (as-text "") string?)))
|
|
|
|
(test-assert (eqv? 5 (textual-skip-right (as-text "abcdef") string?)))
|
|
|
|
(test-assert (eqv? 5 (textual-skip-right (as-text "abcdef")
|
|
(lambda (c) (char<=? c #\d)))))
|
|
|
|
(test-assert (eqv? #f (textual-skip-right (as-text "abcdef") char?)))
|
|
|
|
|
|
(test-assert (eqv? 2 (textual-index "abcdef" char? 2)))
|
|
|
|
(test-assert (eqv? 4 (textual-index "abcdef" (lambda (c) (char>? c #\d)) 2)))
|
|
|
|
(test-assert (eqv? #f (textual-index "abcdef" char-whitespace? 2)))
|
|
|
|
(test-assert (eqv? 5 (textual-index-right "abcdef" char? 2)))
|
|
|
|
(test-assert (eqv? 5 (textual-index-right "abcdef"
|
|
(lambda (c)
|
|
(char>? c #\d)) 2)))
|
|
|
|
(test-assert (eqv? #f (textual-index-right "abcdef" char-whitespace? 2)))
|
|
|
|
(test-assert (eqv? 2 (textual-skip "abcdef" string? 2)))
|
|
|
|
(test-assert (eqv? 4 (textual-skip "abcdef"
|
|
(lambda (c)
|
|
(char<=? c #\d)) 2)))
|
|
|
|
(test-assert (eqv? #f (textual-skip "abcdef" char? 2)))
|
|
|
|
(test-assert (eqv? 5 (textual-skip-right "abcdef" string? 2)))
|
|
|
|
(test-assert (eqv? 5 (textual-skip-right "abcdef"
|
|
(lambda (c)
|
|
(char<=? c #\d)) 2)))
|
|
|
|
(test-assert (eqv? #f (textual-skip-right "abcdef" char? 2)))
|
|
|
|
|
|
(test-assert (eqv? 2 (textual-index (as-text "abcdef") char? 2 5)))
|
|
|
|
(test-assert (eqv? 4 (textual-index (as-text "abcdef")
|
|
(lambda (c) (char>? c #\d)) 2 5)))
|
|
|
|
(test-assert (eqv? #f (textual-index (as-text "abcdef") char-whitespace? 2 5)))
|
|
|
|
(test-assert (eqv? 4 (textual-index-right (as-text "abcdef") char? 2 5)))
|
|
|
|
(test-assert (eqv? 4 (textual-index-right (as-text "abcdef")
|
|
(lambda (c)
|
|
(char>? c #\d)) 2 5)))
|
|
|
|
(test-assert (eqv? #f (textual-index-right (as-text "abcdef")
|
|
char-whitespace? 2 5)))
|
|
|
|
|
|
(test-assert (eqv? 2 (textual-skip (as-text "abcdef") string? 2 5)))
|
|
|
|
(test-assert (eqv? 4 (textual-skip (as-text "abcdef")
|
|
(lambda (c) (char<=? c #\d)) 2 5)))
|
|
|
|
(test-assert (eqv? #f (textual-skip (as-text "abcdef") char? 2 5)))
|
|
|
|
(test-assert (eqv? 4 (textual-skip-right (as-text "abcdef") string? 2 5)))
|
|
|
|
(test-assert (eqv? 4 (textual-skip-right (as-text "abcdef")
|
|
(lambda (c)
|
|
(char<=? c #\d)) 2 5)))
|
|
|
|
(test-assert (eqv? #f (textual-skip-right (as-text "abcdef") char? 2 5)))
|
|
|
|
|
|
(test-assert (eqv? 0 (textual-contains (as-text "") (as-text ""))))
|
|
|
|
(test-assert (eqv? 0 (textual-contains (as-text "abcdeffffoo") (as-text ""))))
|
|
|
|
(test-assert (eqv? 0 (textual-contains (as-text "abcdeffffoo") (as-text "a"))))
|
|
|
|
(test-assert (eqv? 5 (textual-contains (as-text "abcdeffffoo") (as-text "ff"))))
|
|
|
|
(test-assert (eqv? 4 (textual-contains (as-text "abcdeffffoo") (as-text "eff"))))
|
|
|
|
(test-assert (eqv? 8 (textual-contains (as-text "abcdeffffoo") (as-text "foo"))))
|
|
|
|
(test-assert (eqv? #f (textual-contains (as-text "abcdeffffoo") (as-text "efffoo"))))
|
|
|
|
(test-assert (eqv? 0 (textual-contains-right (as-text "") (as-text ""))))
|
|
|
|
(test-assert (eqv? 11 (textual-contains-right (as-text "abcdeffffoo") (as-text ""))))
|
|
|
|
(test-assert (eqv? 0 (textual-contains-right (as-text "abcdeffffoo") (as-text "a"))))
|
|
|
|
(test-assert (eqv? 7 (textual-contains-right (as-text "abcdeffffoo") (as-text "ff"))))
|
|
|
|
(test-assert (eqv? 4 (textual-contains-right (as-text "abcdeffffoo") (as-text "eff"))))
|
|
|
|
(test-assert (eqv? 8 (textual-contains-right (as-text "abcdeffffoo") (as-text "foo"))))
|
|
|
|
(test-assert (eqv? #f (textual-contains-right (as-text "abcdeffffoo")
|
|
(as-text "efffoo"))))
|
|
|
|
|
|
(test-assert (eqv? 0 (textual-contains "" "" 0)))
|
|
|
|
(test-assert (eqv? 2 (textual-contains "abcdeffffoo" "" 2)))
|
|
|
|
(test-assert (eqv? #f (textual-contains "abcdeffffoo" "a" 2)))
|
|
|
|
(test-assert (eqv? 5 (textual-contains "abcdeffffoo" "ff" 2)))
|
|
|
|
(test-assert (eqv? 4 (textual-contains "abcdeffffoo" "eff" 2)))
|
|
|
|
(test-assert (eqv? 8 (textual-contains "abcdeffffoo" "foo" 2)))
|
|
|
|
(test-assert (eqv? #f (textual-contains "abcdeffffoo" "efffoo" 2)))
|
|
|
|
(test-assert (eqv? 0 (textual-contains-right "" "" 0)))
|
|
|
|
(test-assert (eqv? 11 (textual-contains-right "abcdeffffoo" "" 2)))
|
|
|
|
(test-assert (eqv? #f (textual-contains-right "abcdeffffoo" "a" 2)))
|
|
|
|
(test-assert (eqv? 7 (textual-contains-right "abcdeffffoo" "ff" 2)))
|
|
|
|
(test-assert (eqv? 4 (textual-contains-right "abcdeffffoo" "eff" 2)))
|
|
|
|
(test-assert (eqv? 8 (textual-contains-right "abcdeffffoo" "foo" 2)))
|
|
|
|
(test-assert (eqv? #f (textual-contains-right "abcdeffffoo" "efffoo" 2)))
|
|
|
|
|
|
(test-assert (eqv? 0 (textual-contains (as-text "") (as-text "") 0 0)))
|
|
|
|
(test-assert (eqv? 2 (textual-contains (as-text "abcdeffffoo") (as-text "") 2 10)))
|
|
|
|
(test-assert (eqv? #f (textual-contains (as-text "abcdeffffoo") (as-text "a") 2 10)))
|
|
|
|
(test-assert (eqv? 5 (textual-contains (as-text "abcdeffffoo") (as-text "ff") 2 10)))
|
|
|
|
(test-assert (eqv? 4 (textual-contains (as-text "abcdeffffoo") (as-text "eff") 2 10)))
|
|
|
|
(test-assert (eqv? #f (textual-contains (as-text "abcdeffffoo") (as-text "foo") 2 10)))
|
|
|
|
(test-assert (eqv? #f (textual-contains (as-text "abcdeffffoo") (as-text "efffoo") 2 10)))
|
|
|
|
(test-assert (eqv? 0 (textual-contains-right (as-text "") (as-text "") 0 0)))
|
|
|
|
(test-assert (eqv? 10 (textual-contains-right (as-text "abcdeffffoo") (as-text "") 2 10)))
|
|
|
|
(test-assert (eqv? #f (textual-contains-right (as-text "abcdeffffoo") (as-text "a") 2 10)))
|
|
|
|
(test-assert (eqv? 7 (textual-contains-right (as-text "abcdeffffoo") (as-text "ff") 2 10)))
|
|
|
|
(test-assert (eqv? 4 (textual-contains-right (as-text "abcdeffffoo") (as-text "eff") 2 10)))
|
|
|
|
(test-assert (eqv? #f (textual-contains-right (as-text "abcdeffffoo") "foo" 2 10)))
|
|
|
|
(test-assert (eqv? #f (textual-contains-right "abcdeffffoo" (as-text "efffoo") 2 10)))
|
|
|
|
|
|
(test-assert (eqv? 0 (textual-contains "" "" 0 0 0)))
|
|
|
|
(test-assert (eqv? 2 (textual-contains "abcdeffffoo" "" 2 10 0)))
|
|
|
|
(test-assert (eqv? 2 (textual-contains "abcdeffffoo" "a" 2 10 1)))
|
|
|
|
(test-assert (eqv? 5 (textual-contains "abcdeffffoo" "ff" 2 10 1)))
|
|
|
|
(test-assert (eqv? 5 (textual-contains "abcdeffffoo" "eff" 2 10 1)))
|
|
|
|
(test-assert (eqv? #f (textual-contains "abcdeffffoo" "foo" 2 10 1)))
|
|
|
|
(test-assert (eqv? #f (textual-contains "abcdeffffoo" "efffoo" 2 10 1)))
|
|
|
|
(test-assert (eqv? 0 (textual-contains-right "" "" 0 0 0)))
|
|
|
|
(test-assert (eqv? 10 (textual-contains-right "abcdeffffoo" "" 2 10 0)))
|
|
|
|
(test-assert (eqv? 10 (textual-contains-right "abcdeffffoo" "a" 2 10 1)))
|
|
|
|
(test-assert (eqv? 8 (textual-contains-right "abcdeffffoo" "ff" 2 10 1)))
|
|
|
|
(test-assert (eqv? 7 (textual-contains-right "abcdeffffoo" "eff" 2 10 1)))
|
|
|
|
(test-assert (eqv? #f (textual-contains-right "abcdeffffoo" "foo" 2 10 1)))
|
|
|
|
(test-assert (eqv? #f (textual-contains-right "abcdeffffoo" "efffoo" 2 10 1)))
|
|
|
|
|
|
(test-assert (eqv? 0 (textual-contains "" "" 0 0 0 0)))
|
|
|
|
(test-assert (eqv? 2 (textual-contains "abcdeffffoo" "" 2 10 0 0)))
|
|
|
|
(test-assert (eqv? 2 (textual-contains "abcdeffffoo" "a" 2 10 1 1)))
|
|
|
|
(test-assert (eqv? 5 (textual-contains "abcdeffffoo" "ff" 2 10 1 2)))
|
|
|
|
(test-assert (eqv? 5 (textual-contains "abcdeffffoo" "eff" 2 10 1 2)))
|
|
|
|
(test-assert (eqv? 9 (textual-contains "abcdeffffoo" "foo" 2 10 1 2)))
|
|
|
|
(test-assert (eqv? 4 (textual-contains "abcdeffffoo" "efffoo" 2 10 0 2)))
|
|
|
|
(test-assert (eqv? 0 (textual-contains-right "" "" 0 0 0 0)))
|
|
|
|
(test-assert (eqv? 10 (textual-contains-right "abcdeffffoo" "" 2 10 0 0)))
|
|
|
|
(test-assert (eqv? 10 (textual-contains-right "abcdeffffoo" "a" 2 10 1 1)))
|
|
|
|
(test-assert (eqv? 8 (textual-contains-right "abcdeffffoo" "ff" 2 10 1 2)))
|
|
|
|
(test-assert (eqv? 8 (textual-contains-right "abcdeffffoo" "eff" 2 10 1 2)))
|
|
|
|
(test-assert (eqv? 9 (textual-contains-right "abcdeffffoo" "foo" 2 10 1 2)))
|
|
|
|
(test-assert (eqv? 7 (textual-contains-right "abcdeffffoo" "efffoo" 2 10 1 3)))
|
|
|
|
|
|
;; Case conversion
|
|
|
|
;; FIXME: should test some non-ASCII cases here.
|
|
|
|
(test-text "1234STRIKES" (textual-upcase (as-text "1234Strikes")))
|
|
|
|
(test-text "1234STRIKES" (textual-upcase (as-text "1234strikes")))
|
|
|
|
(test-text "1234STRIKES" (textual-upcase (as-text "1234STRIKES")))
|
|
|
|
(test-text "1234strikes" (textual-downcase (as-text "1234Strikes")))
|
|
|
|
(test-text "1234strikes" (textual-downcase (as-text "1234strikes")))
|
|
|
|
(test-text "1234strikes" (textual-downcase (as-text "1234STRIKES")))
|
|
|
|
(test-text "1234strikes" (textual-foldcase (as-text "1234Strikes")))
|
|
|
|
(test-text "1234strikes" (textual-foldcase (as-text "1234strikes")))
|
|
|
|
(test-text "1234strikes" (textual-foldcase (as-text "1234STRIKES")))
|
|
|
|
(test-text "And With Three Strikes You Are Out"
|
|
(textual-titlecase
|
|
(as-text "and with THREE STRIKES you are oUT")))
|
|
|
|
;; Concatenation
|
|
|
|
(test-text "" (textual-append))
|
|
|
|
(test-text "abcdef"
|
|
(textual-append (as-text "")
|
|
(as-text "a")
|
|
(as-text "bcd")
|
|
"" "ef" "" ""))
|
|
|
|
(test-text "" (textual-concatenate '()))
|
|
|
|
(test-text "abcdef"
|
|
(textual-concatenate
|
|
(map string->text '("" "a" "bcd" "" "ef" "" ""))))
|
|
|
|
;; textual-concatenate is likely to have special cases for longer texts.
|
|
|
|
(let* ((alphabet "abcdefghijklmnopqrstuvwxyz")
|
|
(str1 alphabet)
|
|
(str10 (apply string-append (vector->list (make-vector 10 str1))))
|
|
(str100 (apply string-append (vector->list (make-vector 10 str10))))
|
|
(str100-500 (substring str100 100 500))
|
|
(str600-999 (substring str100 600 999))
|
|
(alph1 (textual-copy alphabet))
|
|
(alph10 (textual-concatenate (vector->list (make-vector 10 alph1))))
|
|
(alph100 (textual-concatenate (vector->list (make-vector 10 alph10))))
|
|
(t100-500 (subtext alph100 100 500))
|
|
(t600-999 (subtext alph100 600 999)))
|
|
|
|
(test-assert (result=? str10 alph10))
|
|
|
|
(test-assert (result=? str100 alph100))
|
|
|
|
(test-assert (result=? str100-500 t100-500))
|
|
|
|
(test-assert (result=? str600-999 t600-999))
|
|
|
|
;; concatenating a short text with a long text
|
|
|
|
(test-text (string-append str1 str600-999)
|
|
(textual-concatenate (list alph1 t600-999)))
|
|
|
|
(test-text (string-append str1 str600-999)
|
|
(textual-concatenate (list alph1 (textual-copy t600-999))))
|
|
|
|
(test-text (string-append str600-999 str1)
|
|
(textual-concatenate (list t600-999 alph1)))
|
|
|
|
(test-text (string-append str600-999 str1)
|
|
(textual-concatenate (list (textual-copy t600-999) alph1))))
|
|
|
|
|
|
(test-text "" (textual-concatenate-reverse '()))
|
|
|
|
(test-text "efbcda"
|
|
(textual-concatenate-reverse
|
|
(map string->text '("" "a" "bcd" "" "ef" "" ""))))
|
|
|
|
(test-text "huh?"
|
|
(textual-concatenate-reverse '() "huh?"))
|
|
|
|
(test-text "efbcdaxy"
|
|
(textual-concatenate-reverse '("" "a" "bcd" "" "ef" "" "") "xy"))
|
|
|
|
(test-text "huh"
|
|
(textual-concatenate-reverse '() "huh?" 3))
|
|
|
|
(test-text "efbcdax"
|
|
(textual-concatenate-reverse
|
|
'("" "a" "bcd" "" "ef" "" "") "x" 1))
|
|
|
|
|
|
(test-text "" (textual-join '()))
|
|
|
|
(test-text " ab cd e f "
|
|
(textual-join (map string->text '("" "ab" "cd" "" "e" "f" ""))))
|
|
|
|
(test-text ""
|
|
(textual-join '() ""))
|
|
|
|
(test-text "abcdef"
|
|
(textual-join '("" "ab" "cd" "" "e" "f" "") ""))
|
|
|
|
(test-text ""
|
|
(textual-join '() "xyz"))
|
|
|
|
(test-text "xyzabxyzcdxyzxyzexyzfxyz"
|
|
(textual-join '("" "ab" "cd" "" "e" "f" "") "xyz"))
|
|
|
|
(test-text ""
|
|
(textual-join '() "" 'infix))
|
|
|
|
(test-text "abcdef"
|
|
(textual-join '("" "ab" "cd" "" "e" "f" "") "" 'infix))
|
|
|
|
(test-text ""
|
|
(textual-join '() "xyz" 'infix))
|
|
|
|
(test-text "xyzabxyzcdxyzxyzexyzfxyz"
|
|
(textual-join '("" "ab" "cd" "" "e" "f" "") (as-text "xyz") 'infix))
|
|
|
|
(test-assert (equal? 'horror
|
|
(guard (exn (#t 'horror))
|
|
(textual-join '() "" 'strict-infix))))
|
|
|
|
(test-text "abcdef"
|
|
(textual-join '("" "ab" "cd" "" "e" "f" "") "" 'strict-infix))
|
|
|
|
(test-assert (equal? 'wham
|
|
(guard (exn (else 'wham))
|
|
(textual-join '() "xyz" 'strict-infix))))
|
|
|
|
(test-text "xyzabxyzcdxyzxyzexyzfxyz"
|
|
(textual-join '("" "ab" "cd" "" "e" "f" "") "xyz" 'strict-infix))
|
|
|
|
(test-text ""
|
|
(textual-join '() "" 'suffix))
|
|
|
|
(test-text "abcdef"
|
|
(textual-join '("" "ab" "cd" "" "e" "f" "") "" 'suffix))
|
|
|
|
(test-text ""
|
|
(textual-join '() "xyz" 'suffix))
|
|
|
|
(test-text "xyzabxyzcdxyzxyzexyzfxyzxyz"
|
|
(textual-join '("" "ab" "cd" "" "e" "f" "") "xyz" 'suffix))
|
|
|
|
(test-text ""
|
|
(textual-join '() "" 'prefix))
|
|
|
|
(test-text "abcdef"
|
|
(textual-join '("" "ab" "cd" "" "e" "f" "") "" 'prefix))
|
|
|
|
(test-text ""
|
|
(textual-join '() "xyz" 'prefix))
|
|
|
|
(test-text "xyzxyzabxyzcdxyzxyzexyzfxyz"
|
|
(textual-join '("" "ab" "cd" "" "e" "f" "") "xyz" 'prefix))
|
|
|
|
|
|
;; Fold & map & friends
|
|
|
|
(test-assert (= 8
|
|
(textual-fold (lambda (c count)
|
|
(if (char-whitespace? c)
|
|
(+ count 1)
|
|
count))
|
|
0
|
|
(as-text " ...a couple of spaces in this one... "))))
|
|
|
|
(test-assert (= 7
|
|
(textual-fold (lambda (c count)
|
|
(if (char-whitespace? c)
|
|
(+ count 1)
|
|
count))
|
|
0
|
|
" ...a couple of spaces in this one... "
|
|
1)))
|
|
|
|
(test-assert (= 6
|
|
(textual-fold (lambda (c count)
|
|
(if (char-whitespace? c)
|
|
(+ count 1)
|
|
count))
|
|
0
|
|
" ...a couple of spaces in this one... "
|
|
1
|
|
32)))
|
|
|
|
(test-assert (equal? (string->list "abcdef")
|
|
(textual-fold-right cons '() "abcdef")))
|
|
|
|
(test-assert (equal? (string->list "def")
|
|
(textual-fold-right cons '() (as-text "abcdef") 3)))
|
|
|
|
(test-assert (equal? (string->list "cde")
|
|
(textual-fold-right cons '() (as-text "abcdef") 2 5)))
|
|
|
|
(test-assert (string=? "aabraacaadaabraa"
|
|
(let* ((s (as-text "abracadabra"))
|
|
(ans-len (textual-fold (lambda (c sum)
|
|
(+ sum (if (char=? c #\a) 2 1)))
|
|
0 s))
|
|
(ans (make-string ans-len)))
|
|
(textual-fold (lambda (c i)
|
|
(let ((i (if (char=? c #\a)
|
|
(begin (string-set! ans i #\a)
|
|
(+ i 1))
|
|
i)))
|
|
(string-set! ans i c)
|
|
(+ i 1)))
|
|
0 s)
|
|
ans)))
|
|
|
|
|
|
(test-text "abc" (textual-map string (as-text "abc")))
|
|
|
|
(test-text "ABC" (textual-map char-upcase "abc"))
|
|
|
|
(test-text "Hear-here!"
|
|
(textual-map (lambda (c0 c1 c2)
|
|
(case c0
|
|
((#\1) c1)
|
|
((#\2) (string c2))
|
|
((#\-) (text #\- c1))))
|
|
(string->text "1222-1111-2222")
|
|
(string->text "Hi There!")
|
|
(string->text "Dear John")))
|
|
|
|
(test-assert (string=? "abc"
|
|
(let ((q (open-output-string)))
|
|
(textual-for-each (lambda (c) (write-char c q))
|
|
(as-text "abc"))
|
|
(get-output-string q))))
|
|
|
|
(test-assert (equal? '("cfi" "beh" "adg")
|
|
(let ((x '()))
|
|
(textual-for-each (lambda (c1 c2 c3)
|
|
(set! x (cons (string c1 c2 c3) x)))
|
|
"abc"
|
|
(as-text "defxyz")
|
|
(as-text "ghijklmnopqrstuvwxyz"))
|
|
x)))
|
|
|
|
(test-text "abc"
|
|
(textual-map-index (lambda (i)
|
|
(integer->char (+ i (char->integer #\a))))
|
|
"xyz"))
|
|
|
|
(test-text "def"
|
|
(textual-map-index (lambda (i)
|
|
(integer->char (+ i (char->integer #\a))))
|
|
"xyz***" 3))
|
|
|
|
(test-text "cde"
|
|
(textual-map-index (lambda (i)
|
|
(integer->char (+ i (char->integer #\a))))
|
|
"......" 2 5))
|
|
|
|
(test-assert (equal? '(101 100 99 98 97)
|
|
(let ((s (as-text "abcde"))
|
|
(v '()))
|
|
(textual-for-each-index
|
|
(lambda (i)
|
|
(set! v (cons (char->integer (textual-ref s i)) v)))
|
|
s)
|
|
v)))
|
|
|
|
(test-assert (equal? '(101 100 99)
|
|
(let ((s (as-text "abcde"))
|
|
(v '()))
|
|
(textual-for-each-index
|
|
(lambda (i)
|
|
(set! v (cons (char->integer (textual-ref s i)) v)))
|
|
s 2)
|
|
v)))
|
|
|
|
(test-assert (equal? '(99 98)
|
|
(let ((s (as-text "abcde"))
|
|
(v '()))
|
|
(textual-for-each-index
|
|
(lambda (i)
|
|
(set! v (cons (char->integer (textual-ref s i)) v)))
|
|
s 1 3)
|
|
v)))
|
|
|
|
(test-assert (= 6 (textual-count "abcdef" char?)))
|
|
|
|
(test-assert (= 4 (textual-count "counting whitespace, again " char-whitespace? 5)))
|
|
|
|
(test-assert (= 3 (textual-count "abcdefwxyz"
|
|
(lambda (c) (odd? (char->integer c)))
|
|
2 8)))
|
|
|
|
|
|
(test-text "aiueaaaoi"
|
|
(textual-filter (lambda (c) (memv c (textual->list "aeiou")))
|
|
(as-text "What is number, that man may know it?")))
|
|
|
|
(test-text "And wmn, tht sh my knw nmbr?"
|
|
(textual-remove (lambda (c) (memv c (textual->list "aeiou")))
|
|
"And woman, that she may know number?"))
|
|
|
|
(test-text "iueaaaoi"
|
|
(textual-filter (lambda (c) (memv c (textual->list "aeiou")))
|
|
(as-text "What is number, that man may know it?")
|
|
4))
|
|
|
|
(test-text "mn, tht sh my knw nmbr?"
|
|
(textual-remove (lambda (c) (memv c (textual->list "aeiou")))
|
|
"And woman, that she may know number?"
|
|
6))
|
|
|
|
(test-text "aaao"
|
|
(textual-filter (lambda (c) (memv c (textual->list "aeiou")))
|
|
(as-text "What is number, that man may know it?")
|
|
16 32))
|
|
|
|
(test-text "And woman, that sh may know"
|
|
(textual-remove (lambda (c) (memv c (textual->list "eiu")))
|
|
"And woman, that she may know number?"
|
|
0 28))
|
|
|
|
;; Replication and splitting ; ; ;
|
|
|
|
(test-text "cdefabcdefabcd"
|
|
(textual-replicate "abcdef" -4 10))
|
|
|
|
(test-text "bcdefbcdefbcd"
|
|
(textual-replicate "abcdef" 90 103 1))
|
|
|
|
(test-text "ecdecdecde"
|
|
(textual-replicate "abcdef" -13 -3 2 5))
|
|
|
|
(test-assert (equal? '() (map textual->string (textual-split "" ""))))
|
|
|
|
(test-assert (equal? '("a" "b" "c") (map textual->string (textual-split "abc" ""))))
|
|
|
|
(test-assert (equal? '("too" "" "much" "" "data")
|
|
(map textual->string
|
|
(textual-split "too much data" " "))))
|
|
|
|
(test-assert (equal? '("" "there" "ya" "go" "")
|
|
(map textual->string
|
|
(textual-split "***there***ya***go***" "***"))))
|
|
|
|
(test-assert (equal? '() (map textual->string (textual-split "" "" 'infix))))
|
|
|
|
(test-assert (equal? '("a" "b" "c")
|
|
(map textual->string (textual-split "abc" "" 'infix))))
|
|
|
|
(test-assert (equal? '("too" "" "much" "" "data")
|
|
(map textual->string
|
|
(textual-split "too much data" " " 'infix))))
|
|
|
|
(test-assert (equal? '("" "there" "ya" "go" "")
|
|
(map textual->string
|
|
(textual-split "***there***ya***go***" "***" 'infix))))
|
|
|
|
(test-assert (equal? 'error
|
|
(guard (exn (else 'error))
|
|
(map textual->string
|
|
(textual-split "" "" 'strict-infix)))))
|
|
|
|
(test-assert (equal? '("a" "b" "c")
|
|
(map textual->string
|
|
(textual-split "abc" "" 'strict-infix))))
|
|
|
|
(test-assert (equal? '("too" "" "much" "" "data")
|
|
(map textual->string
|
|
(textual-split "too much data" " " 'strict-infix))))
|
|
|
|
(test-assert (equal? '("" "there" "ya" "go" "")
|
|
(map textual->string
|
|
(textual-split "***there***ya***go***" "***" 'strict-infix))))
|
|
|
|
(test-assert (equal? '()
|
|
(map textual->string
|
|
(textual-split "" "" 'prefix))))
|
|
|
|
(test-assert (equal? '("a" "b" "c")
|
|
(map textual->string
|
|
(textual-split "abc" "" 'prefix))))
|
|
|
|
(test-assert (equal? '("too" "" "much" "" "data")
|
|
(map textual->string
|
|
(textual-split "too much data" " " 'prefix))))
|
|
|
|
(test-assert (equal? '("there" "ya" "go" "")
|
|
(map textual->string
|
|
(textual-split "***there***ya***go***" "***" 'prefix))))
|
|
|
|
(test-assert (equal? '()
|
|
(map textual->string
|
|
(textual-split "" "" 'suffix))))
|
|
|
|
(test-assert (equal? '("a" "b" "c")
|
|
(map textual->string
|
|
(textual-split "abc" "" 'suffix))))
|
|
|
|
(test-assert (equal? '("too" "" "much" "" "data")
|
|
(map textual->string
|
|
(textual-split "too much data" " " 'suffix))))
|
|
|
|
(test-assert (equal? '("" "there" "ya" "go")
|
|
(map textual->string
|
|
(textual-split "***there***ya***go***" "***" 'suffix))))
|
|
|
|
|
|
(test-assert (equal? '()
|
|
(map textual->string
|
|
(textual-split "" "" 'infix #f))))
|
|
|
|
(test-assert (equal? '("a" "b" "c")
|
|
(map textual->string
|
|
(textual-split "abc" "" 'infix #f))))
|
|
|
|
(test-assert (equal? '("too" "" "much" "" "data")
|
|
(map textual->string
|
|
(textual-split "too much data" " " 'infix #f))))
|
|
|
|
(test-assert (equal? '("" "there" "ya" "go" "")
|
|
(map textual->string
|
|
(textual-split "***there***ya***go***" "***" 'infix #f))))
|
|
|
|
(test-assert (equal? 'error
|
|
(guard (exn (else 'error))
|
|
(map textual->string
|
|
(textual-split "" "" 'strict-infix #f)))))
|
|
|
|
(test-assert (equal? '("a" "b" "c")
|
|
(map textual->string
|
|
(textual-split "abc" "" 'strict-infix #f))))
|
|
|
|
(test-assert (equal? '("too" "" "much" "" "data")
|
|
(map textual->string
|
|
(textual-split "too much data" " " 'strict-infix #f))))
|
|
|
|
(test-assert (equal? '("" "there" "ya" "go" "")
|
|
(map textual->string
|
|
(textual-split "***there***ya***go***" "***" 'strict-infix #f))))
|
|
|
|
(test-assert (equal? '()
|
|
(map textual->string
|
|
(textual-split "" "" 'prefix #f))))
|
|
|
|
(test-assert (equal? '("a" "b" "c")
|
|
(map textual->string
|
|
(textual-split "abc" "" 'prefix #f))))
|
|
|
|
(test-assert (equal? '("too" "" "much" "" "data")
|
|
(map textual->string
|
|
(textual-split "too much data" " " 'prefix #f))))
|
|
|
|
(test-assert (equal? '("there" "ya" "go" "")
|
|
(map textual->string
|
|
(textual-split "***there***ya***go***" "***" 'prefix #f))))
|
|
|
|
(test-assert (equal? '()
|
|
(map textual->string
|
|
(textual-split "" "" 'suffix #f))))
|
|
|
|
(test-assert (equal? '("a" "b" "c")
|
|
(map textual->string
|
|
(textual-split "abc" "" 'suffix #f))))
|
|
|
|
(test-assert (equal? '("too" "" "much" "" "data")
|
|
(map textual->string
|
|
(textual-split "too much data" " " 'suffix #f))))
|
|
|
|
(test-assert (equal? '("" "there" "ya" "go")
|
|
(map textual->string
|
|
(textual-split "***there***ya***go***" "***" 'suffix #f))))
|
|
|
|
|
|
(test-assert (equal? 'error
|
|
(guard (exn (else 'error))
|
|
(map textual->string
|
|
(textual-split "" "" 'strict-infix 3)))))
|
|
|
|
(test-assert (equal? '("a" "b" "c")
|
|
(map textual->string
|
|
(textual-split "abc" "" 'strict-infix 3))))
|
|
|
|
(test-assert (equal? '("too" "" "much" " data")
|
|
(map textual->string
|
|
(textual-split "too much data" " " 'strict-infix 3))))
|
|
|
|
(test-assert (equal? '("" "there" "ya" "go***")
|
|
(map textual->string
|
|
(textual-split "***there***ya***go***" "***" 'strict-infix 3))))
|
|
|
|
(test-assert (equal? '()
|
|
(map textual->string
|
|
(textual-split "" "" 'prefix 3))))
|
|
|
|
(test-assert (equal? '("a" "b" "c")
|
|
(map textual->string
|
|
(textual-split "abc" "" 'prefix 3))))
|
|
|
|
(test-assert (equal? '("too" "" "much" " data")
|
|
(map textual->string
|
|
(textual-split "too much data" " " 'prefix 3))))
|
|
|
|
(test-assert (equal? '("there" "ya" "go***")
|
|
(map textual->string
|
|
(textual-split "***there***ya***go***" "***" 'prefix 3))))
|
|
|
|
(test-assert (equal? '()
|
|
(map textual->string
|
|
(textual-split "" "" 'suffix 3))))
|
|
|
|
(test-assert (equal? '("a" "b" "c")
|
|
(map textual->string
|
|
(textual-split "abc" "" 'suffix 3))))
|
|
|
|
(test-assert (equal? '("too" "" "much" " data")
|
|
(map textual->string
|
|
(textual-split "too much data" " " 'suffix 3))))
|
|
|
|
(test-assert (equal? '("" "there" "ya" "go***")
|
|
(map textual->string
|
|
(textual-split "***there***ya***go***" "***" 'suffix 3))))
|
|
|
|
|
|
(test-assert (equal? 'error
|
|
(guard (exn (else 'error))
|
|
(map textual->string
|
|
(textual-split "" "" 'strict-infix 3 0)))))
|
|
|
|
(test-assert (equal? '("b" "c")
|
|
(map textual->string
|
|
(textual-split "abc" "" 'strict-infix 3 1))))
|
|
|
|
(test-assert (equal? '("oo" "" "much" " data")
|
|
(map textual->string
|
|
(textual-split "too much data" " " 'strict-infix 3 1))))
|
|
|
|
(test-assert (equal? '("**there" "ya" "go" "")
|
|
(map textual->string
|
|
(textual-split "***there***ya***go***" "***" 'strict-infix 3 1))))
|
|
|
|
(test-assert (equal? '()
|
|
(map textual->string
|
|
(textual-split "" "" 'prefix 3 0))))
|
|
|
|
(test-assert (equal? '("b" "c")
|
|
(map textual->string
|
|
(textual-split "abc" "" 'prefix 3 1))))
|
|
|
|
(test-assert (equal? '("oo" "" "much" " data")
|
|
(map textual->string
|
|
(textual-split "too much data" " " 'prefix 3 1))))
|
|
|
|
(test-assert (equal? '("**there" "ya" "go" "")
|
|
(map textual->string
|
|
(textual-split "***there***ya***go***" "***" 'prefix 3 1))))
|
|
|
|
(test-assert (equal? '()
|
|
(map textual->string
|
|
(textual-split "" "" 'suffix 3 0))))
|
|
|
|
(test-assert (equal? '("b" "c")
|
|
(map textual->string
|
|
(textual-split "abc" "" 'suffix 3 1))))
|
|
|
|
(test-assert (equal? '("oo" "" "much" " data")
|
|
(map textual->string
|
|
(textual-split "too much data" " " 'suffix 3 1))))
|
|
|
|
(test-assert (equal? '("**there" "ya" "go")
|
|
(map textual->string
|
|
(textual-split "***there***ya***go***" "***" 'suffix 3 1))))
|
|
|
|
|
|
(test-assert (equal? 'error
|
|
(guard (exn (else 'error))
|
|
(map textual->string
|
|
(textual-split "" "" 'strict-infix 3 0 0)))))
|
|
|
|
(test-assert (equal? '("b")
|
|
(map textual->string
|
|
(textual-split "abc" "" 'strict-infix 3 1 2))))
|
|
|
|
(test-assert (equal? '("oo" "" "much" " ")
|
|
(map textual->string
|
|
(textual-split "too much data" " " 'strict-infix 3 1 11))))
|
|
|
|
(test-assert (equal? '()
|
|
(map textual->string
|
|
(textual-split "" "" 'prefix 3 0 0))))
|
|
|
|
(test-assert (equal? '("b")
|
|
(map textual->string
|
|
(textual-split "abc" "" 'prefix 3 1 2))))
|
|
|
|
(test-assert (equal? '("oo" "" "much" " ")
|
|
(map textual->string
|
|
(textual-split "too much data" " " 'prefix 3 1 11))))
|
|
|
|
(test-assert (equal? '()
|
|
(map textual->string
|
|
(textual-split "" "" 'suffix 3 0 0))))
|
|
|
|
(test-assert (equal? '("b")
|
|
(map textual->string
|
|
(textual-split "abc" "" 'suffix 3 1 2))))
|
|
|
|
(test-assert (equal? '("oo" "" "much" " ")
|
|
(map textual->string
|
|
(textual-split "too much data" " " 'suffix 3 1 11))))
|
|
|
|
(test-end))))
|
|
|
|
;; Local variables:
|
|
;; eval: (put 'test-text 'scheme-indent-function 1)
|
|
;; End:
|