288 lines
12 KiB
Scheme
288 lines
12 KiB
Scheme
|
|
(load-relative "loadtest.ss")
|
|
|
|
(Section 'string)
|
|
|
|
(require scheme/string)
|
|
|
|
;; ---------- real->decimal-string ----------
|
|
(test "0." real->decimal-string 0 0)
|
|
(test "0." real->decimal-string 0.0 0)
|
|
(test "1." real->decimal-string 0.6 0)
|
|
(test "1." real->decimal-string 3/4 0)
|
|
(test "1." real->decimal-string 1.2 0)
|
|
(test "-0." real->decimal-string -0.0 0) ; note this!
|
|
(test "-0.00" real->decimal-string -0.0) ; same here...
|
|
(test "-1." real->decimal-string -0.6 0)
|
|
(test "-1." real->decimal-string -3/4 0)
|
|
(test "-1." real->decimal-string -1.2 0)
|
|
(test "1.20" real->decimal-string 1.2)
|
|
(test "-1.20" real->decimal-string -1.2)
|
|
(test "1.00" real->decimal-string 0.99999999999)
|
|
(test "-1.00" real->decimal-string -0.99999999999)
|
|
(test "1999999999999999859514578049071102439861518336.00"
|
|
real->decimal-string 2e45)
|
|
|
|
;; ---------- regexp-quote ----------
|
|
(let ([s (list->string
|
|
(let loop ([i 0])
|
|
(if (= i 256)
|
|
null
|
|
(cons (integer->char i) (loop (add1 i))))))])
|
|
(test (list s) regexp-match (regexp-quote s) s)
|
|
(test (string-append "!" s "!")
|
|
regexp-replace
|
|
(regexp-quote s) s (regexp-replace-quote (string-append "!" s "!"))))
|
|
|
|
;; ---------- regexp-<?>* functions ----------
|
|
(let ()
|
|
(define (->b x)
|
|
(cond [(list? x) (map ->b x)]
|
|
[(string? x) (string->bytes/utf-8 x)]
|
|
[(pregexp? x) (byte-pregexp (->b (object-name x)))]
|
|
[else x]))
|
|
(define fun* #f)
|
|
(define t
|
|
(case-lambda
|
|
[(fun) (set! fun* fun)]
|
|
[(res left rx str . args)
|
|
(unless (eq? fun* regexp-match-peek-positions*)
|
|
;; test with a string
|
|
(apply test res fun* rx str args)
|
|
;; test with a byte-regexp and/or a byte string
|
|
(apply test (->b res) fun* (->b rx) str args)
|
|
(apply test (->b res) fun* rx (->b str) args)
|
|
(apply test (->b res) fun* (->b rx) (->b str) args))
|
|
;; test with a port, and test leftovers
|
|
(when left
|
|
(let ([p (open-input-string str)])
|
|
(apply test (->b res) fun* rx p args)
|
|
(test left read-string 50 p)))]))
|
|
;; --------------------
|
|
(t regexp-match*)
|
|
(t '("a" "b" "c") eof "[abc]" " a b c ")
|
|
(t '("b" "c") eof "[abc]" " a b c " 2)
|
|
(t '("b" "c") eof "[abc]" " a b c " 3)
|
|
(t '("a") " b c " "[abc]" " a b c " 0 2)
|
|
(t '("a") "b c " "[abc]" " a b c " 0 3)
|
|
(t '("a" "b" "c") eof "[abc]" " a b c " 0 #f)
|
|
(t '("a" "b" "c") eof "[abc]" " a b c " 0 7)
|
|
(t '("a" "b" "c") eof "[abc]" "a b c")
|
|
(t '("b" "c") eof "[abc]" "a b c" 1)
|
|
(t '("b" "c") eof "[abc]" "a b c" 2)
|
|
(t '("a") " b c" "[abc]" "a b c" 0 1)
|
|
(t '("a") "b c" "[abc]" "a b c" 0 2)
|
|
(t '("a" "b" "c") eof "[abc]" "a b c" 0)
|
|
(t '("a" "b" "c") eof "[abc]" "a b c" 0 #f)
|
|
(t '("a" "b" "c") eof "[abc]" "a b c" 0 5)
|
|
(for-each (lambda (cvt)
|
|
(test '(#"\x80" #"\x80") regexp-match* (cvt #"\x80") #"a\x80z\x80q"))
|
|
(list values byte-regexp byte-pregexp))
|
|
;; --------------------
|
|
(t regexp-match-positions*)
|
|
(t '((1 . 2) (3 . 4) (5 . 6)) eof "[abc]" " a b c ")
|
|
(t '((3 . 4) (5 . 6)) eof "[abc]" " a b c " 2)
|
|
(t '((3 . 4) (5 . 6)) eof "[abc]" " a b c " 3)
|
|
(t '((1 . 2)) " b c " "[abc]" " a b c " 0 2)
|
|
(t '((1 . 2)) "b c " "[abc]" " a b c " 0 3)
|
|
(t '((1 . 2) (3 . 4) (5 . 6)) eof "[abc]" " a b c " 0 #f)
|
|
(t '((1 . 2) (3 . 4) (5 . 6)) eof "[abc]" " a b c " 0 7)
|
|
(t '((0 . 1) (2 . 3) (4 . 5)) eof "[abc]" "a b c")
|
|
(t '((2 . 3) (4 . 5)) eof "[abc]" "a b c" 1)
|
|
(t '((2 . 3) (4 . 5)) eof "[abc]" "a b c" 2)
|
|
(t '((0 . 1)) " b c" "[abc]" "a b c" 0 1)
|
|
(t '((0 . 1)) "b c" "[abc]" "a b c" 0 2)
|
|
(t '((0 . 1) (2 . 3) (4 . 5)) eof "[abc]" "a b c" 0)
|
|
(t '((0 . 1) (2 . 3) (4 . 5)) eof "[abc]" "a b c" 0 #f)
|
|
(t '((0 . 1) (2 . 3) (4 . 5)) eof "[abc]" "a b c" 0 5)
|
|
(for-each (lambda (cvt)
|
|
(test '((1 . 2) (3 . 4)) regexp-match-positions* (cvt #"\x80") #"a\x80z\x80q"))
|
|
(list values byte-regexp byte-pregexp))
|
|
;; --------------------
|
|
(t regexp-split)
|
|
(t '("1" "2" "3" "4") eof "[abc]" "1a2b3c4")
|
|
(t '("2" "3" "4") eof "[abc]" "1a2b3c4" 2)
|
|
(t '("" "3" "4") eof "[abc]" "1a2b3c4" 3)
|
|
(t '("1" "") "2b3c4" "[abc]" "1a2b3c4" 0 2)
|
|
(t '("1" "2") "b3c4" "[abc]" "1a2b3c4" 0 3)
|
|
(t '("1" "2" "3" "4") eof "[abc]" "1a2b3c4" 0 #f)
|
|
(t '("1" "2" "3" "4") eof "[abc]" "1a2b3c4" 0 7)
|
|
(t '("" "1" "2" "") eof "[abc]" "a1b2c")
|
|
(t '("1" "2" "") eof "[abc]" "a1b2c" 1)
|
|
(t '("" "2" "") eof "[abc]" "a1b2c" 2)
|
|
(t '("" "") "1b2c" "[abc]" "a1b2c" 0 1)
|
|
(t '("" "1") "b2c" "[abc]" "a1b2c" 0 2)
|
|
(t '("" "1" "2" "") eof "[abc]" "a1b2c" 0)
|
|
(t '("" "1" "2" "") eof "[abc]" "a1b2c" 0 #f)
|
|
(t '("" "1" "2" "") eof "[abc]" "a1b2c" 0 5)
|
|
(for-each (lambda (cvt)
|
|
(test '(#"" #"a" #"z" #"q" #"") regexp-split (cvt #"\x80") #"\x80a\x80z\x80q\x80"))
|
|
(list values byte-regexp byte-pregexp))
|
|
;; --------------------
|
|
(t regexp-match-peek-positions*)
|
|
(err/rt-test (regexp-match-peek-positions* "[abc]" "a b c"))
|
|
(t '((1 . 2) (3 . 4) (5 . 6)) " a b c " "[abc]" " a b c ")
|
|
(t '((3 . 4) (5 . 6)) " a b c " "[abc]" " a b c " 2)
|
|
(t '((3 . 4) (5 . 6)) " a b c " "[abc]" " a b c " 3)
|
|
(t '((1 . 2)) " a b c " "[abc]" " a b c " 0 2)
|
|
(t '((1 . 2)) " a b c " "[abc]" " a b c " 0 3)
|
|
(t '((1 . 2) (3 . 4) (5 . 6)) " a b c " "[abc]" " a b c " 0 #f)
|
|
(t '((1 . 2) (3 . 4) (5 . 6)) " a b c " "[abc]" " a b c " 0 7)
|
|
(t '((0 . 1) (2 . 3) (4 . 5)) "a b c" "[abc]" "a b c")
|
|
(t '((2 . 3) (4 . 5)) "a b c" "[abc]" "a b c" 1)
|
|
(t '((2 . 3) (4 . 5)) "a b c" "[abc]" "a b c" 2)
|
|
(t '((0 . 1)) "a b c" "[abc]" "a b c" 0 1)
|
|
(t '((0 . 1)) "a b c" "[abc]" "a b c" 0 2)
|
|
(t '((0 . 1) (2 . 3) (4 . 5)) "a b c" "[abc]" "a b c" 0 #f)
|
|
(t '((0 . 1) (2 . 3) (4 . 5)) "a b c" "[abc]" "a b c" 0 5)
|
|
;; ---------- tests with zero-length matches ----------
|
|
;; Many of these tests can be repeated with Perl. To try something in Perl,
|
|
;; put this code in a file:
|
|
;; #!/usr/bin/perl
|
|
;; sub test {
|
|
;; my ($rx,$str) = @_; @words = split /$rx/, $str;
|
|
;; print "(t '(";
|
|
;; while (@words) {print '"'.shift(@words).'"'.(@words?" ":"");}
|
|
;; print ") eof \"$rx\" \"$str\")\n";
|
|
;; };
|
|
;; test("[abc]","1a2b3");
|
|
;; and it will print a test that does what perl is doing. Tests that differ
|
|
;; from Perl have explanations.
|
|
;;
|
|
(t regexp-split)
|
|
;; test("a","a");
|
|
;; (t '() eof "a" "a")
|
|
;; perl returns an empty list, we return '("" ""), and this is a difference
|
|
;; that is unrelated to dealing with empty matches, just the way that
|
|
;; perl's split throws out some empty matches (it throws empty matches at
|
|
;; the end (but not at the beginning for some reason...))
|
|
(t '("" "") eof "a" "a")
|
|
;; test("3","123");
|
|
;; (t '("12") eof "3" "123")
|
|
;; a more straightforward demonstration of this
|
|
(t '("12" "") eof "3" "123")
|
|
;; test("a","1a2a3");
|
|
(t '("1" "2" "3") eof "a" "1a2a3")
|
|
;; test("","123");
|
|
(t '("1" "2" "3") eof "" "123")
|
|
;; test("","12 34");
|
|
(t '("1" "2" " " "3" "4") eof "" "12 34")
|
|
;; test(" *","123");
|
|
(t '("1" "2" "3") eof " *" "123")
|
|
;; test(" *","12 34");
|
|
(t '("1" "2" "3" "4") eof " *" "12 34")
|
|
;; test(" *"," 12 34 ");
|
|
;; (t '("" "1" "2" "3" "4") eof " *" " 12 34 ")
|
|
;; again, perl drops the last empty string but we don't
|
|
(t '("" "1" "2" "3" "4" "") eof " *" " 12 34 ")
|
|
;; test("2|", "1234");
|
|
(t '("1" "3" "4") eof "2|" "1234")
|
|
;; test("1|", "1234");
|
|
(t '("" "2" "3" "4") eof "1|" "1234")
|
|
;; test("4|", "1234");
|
|
;; (t '("1" "2" "3") eof "4|" "1234")
|
|
;; perl perl drops the last empty string again
|
|
(t '("1" "2" "3" "") eof "4|" "1234")
|
|
;; test("|2", "1234");
|
|
(t '("1" "" "3" "4") eof "|2" "1234")
|
|
;; test("2|3", "1234");
|
|
(t '("1" "" "4") eof "2|3" "1234")
|
|
;; test("2|3|4", "12345");
|
|
(t '("1" "" "" "5") eof "2|3|4" "12345")
|
|
;; test("1|2", "1234");
|
|
(t '("" "" "34") eof "1|2" "1234")
|
|
;; test("3|4", "1234");
|
|
;; (t '("12") eof "3|4" "1234")
|
|
;; perl perl drops the last empty string again -- even two here
|
|
(t '("12" "" "") eof "3|4" "1234")
|
|
;; test("2|3|4", "1234");
|
|
;; (t '("1") eof "2|3|4" "1234")
|
|
;; ...and even three in this example
|
|
(t '("1" "" "" "") eof "2|3|4" "1234")
|
|
;; test('$',"123");
|
|
(t '("123") eof "$" "123")
|
|
;; test('^',"123");
|
|
;; (t '("123") eof "^" "123")
|
|
;; this is a technicality: perl matches "^" once, but mzscheme matches on
|
|
;; whatever `start' may be; perl is treating it as a beginning-of-line
|
|
;; instead of a beginning-of-string behind your back "since it isn't much
|
|
;; use otherwise" (http://perldoc.perl.org/functions/split.html); but we
|
|
;; don't allow empty matches at the beginning, so a `^' will never match,
|
|
;; and we get the same behavior anyway:
|
|
(t '("123") eof "^" "123")
|
|
;; test('^',"123\n456");
|
|
;; (t '("123\n" "456") eof "^" "123\n456")
|
|
;; we can get the same behavior as perl's with "(m?:^)":
|
|
(t '("123\n" "456") eof "(?m:^)" "123\n456")
|
|
;; test("\\b", "123 456");
|
|
(t '("123" " " "456") eof #px"\\b" "123 456")
|
|
;; test("^|a", "abc");
|
|
(t '("" "bc") eof "^|a" "abc")
|
|
;; some tests with bounds (these have no perl equivalences)
|
|
(t '("1" "2" " " "3" "4") eof "" "12 34" 0)
|
|
(t '("1" "2" " " "3" "4") eof "" "12 34" 0 #f)
|
|
(t '("1" "2" " " "3" "4") eof "" "12 34" 0 5)
|
|
(t '("" "1" "2" "3" "4" "") eof " *" " 12 34 " 0)
|
|
(t '("" "1" "2" "3" "4" "") eof " *" " 12 34 " 0 #f)
|
|
(t '("" "1" "2" "3" "4" "") eof " *" " 12 34 " 0 7)
|
|
(t '("2" "3") eof " *" "123" 1)
|
|
(t '("2" "3" "4") eof " *" "12 34" 1)
|
|
(t '("2" "3" "4" "") eof " *" " 12 34 " 2)
|
|
(t '("1") "23" "" "123" 0 1)
|
|
(t '("2") "3" "" "123" 1 2)
|
|
(t '("3") eof "" "123" 2 3)
|
|
(t '("1" "2") "3" " *" "123" 0 2)
|
|
(t '("2" "3") eof " *" "123" 1 3)
|
|
;; more tests with match*
|
|
(t regexp-match*)
|
|
(t '("" "") eof "" "123")
|
|
(t '("" " " "") eof " *" "12 34")
|
|
(t '(" " "" " " "" " ") eof " *" " 12 34 ")
|
|
(t '("" " " "") " " " *" " 12 34 " 1 6)
|
|
(t regexp-match-positions*)
|
|
(t '((1 . 1) (2 . 2)) eof "" "123")
|
|
(t '((1 . 1) (2 . 3) (4 . 4)) eof " *" "12 34")
|
|
(t '((0 . 1) (2 . 2) (3 . 4) (5 . 5) (6 . 7)) eof " *" " 12 34 ")
|
|
(t '((2 . 2) (3 . 4) (5 . 5)) " " " *" " 12 34 " 1 6)
|
|
(t regexp-match-peek-positions*)
|
|
(t '((1 . 1) (2 . 2)) "123" "" "123")
|
|
(t '((1 . 1) (2 . 3) (4 . 4)) "12 34" " *" "12 34")
|
|
(t '((0 . 1) (2 . 2) (3 . 4) (5 . 5) (6 . 7)) " 12 34 " " *" " 12 34 ")
|
|
(t '((2 . 2) (3 . 4) (5 . 5)) " 12 34 " " *" " 12 34 " 1 6)
|
|
;; finally, some tests for the match* + split property
|
|
(t (lambda (rx str)
|
|
(let ([s (regexp-split rx str)]
|
|
[m (regexp-match* rx str)])
|
|
(and (pair? s) (= (length s) (add1 (length m)))
|
|
(apply (if (string? (car s)) string-append bytes-append)
|
|
(car s)
|
|
(append-map list m (cdr s)))))))
|
|
(t "12 34" #f " " "12 34")
|
|
(t " 12 34 " #f " " " 12 34 ")
|
|
(t "12 34" #f " *" "12 34")
|
|
(t " 12 34 " #f " *" " 12 34 ")
|
|
(t "12 34" #f "" "12 34")
|
|
(t " 12 34 " #f "" " 12 34 ")
|
|
)
|
|
|
|
;; ---------- string-append* ----------
|
|
(let ()
|
|
(test "" string-append* '())
|
|
(test "" string-append* '(""))
|
|
(test "" string-append* '("" ""))
|
|
(test "0123456789" string-append* '("0123456789"))
|
|
(test "0123456789" string-append* "0123456789" '())
|
|
(test "0123456789" string-append* "0123456789" '(""))
|
|
(test "0123456789" string-append* "0123456789" '("" ""))
|
|
(test "0123456789" string-append* "01234567" '("8" "9")))
|
|
|
|
;; ---------- string-join ----------
|
|
(let ()
|
|
(test "" string-join '() " ")
|
|
(test "" string-join '("") " ")
|
|
(test " " string-join '("" "") " ")
|
|
(test "x y" string-join '("x" "y") " ")
|
|
(test "x" string-join '("x") " "))
|
|
|
|
(report-errs)
|