suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

mostly improvements for JIT testing

Browse Source 
svn: r1995
This commit is contained in:
Matthew Flatt 2006-01-27 00:51:04 +00:00
parent 276fc41e53
commit 44929bd21b
5 changed files with 187 additions and 123 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/tests/mzscheme/basic.ss
View File

@ -1,6 +1,16 @@
(load-relative "loadtest.ss")
(test "bbb" regexp-replace* "a" "aaa" "b")
(define (test-weird-offset regexp-match regexp-match-positions)
(test #f regexp-match "e" (open-input-string ""))
(test #f regexp-match "e" (open-input-string "") (expt 2 100))
(test #f regexp-match "e" (open-input-string "") (expt 2 100) (expt 2 101))
(test '((3 . 4)) regexp-match-positions "e" (open-input-string "eaae") 2 (expt 2 101)))
(test-weird-offset regexp-match regexp-match-positions)
(test '() 'null null)
(test '() 'null ())

122
collects/tests/mzscheme/contmark.ss
View File

@ -19,51 +19,75 @@
(syntax-test #'(with-continuation-mark 1 2 3 4))
(syntax-test #'(with-continuation-mark 1 2 3 . 4))
(test '(10) 'wcm (with-continuation-mark 'key 10
(extract-current-continuation-marks 'key)))
(test '(#(10 #f)) 'wcm (with-continuation-mark 'key 10
(continuation-mark-set->list* (current-continuation-marks) '(key no-key))))
(test '(#(#f 10)) 'wcm (with-continuation-mark 'key 10
(continuation-mark-set->list* (current-continuation-marks) '(no-key key))))
(test '(#(nope 10)) 'wcm (with-continuation-mark 'key 10
(continuation-mark-set->list* (current-continuation-marks) '(no-key key) 'nope)))
(define (wcm f) (f))
(test '(#(10 12)) 'wcm (with-continuation-mark 'key1 10
;; Test with an without wrapping `lambda', mainly to
;; test JIT interactions.
(define-syntax wcm-test
(syntax-rules (lambda)
[(_ expect orig)
(begin
(test expect wcm orig)
(test expect 'wcm (orig)))]))
(wcm-test '(10) (lambda ()
(with-continuation-mark 'key 10
(extract-current-continuation-marks 'key))))
(wcm-test '(#(10 #f)) (lambda ()
(with-continuation-mark 'key 10
(continuation-mark-set->list* (current-continuation-marks) '(key no-key)))))
(wcm-test '(#(#f 10)) (lambda ()
(with-continuation-mark 'key 10
(continuation-mark-set->list* (current-continuation-marks) '(no-key key)))))
(wcm-test '(#(nope 10)) (lambda ()
(with-continuation-mark 'key 10
(continuation-mark-set->list* (current-continuation-marks) '(no-key key) 'nope))))
(wcm-test '(#(10 12)) (lambda ()
(with-continuation-mark 'key1 10
(with-continuation-mark 'key2 12
(continuation-mark-set->list* (current-continuation-marks) '(key1 key2)))))
(test '(#(#f 12) #(10 #f)) 'wcm
(continuation-mark-set->list* (current-continuation-marks) '(key1 key2))))))
(wcm-test '(#(#f 12) #(10 #f))
(lambda ()
(with-continuation-mark 'key1 10
(let ([x (with-continuation-mark 'key2 12
(continuation-mark-set->list* (current-continuation-marks) '(key1 key2)))])
(if (void? x)
x
x))))
x)))))
(test '(11) 'wcm (with-continuation-mark 'key 10
(wcm-test '(11) (lambda ()
(with-continuation-mark 'key 10
(with-continuation-mark 'key 11
(extract-current-continuation-marks 'key)))))
(wcm-test '(9) (lambda () (with-continuation-mark 'key 10
(with-continuation-mark 'key2 9
(with-continuation-mark 'key 11
(extract-current-continuation-marks 'key2))))))
(wcm-test '() (lambda () (with-continuation-mark 'key 10
(with-continuation-mark 'key2 9
(with-continuation-mark 'key 11
(extract-current-continuation-marks 'key3))))))
(wcm-test '() (lambda ()
(let ([x (with-continuation-mark 'key 10 (list 100))])
(extract-current-continuation-marks 'key))))
(test '(9) 'wcm (with-continuation-mark 'key 10
(with-continuation-mark 'key2 9
(with-continuation-mark 'key 11
(extract-current-continuation-marks 'key2)))))
(test '() 'wcm (with-continuation-mark 'key 10
(with-continuation-mark 'key2 9
(with-continuation-mark 'key 11
(extract-current-continuation-marks 'key3)))))
(test '() 'wcm (let ([x (with-continuation-mark 'key 10 (list 100))])
(extract-current-continuation-marks 'key)))
(test '(11) 'wcm (with-continuation-mark 'key 11
(wcm-test '(11) (lambda ()
(with-continuation-mark 'key 11
(let ([x (with-continuation-mark 'key 10 (extract-current-continuation-marks 'key))])
(extract-current-continuation-marks 'key))))
(extract-current-continuation-marks 'key)))))
(test '((11) (10 11) (11)) 'wcm (with-continuation-mark 'key 11
(wcm-test '((11) (10 11) (11)) (lambda ()
(with-continuation-mark 'key 11
(list (extract-current-continuation-marks 'key)
(with-continuation-mark 'key 10 (extract-current-continuation-marks 'key))
(extract-current-continuation-marks 'key))))
(extract-current-continuation-marks 'key)))))
(test '(11) 'wcm-invoke/tail (with-continuation-mark 'x 10
(wcm-test '(11)
(lambda ()
(with-continuation-mark 'x 10
(invoke-unit
(unit
(import)
@ -72,9 +96,11 @@
(with-continuation-mark 'x 11
(continuation-mark-set->list
(current-continuation-marks)
'x))))))
'x)))))))
(test '(11 10) 'wcm-invoke/nontail (with-continuation-mark 'x 10
(wcm-test '(11 10)
(lambda ()
(with-continuation-mark 'x 10
(invoke-unit
(unit
(import)
@ -84,21 +110,26 @@
(continuation-mark-set->list
(current-continuation-marks)
'x)))
l))))
l)))))
(test '(11 10) 'wcm-begin0 (with-continuation-mark 'x 10
(wcm-test '(11 10)
(lambda ()
(with-continuation-mark 'x 10
(begin0
(with-continuation-mark 'x 11
(extract-current-continuation-marks 'x))
(+ 2 3))))
(test '(11 10) 'wcm-begin0/const (with-continuation-mark 'x 10
(+ 2 3)))))
(wcm-test '(11 10)
(lambda ()
(with-continuation-mark 'x 10
(begin0
(with-continuation-mark 'x 11
(extract-current-continuation-marks 'x))
'constant)))
'constant))))
;; full continuation, same thread
(test '(11 10) 'wcm-begin0
(wcm-test '(11 10)
(lambda ()
(let ([k (with-continuation-mark 'x 10
(begin0
(with-continuation-mark 'x 11
@ -106,10 +137,11 @@
(+ 2 3)))])
(continuation-mark-set->list
(continuation-marks k)
'x)))
'x))))
;; full continuation, another thread
(test '(11 10) 'wcm-begin0
(wcm-test '(11 10)
(lambda ()
(let ([k (with-continuation-mark 'x 10
(begin0
(with-continuation-mark 'x 11
@ -120,10 +152,11 @@
(thread-wait (thread (lambda ()
(set! v (continuation-marks k)))))
v)
'x)))
'x))))
;; escape continuation, same thread
(test '(11 10) 'wcm-begin0
(wcm-test '(11 10)
(lambda ()
(let ([m (with-continuation-mark 'x 10
(begin0
(with-continuation-mark 'x 11
@ -133,10 +166,11 @@
(continuation-marks k))
(+ 17 7))))
(+ 2 3)))])
(continuation-mark-set->list m 'x)))
(continuation-mark-set->list m 'x))))
;; escape continuation, another thread => not allowed
(test #f 'wcm-begin0
(wcm-test #f
(lambda ()
(with-continuation-mark 'x 10
(let/ec k
(with-continuation-mark 'x 12
@ -144,7 +178,7 @@
(thread-wait
(thread (lambda ()
(set! v (continuation-marks k)))))
v)))))
v))))))
;; escape continuation, dead
(err/rt-test (continuation-marks (let/ec k k)) exn:application:mismatch?)

31
collects/tests/mzscheme/optimize.ss
View File

@ -9,16 +9,29 @@
(define maybe-different-depths? #f)
(define (comp=? c1 c2)
(let ([s1 (open-output-string)]
[s2 (open-output-string)])
(let ([s1 (open-output-bytes)]
[s2 (open-output-bytes)])
(write c1 s1)
(write c2 s2)
(let ([t1 (get-output-string s1)]
[t2 (get-output-string s2)])
(or (string=? t1 t2)
(let ([t1 (get-output-bytes s1)]
[t2 (get-output-bytes s2)]
[skip-byte (+ 2 ; #~
1 ; version length
(string-length (version))
1 ; symtab count
1 ; length
1 ; CPT_MARSHALLED for top
1)])
(or (bytes=? t1 t2)
(and maybe-different-depths?
(string=? (substring t1 5 (string-length t1))
(substring t2 5 (string-length t2))))))))
(bytes=? (subbytes t1 0 (sub1 skip-byte))
(subbytes t2 0 (sub1 skip-byte)))
(bytes=? (subbytes t1 skip-byte)
(subbytes t2 skip-byte)))
(begin
(printf "~s\n~s\n" t1 t2)
#f
)))))
(define test-comp
(case-lambda
@ -101,6 +114,10 @@
'(expt 5 (* 5 6)))
(test-comp 88
'(if (pair? null) 89 88))
(test-comp '(if _x_ 2 1)
'(if (not _x_) 1 2))
(test-comp '(if _x_ 2 1)
'(if (not (not (not _x_))) 1 2))
(test-comp '(let ([x 3]) x)
'((lambda (x) x) 3))

2
collects/tests/mzscheme/syntax.ss
View File

@ -19,6 +19,7 @@
(with-handlers ([void (lambda (x) 5)])
(with-handlers ((zero? (lambda (x) 'zero)))
(/ 0))))
(error-test #'(with-handlers ()
(/ 0))
exn:fail:contract:divide-by-zero?)
@ -29,6 +30,7 @@
(boolean? (lambda (x) 'boolean)))
(/ 0))
exn:application:type?)
(syntax-test #'with-handlers)
(syntax-test #'(with-handlers))
(syntax-test #'(with-handlers . 1))

1
collects/tests/mzscheme/testing.ss
View File

@ -117,6 +117,7 @@ transcript.
(set! number-of-error-tests (add1 number-of-error-tests))
(write expr)
(display " =e=> ")
(flush-output)
(call/ec (lambda (escape)
(let* ([old-esc-handler (error-escape-handler)]
[old-handler (current-exception-handler)]