diff options
| author | Andy Wingo <wingo@pobox.com> | 2016-12-12 20:55:08 +0100 |
|---|---|---|
| committer | Andy Wingo <wingo@pobox.com> | 2016-12-12 21:13:00 +0100 |
| commit | 6dd87f4d8c764360c8d22c03f65603ea8b8c9e78 (patch) | |
| tree | 6a502663cd206f0b4a46f61e8eb090ba4bd2e78b /test-suite | |
| parent | bf4a97898beac167e8b4f565ce4c7540bed24685 (diff) | |
Add suspendable-continuation?
* doc/ref/api-control.texi (Prompt Primitives): Document
suspendable-continuation?.
* libguile/control.c (scm_suspendable_continuation_p): New procedure.
(scm_init_ice_9_control): New extension procedure, defines
suspendable-continuation?.
(scm_init_control): Register scm_init_ice_9_control.
* libguile/eval.c (eval):
* libguile/throw.c (catch):
* libguile/continuations.c (scm_i_make_continuation): Restore resumable
prompt cookie after continuation invocation.
* libguile/vm.c (scm_call_n): Arrange to set resumable_prompt_cookie
during invocation of VM.
* libguile/vm.h (struct scm_vm): Add resumable_prompt_cookie member.
* module/ice-9/control.scm: Export suspendable-continuation?.
* test-suite/tests/control.test ("suspendable-continuation?"): New
test.
Diffstat (limited to 'test-suite')
| -rw-r--r-- | test-suite/tests/control.test | 27 |
1 files changed, 27 insertions, 0 deletions
diff --git a/test-suite/tests/control.test b/test-suite/tests/control.test index 52ce6b138..4ca8ed8cd 100644 --- a/test-suite/tests/control.test +++ b/test-suite/tests/control.test @@ -410,3 +410,30 @@ (cons (car xs) (k (cdr xs)))))))) (reset* (lambda () (visit xs)))) (traverse '(1 2 3 4 5)))))) + +(with-test-prefix "suspendable-continuation?" + (let ((tag (make-prompt-tag))) + (pass-if "escape-only" + (call-with-prompt tag + (lambda () + (suspendable-continuation? tag)) + (lambda _ (error "unreachable")))) + (pass-if "full" + (call-with-prompt tag + (lambda () + (suspendable-continuation? tag)) + (lambda (k) (error "unreachable" k)))) + (pass-if "escape-only with barrier" + (call-with-prompt tag + (lambda () + (with-continuation-barrier + (lambda () + (not (suspendable-continuation? tag))))) + (lambda _ (error "unreachable")))) + (pass-if "full with barrier" + (call-with-prompt tag + (lambda () + (with-continuation-barrier + (lambda () + (not (suspendable-continuation? tag))))) + (lambda (k) (error "unreachable" k)))))) |