74 lines
2.9 KiB
Scheme
74 lines
2.9 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 _)))))))))
|
|
|
|
(report-errs)
|