95 lines
3.7 KiB
Scheme
95 lines
3.7 KiB
Scheme
|
|
(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)
|