diff options
Diffstat (limited to 'test-suite/tests/control.test')
-rw-r--r-- | test-suite/tests/control.test | 84 |
1 files changed, 30 insertions, 54 deletions
diff --git a/test-suite/tests/control.test b/test-suite/tests/control.test index e17b5843c..99379103b 100644 --- a/test-suite/tests/control.test +++ b/test-suite/tests/control.test @@ -23,9 +23,6 @@ #:use-module (test-suite lib)) -(define default-tag (fluid-ref %default-prompt-tag)) - - ;; For these, the compiler should be able to prove that "k" is not referenced, ;; so it avoids reifying the continuation. Since that's a slightly different ;; codepath, we test them both. @@ -34,17 +31,15 @@ (equal? '() (call-with-values (lambda () - (% default-tag - (values) + (% (values) (lambda (k . args) (error "unexpected exit" args)))) list))) (pass-if "no values, abnormal exit" (equal? '() - (% default-tag - (begin - (abort default-tag) + (% (begin + (abort) (error "unexpected exit")) (lambda (k . args) args)))) @@ -53,17 +48,15 @@ (equal? '(foo) (call-with-values (lambda () - (% default-tag - 'foo + (% 'foo (lambda (k . args) (error "unexpected exit" args)))) list))) (pass-if "single value, abnormal exit" (equal? '(foo) - (% default-tag - (begin - (abort default-tag 'foo) + (% (begin + (abort 'foo) (error "unexpected exit")) (lambda (k . args) args)))) @@ -72,17 +65,15 @@ (equal? '(foo bar baz) (call-with-values (lambda () - (% default-tag - (values 'foo 'bar 'baz) + (% (values 'foo 'bar 'baz) (lambda (k . args) (error "unexpected exit" args)))) list))) (pass-if "multiple values, abnormal exit" (equal? '(foo bar baz) - (% default-tag - (begin - (abort default-tag 'foo 'bar 'baz) + (% (begin + (abort 'foo 'bar 'baz) (error "unexpected exit")) (lambda (k . args) args))))) @@ -93,8 +84,7 @@ (equal? '() (call-with-values (lambda () - (% default-tag - (values) + (% (values) (lambda (k . args) (error "unexpected exit" k args)))) list))) @@ -102,9 +92,8 @@ (pass-if "no values, abnormal exit" (equal? '() (cdr - (% default-tag - (begin - (abort default-tag) + (% (begin + (abort) (error "unexpected exit")) (lambda args args))))) @@ -113,8 +102,7 @@ (equal? '(foo) (call-with-values (lambda () - (% default-tag - 'foo + (% 'foo (lambda (k . args) (error "unexpected exit" k args)))) list))) @@ -122,9 +110,8 @@ (pass-if "single value, abnormal exit" (equal? '(foo) (cdr - (% default-tag - (begin - (abort default-tag 'foo) + (% (begin + (abort 'foo) (error "unexpected exit")) (lambda args args))))) @@ -133,8 +120,7 @@ (equal? '(foo bar baz) (call-with-values (lambda () - (% default-tag - (values 'foo 'bar 'baz) + (% (values 'foo 'bar 'baz) (lambda (k . args) (error "unexpected exit" k args)))) list))) @@ -142,9 +128,8 @@ (pass-if "multiple values, abnormal exit" (equal? '(foo bar baz) (cdr - (% default-tag - (begin - (abort default-tag 'foo 'bar 'baz) + (% (begin + (abort 'foo 'bar 'baz) (error "unexpected exit")) (lambda args args)))))) @@ -152,37 +137,32 @@ ;; The variants check different cases in the compiler. (with-test-prefix "restarting partial continuations" (pass-if "in side-effect position" - (let ((k (% default-tag - (begin (abort default-tag) 'foo) + (let ((k (% (begin (abort) 'foo) (lambda (k) k)))) (eq? (k) 'foo))) (pass-if "passing values to side-effect abort" - (let ((k (% default-tag - (begin (abort default-tag) 'foo) + (let ((k (% (begin (abort) 'foo) (lambda (k) k)))) (eq? (k 'qux 'baz 'hello) 'foo))) (pass-if "called for one value" - (let ((k (% default-tag - (+ (abort default-tag) 3) + (let ((k (% (+ (abort) 3) (lambda (k) k)))) (eqv? (k 39) 42))) (pass-if "called for multiple values" - (let ((k (% default-tag - (let-values (((a b . c) (abort default-tag))) + (let ((k (% (let-values (((a b . c) (abort))) (list a b c)) (lambda (k) k)))) (equal? (k 1 2 3 4) '(1 2 (3 4))))) (pass-if "in tail position" - (let ((k (% default-tag - (abort default-tag) + (let ((k (% (abort) (lambda (k) k)))) (eq? (k 'xyzzy) 'xyzzy)))) @@ -192,20 +172,17 @@ (with-test-prefix "suspend/resume with fluids" (pass-if "normal" - (zero? (% default-tag - (fluid-ref fl) + (zero? (% (fluid-ref fl) error))) (pass-if "with-fluids normal" - (equal? (% default-tag - (with-fluids ((fl (1+ (fluid-ref fl)))) + (equal? (% (with-fluids ((fl (1+ (fluid-ref fl)))) (fluid-ref fl)) error) 1)) (pass-if "normal (post)" (zero? (fluid-ref fl))) (pass-if "with-fluids and fluid-set!" - (equal? (% default-tag - (with-fluids ((fl (1+ (fluid-ref fl)))) + (equal? (% (with-fluids ((fl (1+ (fluid-ref fl)))) (fluid-set! fl (1+ (fluid-ref fl))) (fluid-ref fl)) error) @@ -223,9 +200,8 @@ (fluid-ref fl)) 0)) - (let ((k (% default-tag - (with-fluids ((fl (1+ (fluid-ref fl)))) - (abort default-tag) + (let ((k (% (with-fluids ((fl (1+ (fluid-ref fl)))) + (abort) (fluid-ref fl)) (lambda (k) k)))) (pass-if "pre" @@ -240,8 +216,8 @@ (let ((k (% 'a (% 'b (begin - (abort 'a) - (abort 'b #t)) + (abort-to-prompt 'a) + (abort-to-prompt 'b #t)) (lambda (k x) x)) (lambda (k) k)))) (k)))) |