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

move promise tests to tests/lazy

Browse Source 
svn: r16773
This commit is contained in:
Eli Barzilay 2009-11-15 00:36:24 +00:00
parent 8e3ec9d3bf
commit d66d5f7759
6 changed files with 161 additions and 144 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
collects/tests/lazy/lang.ss Normal file
View File

@ -0,0 +1,54 @@
#lang scheme/base
(require tests/eli-tester lazy/force)
;; Currently this has only tests for the lazy language `!' forcer.
(define (test-lazy/force)
(test (! 1) => 1
(! (! 1)) => 1
(! (~ 1)) => 1
(! (~ (~ (~ 1)))) => 1))
(define (test-!list)
(test (!list (list 1 2 3)) => '(1 2 3)
(!list (~ (list 1 2 3))) => '(1 2 3)
(!list (~ (cons 1 (~ (cons 2 (~ (cons 3 (~ null)))))))) => '(1 2 3)
(!list 1) => 1 ; works on dotted lists
(!list (cons 1 2)) => '(1 . 2)))
(define (test-!!list)
(test (!!list (list 1 2 3)) => '(1 2 3)
(!!list (list (~ 1) (~ 2) (~ 3))) => '(1 2 3)
(!!list (list* (~ 1) (~ 2) (~ 3))) => '(1 2 . 3)
(!!list (~ (cons (~ 1) (~ (cons (~ 2) (~ (cons (~ 3) (~ null))))))))
=> '(1 2 3)
(!!list (~ (cons (~ 1) (~ (list 2 3))))) => '(1 2 3)
(!!list (~ (cons (~ 1) (~ (list 2 (~ 3)))))) => '(1 2 3)))
(define (test-!!)
(parameterize ([print-graph #t])
(test
(!! (~ (cons (~ 1) (~ (cons (~ 2) (~ (cons (~ 3) (~ null))))))))
=> '(1 2 3)
(format "~s" (!! (letrec ([ones (~ (cons 1 (~ ones)))]) ones)))
=> "#0=(1 . #0#)"
(format "~s" (!! (letrec ([ones (~ (cons 1 (~ ones)))]) (list ones ones))))
=> "(#0=(1 . #0#) #0#)"
(format "~s" (!! (letrec ([x (vector 1 (~ x))]) x)))
=> "#0=#(1 #0#)"
(format "~s" (!! (letrec ([x (vector-immutable 1 (~ x))]) x)))
=> "#0=#(1 #0#)"
(format "~s" (!! (letrec ([x (box (~ x))]) x)))
=> "#0=#&#0#"
(format "~s" (!! (letrec ([x (box-immutable (~ x))]) x)))
=> "#0=#&#0#"
(format "~s" (!! (letrec ([x (make-prefab-struct 'foo 1 (~ x))]) x)))
=> "#0=#s(foo 1 #0#)")))
(provide lang-tests)
(define (lang-tests)
(test do (test-lazy/force)
do (test-!list)
do (test-!!list)
do (test-!!)))

51
collects/tests/lazy/main.ss
View File

@ -1,51 +1,6 @@
#lang scheme/base
(require tests/eli-tester lazy/force)
(require tests/eli-tester "promise.ss" "lang.ss")
(test
;; lazy/force behavior
(test
(! 1) => 1
(! (! 1)) => 1
(! (~ 1)) => 1
(! (~ (~ (~ 1)))) => 1)
;; !list
(test
(!list (list 1 2 3)) => '(1 2 3)
(!list (~ (list 1 2 3))) => '(1 2 3)
(!list (~ (cons 1 (~ (cons 2 (~ (cons 3 (~ null)))))))) => '(1 2 3)
(!list 1) => 1 ; works on dotted lists
(!list (cons 1 2)) => '(1 . 2))
;; !!list
(test
(!!list (list 1 2 3)) => '(1 2 3)
(!!list (list (~ 1) (~ 2) (~ 3))) => '(1 2 3)
(!!list (list* (~ 1) (~ 2) (~ 3))) => '(1 2 . 3)
(!!list (~ (cons (~ 1) (~ (cons (~ 2) (~ (cons (~ 3) (~ null)))))))) => '(1 2 3)
(!!list (~ (cons (~ 1) (~ (list 2 3))))) => '(1 2 3)
(!!list (~ (cons (~ 1) (~ (list 2 (~ 3)))))) => '(1 2 3))
;; !!
(parameterize ([print-graph #t])
(test
(!! (~ (cons (~ 1) (~ (cons (~ 2) (~ (cons (~ 3) (~ null)))))))) => '(1 2 3)
(format "~s" (!! (letrec ([ones (~ (cons 1 (~ ones)))]) ones)))
=> "#0=(1 . #0#)"
(format "~s" (!! (letrec ([ones (~ (cons 1 (~ ones)))]) (list ones ones))))
=> "(#0=(1 . #0#) #0#)"
(format "~s" (!! (letrec ([x (vector 1 (~ x))]) x)))
=> "#0=#(1 #0#)"
(format "~s" (!! (letrec ([x (vector-immutable 1 (~ x))]) x)))
=> "#0=#(1 #0#)"
(format "~s" (!! (letrec ([x (box (~ x))]) x)))
=> "#0=#&#0#"
(format "~s" (!! (letrec ([x (box-immutable (~ x))]) x)))
=> "#0=#&#0#"
(format "~s" (!! (letrec ([x (make-prefab-struct 'foo 1 (~ x))]) x)))
=> "#0=#s(foo 1 #0#)"
))
)
(test do (lang-tests)
do (promise-tests))

104
collects/tests/lazy/promise.ss Normal file
View File

@ -0,0 +1,104 @@
#lang scheme/base
(require scheme/promise tests/eli-tester (for-syntax scheme/base))
;; check that things are `promise?'s or not
(define (test-types)
(for ([v (list 1 '(1) (lambda () 1))])
(test (promise? v) => #f))
(for ([v (list (delay 1) (lazy 1) (delay (delay 1)) (lazy (lazy 1)))])
(test (promise? v) => #t)))
;; basic delay/lazy/force tests
(define (basic-promise-tests)
(define thunk1 (lambda () 1))
(define promise1 (delay 1))
(define ? #f)
;; test a few different values
(define-syntax-rule (t (f x ...))
(begin (set! ? 1) (test (f x ...) => ?)
(set! ? '()) (test (f x ...) => ?)
(set! ? '(1)) (test (f x ...) => ?)
(set! ? thunk1) (test (f x ...) => ?)))
(define-syntax-rule (t* (f x ...))
(begin (t (f x ...)) (set! ? promise1) (test (f x ...) => ?)))
;; `force' is identity for non-promises
(t (force ?))
;; basic checks that `delay' works as expected with all kinds of values
(t* (force (delay ?)))
(t* (force (force (delay (delay ?)))))
(t* (force (delay (force (delay ?)))))
;; basic checks that `lazy' works as expected with all kinds of values
(t (force (lazy ?)))
(t (force (lazy (lazy ?))))
(t (force (force (lazy (lazy ?)))))
(t (force (lazy (lazy (lazy (lazy ?))))))
;; check that `lazy' combines as expected with `delay' in regards to `force'
;; (generally, each `L*D?' sequence requires a force)
(t* (force (lazy (delay ?))))
(t* (force (lazy (lazy (delay ?)))))
(t* (force (lazy (lazy (lazy (delay ?))))))
;; two delays = two forces
(t* (force (force (lazy (delay (delay ?))))))
(t* (force (force (delay (lazy (delay ?))))))
(t* (force (force (lazy (lazy (delay (delay ?)))))))
(t* (force (force (lazy (delay (lazy (delay ?)))))))
(t* (force (force (delay (lazy (lazy (delay ?)))))))
(t* (force (force (lazy (lazy (lazy (delay (delay ?))))))))
(t* (force (force (lazy (lazy (delay (lazy (delay ?))))))))
(t* (force (force (lazy (delay (lazy (lazy (delay ?))))))))
(t* (force (force (delay (lazy (lazy (lazy (delay ?))))))))
;; now push the second force inside
(t* (force (lazy (force (delay (delay ?))))))
(t* (force (delay (force (lazy (delay ?))))))
(t* (force (lazy (force (lazy (delay (delay ?)))))))
(t* (force (lazy (force (delay (lazy (delay ?)))))))
(t* (force (delay (force (lazy (lazy (delay ?)))))))
(t* (force (lazy (force (lazy (lazy (delay (delay ?))))))))
(t* (force (lazy (force (lazy (delay (lazy (delay ?))))))))
(t* (force (lazy (force (delay (lazy (lazy (delay ?))))))))
(t* (force (delay (force (lazy (lazy (lazy (delay ?))))))))
(t* (force (lazy (delay (force (delay ?))))))
(t* (force (lazy (lazy (force (delay (delay ?)))))))
(t* (force (lazy (delay (force (lazy (delay ?)))))))
(t* (force (lazy (lazy (force (lazy (delay (delay ?))))))))
(t* (force (lazy (lazy (force (delay (lazy (delay ?))))))))
(t* (force (lazy (delay (force (lazy (lazy (delay ?))))))))
(t* (force (lazy (lazy (delay (force (delay ?)))))))
(t* (force (lazy (lazy (lazy (force (delay (delay ?))))))))
(t* (force (lazy (lazy (delay (force (lazy (delay ?)))))))))
(define (basic-promise-behavior-tests)
(define (force+catch p) (with-handlers ([exn? values]) (force p)))
;; results are cached
(let* ([c 0] [p (delay (set! c (add1 c)) c)])
(test c => 0
(force p) => 1
(force p) => 1
(force p) => 1
c => 1))
;; errors are caught
(let ([p #f])
(test (void? (set! p (delay (error "BOOM"))))
(force p) =error> "BOOM"
(eq? (force+catch p) (force+catch p)))) ; and cached
;; raised values too
(let ([c 0] [p #f])
(test (void? (set! p (delay (set! c (add1 c)) (raise c))))
c => 0
(force p) => (raise 1)
(force p) => (raise 1)
c => 1))
;; test the predicates
(letrec ([forced+running?
(lambda (p) (list (promise-forced? p) (promise-running? p)))]
[p (delay (forced+running? p))])
(test (forced+running? p) => '(#f #f)
(force p) => '(#f #t)
(forced+running? p) => '(#t #f))))
(provide promise-tests)
(define (promise-tests)
(test do (test-types)
do (basic-promise-tests)
do (basic-promise-behavior-tests)))

94
collects/tests/mzscheme/promise.ss
View File

@ -1,94 +0,0 @@
(load-relative "loadtest.ss")
(Section 'promise)
(require scheme/promise)
;; check that things are `promise?'s or not
(for ([v (list 1 '(1) (lambda () 1))])
(test #f promise? v))
(for ([v (list (delay 1) (lazy 1) (delay (delay 1)) (lazy (lazy 1)))])
(test #t promise? v))
(let ()
(define thunk1 (lambda () 1))
;; test a few different values
(define-syntax (t stx)
(define _ (datum->syntax stx '_ stx))
(syntax-case stx ()
[(t (f x ...))
(with-syntax ([_ _])
#'(begin (let ([_ 1]) (test _ f x ...))
(let ([_ '()]) (test _ f x ...))
(let ([_ '(1)]) (test _ f x ...))
(let ([_ thunk1]) (test _ f x ...))))]))
;; `force' is identity for non-promises
(t (force _))
;; basic checks that `delay' works as expected with all kinds of values
(t (force (delay _)))
(t (force (force (delay (delay _)))))
(t (force (delay (force (delay _)))))
;; basic checks that `lazy' works as expected with all kinds of values
(t (force (lazy _)))
(t (force (lazy (lazy _))))
(t (force (force (lazy (lazy _)))))
(t (force (lazy (lazy (lazy (lazy _))))))
;; check that `lazy' combines as expected with `delay' in regards to `force'
;; (generally, each `L*D?' sequence requires a force)
(t (force (lazy (delay _))))
(t (force (lazy (lazy (delay _)))))
(t (force (lazy (lazy (lazy (delay _))))))
;; two delays = two forces
(t (force (force (lazy (delay (delay _))))))
(t (force (force (delay (lazy (delay _))))))
(t (force (force (lazy (lazy (delay (delay _)))))))
(t (force (force (lazy (delay (lazy (delay _)))))))
(t (force (force (delay (lazy (lazy (delay _)))))))
(t (force (force (lazy (lazy (lazy (delay (delay _))))))))
(t (force (force (lazy (lazy (delay (lazy (delay _))))))))
(t (force (force (lazy (delay (lazy (lazy (delay _))))))))
(t (force (force (delay (lazy (lazy (lazy (delay _))))))))
;; now push the second force inside
(t (force (lazy (force (delay (delay _))))))
(t (force (delay (force (lazy (delay _))))))
(t (force (lazy (force (lazy (delay (delay _)))))))
(t (force (lazy (force (delay (lazy (delay _)))))))
(t (force (delay (force (lazy (lazy (delay _)))))))
(t (force (lazy (force (lazy (lazy (delay (delay _))))))))
(t (force (lazy (force (lazy (delay (lazy (delay _))))))))
(t (force (lazy (force (delay (lazy (lazy (delay _))))))))
(t (force (delay (force (lazy (lazy (lazy (delay _))))))))
(t (force (lazy (delay (force (delay _))))))
(t (force (lazy (lazy (force (delay (delay _)))))))
(t (force (lazy (delay (force (lazy (delay _)))))))
(t (force (lazy (lazy (force (lazy (delay (delay _))))))))
(t (force (lazy (lazy (force (delay (lazy (delay _))))))))
(t (force (lazy (delay (force (lazy (lazy (delay _))))))))
(t (force (lazy (lazy (delay (force (delay _)))))))
(t (force (lazy (lazy (lazy (force (delay (delay _))))))))
(t (force (lazy (lazy (delay (force (lazy (delay _)))))))))
;; more tests
(let ()
(define (force+catch p)
(with-handlers ([void (lambda (x) (cons 'catch x))]) (force p)))
(define (forced+running? p) (list (promise-forced? p) (promise-running? p)))
;; results are cached
(let ([p (delay (random 10000))])
(test #t equal? (force p) (force p)))
;; errors are cached
(let ([p (delay (error 'foo "blah"))])
(test #t equal? (force+catch p) (force+catch p)))
;; other raised values are cached
(let ([p (delay (raise (random 10000)))])
(test #t equal? (force+catch p) (force+catch p)))
;; test the predicates
(letrec ([p (delay (forced+running? p))])
(test '(#f #f) forced+running? p)
(test '(#f #t) force p)
(test '(#t #f) forced+running? p))
)
(report-errs)

1
collects/tests/mzscheme/scheme-tests.ss
View File

@ -7,6 +7,5 @@
(load-in-sandbox "vector.ss")
(load-in-sandbox "function.ss")
(load-in-sandbox "dict.ss")
(load-in-sandbox "promise.ss")
(load-in-sandbox "contract-test.ss")

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

@ -626,7 +626,6 @@
(syntax-test #'(delay))
(syntax-test #'(delay . 1))
(syntax-test #'(delay 1 . 2))
(syntax-test #'(delay 1 2))
(test '(list 3 4) 'quasiquote `(list ,(+ 1 2) 4))
(test '(list a (quote a)) 'quasiquote (let ((name 'a)) `(list ,name ',name)))