From d66d5f7759b8ea443c480b20db9a778c87aef222 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Sun, 15 Nov 2009 00:36:24 +0000 Subject: [PATCH] move promise tests to tests/lazy svn: r16773 --- collects/tests/lazy/lang.ss | 54 ++++++++++++ collects/tests/lazy/main.ss | 51 +----------- collects/tests/lazy/promise.ss | 104 ++++++++++++++++++++++++ collects/tests/mzscheme/promise.ss | 94 --------------------- collects/tests/mzscheme/scheme-tests.ss | 1 - collects/tests/mzscheme/syntax.ss | 1 - 6 files changed, 161 insertions(+), 144 deletions(-) create mode 100644 collects/tests/lazy/lang.ss create mode 100644 collects/tests/lazy/promise.ss delete mode 100644 collects/tests/mzscheme/promise.ss diff --git a/collects/tests/lazy/lang.ss b/collects/tests/lazy/lang.ss new file mode 100644 index 0000000000..81feaa3969 --- /dev/null +++ b/collects/tests/lazy/lang.ss @@ -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=#�#" + (format "~s" (!! (letrec ([x (box-immutable (~ x))]) x))) + => "#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-!!))) diff --git a/collects/tests/lazy/main.ss b/collects/tests/lazy/main.ss index 0399be1dee..f12cdacfbd 100644 --- a/collects/tests/lazy/main.ss +++ b/collects/tests/lazy/main.ss @@ -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=#�#" - (format "~s" (!! (letrec ([x (box-immutable (~ x))]) x))) - => "#0=#�#" - (format "~s" (!! (letrec ([x (make-prefab-struct 'foo 1 (~ x))]) x))) - => "#0=#s(foo 1 #0#)" - )) - -) +(test do (lang-tests) + do (promise-tests)) diff --git a/collects/tests/lazy/promise.ss b/collects/tests/lazy/promise.ss new file mode 100644 index 0000000000..c5b75d0ef8 --- /dev/null +++ b/collects/tests/lazy/promise.ss @@ -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))) diff --git a/collects/tests/mzscheme/promise.ss b/collects/tests/mzscheme/promise.ss deleted file mode 100644 index 8ff0f3ed14..0000000000 --- a/collects/tests/mzscheme/promise.ss +++ /dev/null @@ -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) diff --git a/collects/tests/mzscheme/scheme-tests.ss b/collects/tests/mzscheme/scheme-tests.ss index 5a6a59ca1f..1562471cd6 100644 --- a/collects/tests/mzscheme/scheme-tests.ss +++ b/collects/tests/mzscheme/scheme-tests.ss @@ -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") diff --git a/collects/tests/mzscheme/syntax.ss b/collects/tests/mzscheme/syntax.ss index 7ef7dae384..ae36fb67ec 100644 --- a/collects/tests/mzscheme/syntax.ss +++ b/collects/tests/mzscheme/syntax.ss @@ -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)))