* Move the scheme/contract tests to scheme.ss
* Split string.ss into string-mzlib.ss which is left in mzlib.ss * Call the string.ss from scheme (which now has only stuff from scheme/base) svn: r9196
This commit is contained in:
Eli Barzilay
parent
b37d63a5e5
commit
2888a16d0e
|
|
@ -9,7 +9,7 @@
|
|||
(load-in-sandbox "structlib.ss")
|
||||
(load-in-sandbox "async-channel.ss")
|
||||
(load-in-sandbox "restart.ss")
|
||||
(load-in-sandbox "string.ss")
|
||||
(load-in-sandbox "string-mzlib.ss")
|
||||
(load-in-sandbox "filelib.ss")
|
||||
(load-in-sandbox "portlib.ss")
|
||||
(load-in-sandbox "threadlib.ss")
|
||||
|
|
@ -21,8 +21,7 @@
|
|||
(load-in-sandbox "control.ss")
|
||||
(load-in-sandbox "serialize.ss")
|
||||
;; (load-in-sandbox "package.ss")
|
||||
(load-in-sandbox "contract-test.ss") ;; tests scheme/contract
|
||||
(load-in-sandbox "contract-mzlib-test.ss") ;; tests mzlib/contract
|
||||
(load-in-sandbox "contract-mzlib-test.ss")
|
||||
(load-in-sandbox "sandbox.ss")
|
||||
(load-in-sandbox "shared.ss")
|
||||
(load-in-sandbox "kw.ss")
|
||||
|
|
|
|||
|
|
@ -3,5 +3,7 @@
|
|||
|
||||
(load-relative "for.ss")
|
||||
(load-relative "list.ss")
|
||||
(load-relative "string.ss")
|
||||
(load-relative "function.ss")
|
||||
(load-relative "promise.ss")
|
||||
(load-in-sandbox "contract-test.ss")
|
||||
|
|
|
|||
94
collects/tests/mzscheme/string-mzlib.ss
Normal file
94
collects/tests/mzscheme/string-mzlib.ss
Normal file
|
|
@ -0,0 +1,94 @@
|
|||
|
||||
(load-relative "loadtest.ss")
|
||||
|
||||
(Section 'mzlib-string)
|
||||
|
||||
(require mzlib/string)
|
||||
|
||||
(let ([s1 (string-copy "Hello!")])
|
||||
(string-lowercase! s1)
|
||||
(test "hello!" 'lowercase s1)
|
||||
(string-uppercase! s1)
|
||||
(test "HELLO!" 'uppercase s1))
|
||||
|
||||
(test 1 read-from-string "1")
|
||||
(test #f read-from-string "#f (2 3) (")
|
||||
(test #f read-from-string #"#f (2 3) (")
|
||||
(test 1 read-from-string "(" (lambda () 1))
|
||||
(test 1 read-from-string "(" (lambda (_) 1))
|
||||
(test '(1) read-from-string-all "1")
|
||||
(test '(#f (2 3)) read-from-string-all "#f (2 3)")
|
||||
(test '(#f (2 3)) read-from-string-all #"#f (2 3)")
|
||||
(test 1 read-from-string-all "(" (lambda () 1))
|
||||
(test 1 read-from-string-all "(" (lambda (_) 1))
|
||||
|
||||
(test '1 eval-string "1")
|
||||
(test-values '(1 2 3) (lambda () (eval-string "1 2 3")))
|
||||
(test-values '(1 2 3) (lambda () (eval-string #"1 2 3")))
|
||||
(test-values '(1 2 3) (lambda () (eval-string "(values 1 2 3)")))
|
||||
(test-values '() (lambda () (eval-string "(values)")))
|
||||
(test-values '(1 2 3) (lambda () (eval-string "1 (values 2 3)")))
|
||||
(test-values '(1 2 3) (lambda () (eval-string "(values 1 2) 3")))
|
||||
(test-values '(1 2 3 4 5)
|
||||
(lambda ()
|
||||
(eval-string "(values 1 2) 3 (values) (values 4 5)")))
|
||||
|
||||
(let ([s (open-input-string "hello there")])
|
||||
(test #f regexp-match/fail-without-reading #rx"not there" s)
|
||||
(test #f regexp-match/fail-without-reading #rx"t$" s)
|
||||
(test #f regexp-match/fail-without-reading #rx"hello there!!!" s)
|
||||
(test "hello there" read-string 50 s))
|
||||
|
||||
(let ([g->re-test
|
||||
(lambda (glob . more)
|
||||
(let ([re (apply glob->regexp glob more)])
|
||||
(lambda xs
|
||||
(let loop ([xs xs] [res 'unspecified])
|
||||
(when (pair? xs)
|
||||
(loop (cdr xs)
|
||||
(if (boolean? (car xs))
|
||||
(car xs)
|
||||
(begin (test res regexp-match? re (car xs))
|
||||
res))))))))])
|
||||
((g->re-test #"foo*bar" #t #t)
|
||||
#t #"foobar" #"foo-bar" #"foo--bar"
|
||||
#f #"fobar" #"foo-barr" #"ffoo-bar" #".foobar")
|
||||
((g->re-test "foo*bar" #t #t)
|
||||
#t "foobar" "foo-bar" "foo--bar"
|
||||
#f "fobar" "foo-barr" "ffoo-bar" ".foobar")
|
||||
((g->re-test "*foo-bar" #t #t)
|
||||
#f "foobar" "foo-barr"
|
||||
#t "foo-bar" "-foo-bar" "foo-foo-bar" "foo-bar-foo-bar" "f.foo-bar"
|
||||
#f ".foo-bar" ".foo-foo-bar")
|
||||
((g->re-test "[ab]*foo-bar" #t #t)
|
||||
#f "foobar" "foo-barr" "foo-bar"
|
||||
#t "afoo-bar" "b-foo-bar" "a-foo-foo-bar" "b.foo-bar"
|
||||
#f ".afoo-bar" ".b-foo-bar")
|
||||
((g->re-test "[.]foo-bar" #t #t)
|
||||
#f "foobar" "foo-barr" "foo-bar" "-foo-bar" ".foo-bar")
|
||||
((g->re-test "foo*bar" #t #f)
|
||||
#t "fOobAr" "Foo-Bar" "foO--baR"
|
||||
#f "FoBar" "fOO-baRR" "FFoo-bar" ".foobar")
|
||||
((g->re-test "foo*bar" #f #t)
|
||||
#t "foobar" "foo-bar" "foo--bar"
|
||||
#f "fobar" "foo-barr" "ffoo-bar" ".foobar")
|
||||
((g->re-test "*foo-bar" #f #t)
|
||||
#f "foobar" "foo-barr"
|
||||
#t "foo-bar" "-foo-bar" "foo-foo-bar" "foo-bar-foo-bar" "f.foo-bar"
|
||||
#t ".foo-bar" ".foo-foo-bar")
|
||||
((g->re-test "[ab]*foo-bar" #f #t)
|
||||
#f "foobar" "foo-barr" "foo-bar"
|
||||
#t "afoo-bar" "b-foo-bar" "a-foo-foo-bar" "b.foo-bar"
|
||||
#f ".afoo-bar" ".b-foo-bar")
|
||||
((g->re-test "[.]foo-bar" #f #t)
|
||||
#f "foobar" "foo-barr" "foo-bar" "-foo-bar"
|
||||
#t ".foo-bar")
|
||||
((g->re-test "foo{*}bar" #t #t)
|
||||
#f "foo{bar" "foo{-{bar" "foo{}barr" ".foo-bar"
|
||||
#t "foo{}bar" "foo{-}bar" "foo{{}}bar" "foo{}{}bar")
|
||||
((g->re-test "^foo{[*]}bar$" #t #t #t)
|
||||
#f "^foo{[}bar$" "^foo{[-]{bar$" "^foo{[]}barr$" ".^foo{[]}bar$"
|
||||
#t "^foo{[]}bar$" "^foo{[-]}bar$" "^foo{[{}]}bar$" "^foo{[]}{[]}bar$")
|
||||
((g->re-test "$[.]^" #t #t #t) #f "$[,]^" #t "$[.]^"))
|
||||
|
||||
(report-errs)
|
||||
|
|
@ -1,39 +1,9 @@
|
|||
|
||||
(load-relative "loadtest.ss")
|
||||
|
||||
(Section 'mzlib-string)
|
||||
(Section 'string)
|
||||
|
||||
(require mzlib/string)
|
||||
|
||||
(let ([s1 (string-copy "Hello!")])
|
||||
(string-lowercase! s1)
|
||||
(test "hello!" 'lowercase s1)
|
||||
(string-uppercase! s1)
|
||||
(test "HELLO!" 'uppercase s1))
|
||||
|
||||
|
||||
(test 1 read-from-string "1")
|
||||
(test #f read-from-string "#f (2 3) (")
|
||||
(test #f read-from-string #"#f (2 3) (")
|
||||
(test 1 read-from-string "(" (lambda () 1))
|
||||
(test 1 read-from-string "(" (lambda (_) 1))
|
||||
(test '(1) read-from-string-all "1")
|
||||
(test '(#f (2 3)) read-from-string-all "#f (2 3)")
|
||||
(test '(#f (2 3)) read-from-string-all #"#f (2 3)")
|
||||
(test 1 read-from-string-all "(" (lambda () 1))
|
||||
(test 1 read-from-string-all "(" (lambda (_) 1))
|
||||
|
||||
|
||||
(test '1 eval-string "1")
|
||||
(test-values '(1 2 3) (lambda () (eval-string "1 2 3")))
|
||||
(test-values '(1 2 3) (lambda () (eval-string #"1 2 3")))
|
||||
(test-values '(1 2 3) (lambda () (eval-string "(values 1 2 3)")))
|
||||
(test-values '() (lambda () (eval-string "(values)")))
|
||||
(test-values '(1 2 3) (lambda () (eval-string "1 (values 2 3)")))
|
||||
(test-values '(1 2 3) (lambda () (eval-string "(values 1 2) 3")))
|
||||
(test-values '(1 2 3 4 5)
|
||||
(lambda ()
|
||||
(eval-string "(values 1 2) 3 (values) (values 4 5)")))
|
||||
;; to add when this library is there: (require scheme/string)
|
||||
|
||||
(let ([s (list->string
|
||||
(let loop ([i 0])
|
||||
|
|
@ -45,13 +15,6 @@
|
|||
regexp-replace
|
||||
(regexp-quote s) s (regexp-replace-quote (string-append "!" s "!"))))
|
||||
|
||||
(let ([s (open-input-string "hello there")])
|
||||
(test #f regexp-match/fail-without-reading #rx"not there" s)
|
||||
(test #f regexp-match/fail-without-reading #rx"t$" s)
|
||||
(test #f regexp-match/fail-without-reading #rx"hello there!!!" s)
|
||||
(test "hello there" read-string 50 s))
|
||||
|
||||
|
||||
(test '("a" "b" "c") regexp-match* "[abc]" "here's a buck")
|
||||
(test '("b" "c") regexp-match* "[abc]" "here's a buck" 8)
|
||||
(test '("a") regexp-match* "[abc]" "here's a buck" 0 8)
|
||||
|
|
@ -147,56 +110,4 @@
|
|||
;; this doesn't work (like in Emacs) because ^ matches the start pos
|
||||
;; (test '("" "foo bar") regexp-split #rx"^" "foo bar")
|
||||
|
||||
(let ([g->re-test
|
||||
(lambda (glob . more)
|
||||
(let ([re (apply glob->regexp glob more)])
|
||||
(lambda xs
|
||||
(let loop ([xs xs] [res 'unspecified])
|
||||
(when (pair? xs)
|
||||
(loop (cdr xs)
|
||||
(if (boolean? (car xs))
|
||||
(car xs)
|
||||
(begin (test res regexp-match? re (car xs))
|
||||
res))))))))])
|
||||
((g->re-test #"foo*bar" #t #t)
|
||||
#t #"foobar" #"foo-bar" #"foo--bar"
|
||||
#f #"fobar" #"foo-barr" #"ffoo-bar" #".foobar")
|
||||
((g->re-test "foo*bar" #t #t)
|
||||
#t "foobar" "foo-bar" "foo--bar"
|
||||
#f "fobar" "foo-barr" "ffoo-bar" ".foobar")
|
||||
((g->re-test "*foo-bar" #t #t)
|
||||
#f "foobar" "foo-barr"
|
||||
#t "foo-bar" "-foo-bar" "foo-foo-bar" "foo-bar-foo-bar" "f.foo-bar"
|
||||
#f ".foo-bar" ".foo-foo-bar")
|
||||
((g->re-test "[ab]*foo-bar" #t #t)
|
||||
#f "foobar" "foo-barr" "foo-bar"
|
||||
#t "afoo-bar" "b-foo-bar" "a-foo-foo-bar" "b.foo-bar"
|
||||
#f ".afoo-bar" ".b-foo-bar")
|
||||
((g->re-test "[.]foo-bar" #t #t)
|
||||
#f "foobar" "foo-barr" "foo-bar" "-foo-bar" ".foo-bar")
|
||||
((g->re-test "foo*bar" #t #f)
|
||||
#t "fOobAr" "Foo-Bar" "foO--baR"
|
||||
#f "FoBar" "fOO-baRR" "FFoo-bar" ".foobar")
|
||||
((g->re-test "foo*bar" #f #t)
|
||||
#t "foobar" "foo-bar" "foo--bar"
|
||||
#f "fobar" "foo-barr" "ffoo-bar" ".foobar")
|
||||
((g->re-test "*foo-bar" #f #t)
|
||||
#f "foobar" "foo-barr"
|
||||
#t "foo-bar" "-foo-bar" "foo-foo-bar" "foo-bar-foo-bar" "f.foo-bar"
|
||||
#t ".foo-bar" ".foo-foo-bar")
|
||||
((g->re-test "[ab]*foo-bar" #f #t)
|
||||
#f "foobar" "foo-barr" "foo-bar"
|
||||
#t "afoo-bar" "b-foo-bar" "a-foo-foo-bar" "b.foo-bar"
|
||||
#f ".afoo-bar" ".b-foo-bar")
|
||||
((g->re-test "[.]foo-bar" #f #t)
|
||||
#f "foobar" "foo-barr" "foo-bar" "-foo-bar"
|
||||
#t ".foo-bar")
|
||||
((g->re-test "foo{*}bar" #t #t)
|
||||
#f "foo{bar" "foo{-{bar" "foo{}barr" ".foo-bar"
|
||||
#t "foo{}bar" "foo{-}bar" "foo{{}}bar" "foo{}{}bar")
|
||||
((g->re-test "^foo{[*]}bar$" #t #t #t)
|
||||
#f "^foo{[}bar$" "^foo{[-]{bar$" "^foo{[]}barr$" ".^foo{[]}bar$"
|
||||
#t "^foo{[]}bar$" "^foo{[-]}bar$" "^foo{[{}]}bar$" "^foo{[]}{[]}bar$")
|
||||
((g->re-test "$[.]^" #t #t #t) #f "$[,]^" #t "$[.]^"))
|
||||
|
||||
(report-errs)
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user