312 lines
10 KiB
Racket
312 lines
10 KiB
Racket
#lang racket
|
|
(require rackunit
|
|
web-server/lang/abort-resume)
|
|
(require/expose web-server/lang/abort-resume (web-prompt))
|
|
(provide abort-resume-tests)
|
|
|
|
(define abort-resume-tests
|
|
(test-suite
|
|
"Abort/Resume"
|
|
|
|
(test-suite
|
|
"with-current-saved-continuation-marks-and"
|
|
|
|
(test-case
|
|
"Easy"
|
|
(check-equal?
|
|
(call-with-web-prompt
|
|
(lambda ()
|
|
(with-current-saved-continuation-marks-and
|
|
'k1 'v1
|
|
(lambda ()
|
|
(continuation-mark-set->list
|
|
(current-continuation-marks web-prompt)
|
|
the-save-cm-key)))))
|
|
(list (make-immutable-hash (list (cons 'k1 'v1))))))
|
|
|
|
(test-case
|
|
"Preserve (beta)"
|
|
(check-equal?
|
|
(call-with-web-prompt
|
|
(lambda ()
|
|
(with-continuation-mark the-save-cm-key
|
|
(make-immutable-hash (list (cons 'k2 'v2)))
|
|
|
|
(call-with-immediate-continuation-mark
|
|
the-save-cm-key
|
|
(lambda (old-cms)
|
|
(with-continuation-mark the-save-cm-key
|
|
(hash-set old-cms 'k1 'v1)
|
|
(continuation-mark-set->list
|
|
(current-continuation-marks web-prompt)
|
|
the-save-cm-key)))
|
|
(make-immutable-hash empty)))))
|
|
(list (make-immutable-hash
|
|
(list (cons 'k1 'v1)
|
|
(cons 'k2 'v2))))))
|
|
|
|
#;(test-case
|
|
"Preserve"
|
|
(check-equal?
|
|
(call-with-web-prompt
|
|
(lambda ()
|
|
(with-continuation-mark the-save-cm-key
|
|
(make-immutable-hash (list (cons 'k2 'v2)))
|
|
(with-current-saved-continuation-marks-and
|
|
'k1 'v1
|
|
(lambda ()
|
|
(continuation-mark-set->list
|
|
(current-continuation-marks web-prompt)
|
|
the-save-cm-key))))))
|
|
(list (make-immutable-hash
|
|
(list (cons 'k1 'v1)
|
|
(cons 'k2 'v2))))))
|
|
|
|
(test-case
|
|
"Update (beta)"
|
|
(check-equal?
|
|
(call-with-web-prompt
|
|
(lambda ()
|
|
(with-continuation-mark the-save-cm-key
|
|
(make-immutable-hash (list (cons 'k2 'v2) (cons 'k1 'v3)))
|
|
|
|
(call-with-immediate-continuation-mark
|
|
the-save-cm-key
|
|
(lambda (old-cms)
|
|
(with-continuation-mark the-save-cm-key
|
|
(hash-set old-cms 'k1 'v1)
|
|
(continuation-mark-set->list
|
|
(current-continuation-marks web-prompt)
|
|
the-save-cm-key)))
|
|
(make-immutable-hash empty)))))
|
|
(list (make-immutable-hash
|
|
(list (cons 'k1 'v1)
|
|
(cons 'k2 'v2))))))
|
|
|
|
#;(test-case
|
|
"Update"
|
|
(check-equal?
|
|
(call-with-web-prompt
|
|
(lambda ()
|
|
(with-continuation-mark the-save-cm-key
|
|
(make-immutable-hash (list (cons 'k2 'v2) (cons 'k1 'v3)))
|
|
(with-current-saved-continuation-marks-and
|
|
'k1 'v1
|
|
(lambda ()
|
|
(continuation-mark-set->list
|
|
(current-continuation-marks web-prompt)
|
|
the-save-cm-key))))))
|
|
(list (make-immutable-hash
|
|
(list (cons 'k1 'v1)
|
|
(cons 'k2 'v2))))))
|
|
|
|
(test-case
|
|
"Double (beta)"
|
|
(check-equal?
|
|
(call-with-web-prompt
|
|
(lambda ()
|
|
(with-continuation-mark the-save-cm-key
|
|
(make-immutable-hash (list (cons 'k3 'v1) (cons 'k4 'v2)))
|
|
((lambda (x) x)
|
|
(with-continuation-mark the-save-cm-key
|
|
(make-immutable-hash (list (cons 'k2 'v2) (cons 'k1 'v3)))
|
|
|
|
(call-with-immediate-continuation-mark
|
|
the-save-cm-key
|
|
(lambda (old-cms)
|
|
(with-continuation-mark the-save-cm-key
|
|
(hash-set old-cms 'k1 'v1)
|
|
(continuation-mark-set->list
|
|
(current-continuation-marks web-prompt)
|
|
the-save-cm-key)))
|
|
(make-immutable-hash empty)))))))
|
|
(list (make-immutable-hash
|
|
(list (cons 'k1 'v1)
|
|
(cons 'k2 'v2)))
|
|
(make-immutable-hash
|
|
(list (cons 'k3 'v1)
|
|
(cons 'k4 'v2))))))
|
|
|
|
#;(test-case
|
|
"Double"
|
|
(check-equal?
|
|
(call-with-web-prompt
|
|
(lambda ()
|
|
(with-continuation-mark the-save-cm-key
|
|
(make-immutable-hash (list (cons 'k3 'v1) (cons 'k4 'v2)))
|
|
((lambda (x) x)
|
|
(with-continuation-mark the-save-cm-key
|
|
(make-immutable-hash (list (cons 'k2 'v2) (cons 'k1 'v3)))
|
|
(with-current-saved-continuation-marks-and
|
|
'k1 'v1
|
|
(lambda ()
|
|
(continuation-mark-set->list
|
|
(current-continuation-marks web-prompt)
|
|
the-save-cm-key))))))))
|
|
(list (make-immutable-hash
|
|
(list (cons 'k1 'v1)
|
|
(cons 'k2 'v2)))
|
|
(make-immutable-hash
|
|
(list (cons 'k3 'v1)
|
|
(cons 'k4 'v2)))))))
|
|
|
|
(test-suite
|
|
"activation-record-list"
|
|
|
|
(test-case
|
|
"Not in prompt"
|
|
(check-exn exn? (lambda () (activation-record-list))))
|
|
|
|
(test-case
|
|
"Easy"
|
|
(check-equal? (call-with-web-prompt
|
|
(lambda () (activation-record-list)))
|
|
empty))
|
|
|
|
(test-case
|
|
"Single"
|
|
(check-equal? (call-with-web-prompt
|
|
(lambda ()
|
|
(let/ec esc
|
|
('f1 (with-continuation-mark the-cont-key +
|
|
(esc (reverse (activation-record-list))))))))
|
|
(list (vector + #f #f))))
|
|
|
|
(test-case
|
|
"Double"
|
|
(check-equal? (call-with-web-prompt
|
|
(lambda ()
|
|
(let/ec esc
|
|
('f1 (with-continuation-mark the-cont-key +
|
|
('f2 (with-continuation-mark the-cont-key -
|
|
(esc (reverse (activation-record-list))))))))))
|
|
; Opposite the order of c-c-m
|
|
(list (vector + #f #f)
|
|
(vector - #f #f))))
|
|
|
|
(test-case
|
|
"Unsafe"
|
|
(check-exn
|
|
exn?
|
|
(lambda ()
|
|
(call-with-web-prompt
|
|
(lambda ()
|
|
(with-continuation-mark safe-call? #f
|
|
(activation-record-list))))))))
|
|
|
|
(test-suite
|
|
"abort"
|
|
|
|
(test-case
|
|
"Not in prompt"
|
|
(check-exn exn? (lambda () (abort (lambda () 42)))))
|
|
|
|
(test-case
|
|
"Simple"
|
|
(check-equal? (call-with-web-prompt
|
|
(lambda ()
|
|
(abort (lambda () 42))))
|
|
42)))
|
|
|
|
(test-suite
|
|
"resume"
|
|
|
|
(test-case
|
|
"Simple"
|
|
(check-equal? (resume empty (list 42))
|
|
42))
|
|
|
|
#;(test-case
|
|
"Empty frame"
|
|
(check-exn exn? (lambda () (resume (reverse (list (vector #f #f #f))) (list 42)))))
|
|
|
|
(test-case
|
|
"Kont"
|
|
(let ([f (lambda (x) (* x x))])
|
|
(check-equal? (resume (reverse (list (vector f #f #f))) (list 42))
|
|
(f 42))))
|
|
|
|
(test-case
|
|
"Kont 2"
|
|
(let ([f (lambda (x) (* x x))]
|
|
[g (lambda (x) (+ x x))])
|
|
(check-equal? (resume (reverse (list (vector f #f #f) (vector g #f #f))) (list 42))
|
|
(f (g 42)))))
|
|
|
|
(test-case
|
|
"Cont-key"
|
|
(let ([f (lambda (x) (* x x))]
|
|
[g (lambda (x) (+ x x))]
|
|
[esc-b (box #f)]
|
|
[capture (lambda _ (reverse (activation-record-list)))])
|
|
(check-equal? (call-with-web-prompt
|
|
(lambda ()
|
|
(let/ec esc
|
|
(set-box! esc-b esc)
|
|
(resume (reverse
|
|
(list (vector f #f #f) (vector g #f #f)
|
|
(vector esc #f #f) (vector capture #f #f)))
|
|
(list 42)))))
|
|
(list (vector f #f #f) (vector g #f #f)
|
|
(vector (unbox esc-b) #f #f)))))
|
|
|
|
(test-case
|
|
"marks"
|
|
(let ([f (lambda (x) (* x x))]
|
|
[g (lambda (x) (+ x x))])
|
|
(check-equal? (call-with-web-prompt
|
|
(lambda ()
|
|
(let/ec esc
|
|
(resume (reverse
|
|
(list (vector f (make-immutable-hash (list (cons 3 4) (cons 1 2))) #f)
|
|
(vector g (make-immutable-hash (list (cons 5 6))) #f)
|
|
(vector esc (make-immutable-hash (list (cons 7 8))) #f)
|
|
(vector (lambda _
|
|
(continuation-mark-set->list*
|
|
(current-continuation-marks)
|
|
(list 1 3 5 7)))
|
|
#f
|
|
#f)))
|
|
(list 42)))))
|
|
(list (vector #f #f #f 8)
|
|
(vector #f #f 6 #f)
|
|
(vector 2 4 #f #f)))))
|
|
|
|
(test-case
|
|
"cm-key"
|
|
(let ([f (lambda (x) (* x x))]
|
|
[g (lambda (x) (+ x x))]
|
|
[esc-b (box #f)]
|
|
[capture (lambda _ (activation-record-list))])
|
|
(check-equal? (call-with-web-prompt
|
|
(lambda ()
|
|
(let/ec esc
|
|
(set-box! esc-b esc)
|
|
(resume (reverse
|
|
(list (vector f (make-immutable-hash (list (cons 3 4) (cons 1 2))) #f)
|
|
(vector g (make-immutable-hash (list (cons 5 6))) #f)
|
|
(vector esc (make-immutable-hash (list (cons 7 8))) #f)
|
|
(vector capture #f #f)))
|
|
(list 42)))))
|
|
(reverse
|
|
(list (vector f (make-immutable-hash (list (cons 3 4) (cons 1 2))) #f)
|
|
(vector g (make-immutable-hash (list (cons 5 6))) #f)
|
|
(vector (unbox esc-b) (make-immutable-hash (list (cons 7 8))) #f)))))))
|
|
|
|
; XXX test kont
|
|
|
|
; XXX test kont-append-fun
|
|
|
|
; XXX test send/suspend
|
|
|
|
; XXX test dispatch-start
|
|
|
|
; XXX test dispatch
|
|
|
|
))
|
|
|
|
#|
|
|
(require rackunit/text-ui)
|
|
(run-tests abort-resume-tests)
|
|
|#
|