mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

peval: Always visit prompt bodies in values context

Browse source 
* module/language/tree-il/peval.scm (peval): Always evaluate the body in
  values context, as a captured continuation could continue to a
  continuation of any arity.  However the handler, if it returns, does
  return to the prompt's continuation.  Fixes #14347.  Thanks to Jussi
  Piitulainen for the report.
* test-suite/tests/control.test ("shift and reset"): Add a test.
This commit is contained in:
Andy Wingo 2016-06-20 22:59:38 +02:00
parent ee3381c94d
commit a192c336a2
2 changed files with 13 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

6
module/language/tree-il/peval.scm
View file

@ -1550,7 +1550,7 @@ top-level bindings from ENV and return the resulting expression."
(_ #f))) (_ #f)))
(let ((tag (for-value tag)) (let ((tag (for-value tag))
(body (for-tail body))) (body (for-values body)))
(cond (cond
((find-definition tag 1) ((find-definition tag 1)
(lambda (val op) (lambda (val op)
@ -1582,9 +1582,9 @@ top-level bindings from ENV and return the resulting expression."
,(make-primitive-ref #f 'values) ,(make-primitive-ref #f 'values)
,@(abort-args body) ,@(abort-args body)
,(abort-tail body))) ,(abort-tail body)))
(for-value handler))))) (for-tail handler)))))
(else (else
(make-prompt src tag body (for-value handler)))))) (make-prompt src tag body (for-tail handler))))))
(($ <abort> src tag args tail) (($ <abort> src tag args tail)
(make-abort src (for-value tag) (map for-value args) (make-abort src (for-value tag) (map for-value args)
(for-value tail)))))) (for-value tail))))))

10
test-suite/tests/control.test
View file

@ -427,3 +427,13 @@
(cons (car xs) (k (cdr xs)))))))) (cons (car xs) (k (cdr xs))))))))
(reset* (lambda () (visit xs)))) (reset* (lambda () (visit xs))))
(traverse '(1 2 3 4 5)))))) (traverse '(1 2 3 4 5))))))
(with-test-prefix/c&e "shift/reset optimization"
;; Although a call-with-prompt continuation might accept only a single
;; value, it doesn't mean that the body can't provide a possibly
;; different number of values to other continuations.
(pass-if-equal "bug #14347"
'(3.1 2 3)
(call-with-values
(lambda () (let ((k (reset (shift k k) (values 3.1 2 3)))) (k)))
list)))