
(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)
