summaryrefslogtreecommitdiff
path: root/test-suite/tests/control.test
diff options
context:
space:
mode:
Diffstat (limited to 'test-suite/tests/control.test')
-rw-r--r--test-suite/tests/control.test84
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))))