mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-30 06:50:31 +02:00
Code Activity

prompts avoid introducing throw; fixup peval test

Browse source 
* test-suite/tests/peval.test ("partial evaluation"): Fix to expect
raise-type-error from dynwind peval.  Update prompt expectation
similarly.
* module/language/tree-il/primitives.scm (call-with-prompt): Use
raise-type-error.
This commit is contained in:
Andy Wingo 2023-11-23 12:30:36 +01:00
parent 711077586b
commit 83449a8683
2 changed files with 5 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

9
module/language/tree-il/primitives.scm
View file

@ -727,12 +727,9 @@
src '() #f 'args #f '() (list args) src '() #f 'args #f '() (list args)
(primcall apply handler (make-lexical-ref #f 'args args)) (primcall apply handler (make-lexical-ref #f 'args args))
#f))) #f)))
(primcall throw (primcall raise-type-error
(const 'wrong-type-arg) (const #("call-with-prompt" 3 "procedure"))
(const "call-with-prompt") handler)))))))
(const "Wrong type (expecting procedure): ~S")
(primcall list handler)
(primcall list handler))))))))
(else #f))) (else #f)))
(define-primitive-expander! 'abort-to-prompt* (define-primitive-expander! 'abort-to-prompt*

4
test-suite/tests/peval.test
View file

@ -1144,7 +1144,7 @@
(let (tmp tmp) (_ _) ((toplevel foo) (toplevel baz)) (let (tmp tmp) (_ _) ((toplevel foo) (toplevel baz))
(seq (seq (if (primcall thunk? (lexical tmp _)) (seq (seq (if (primcall thunk? (lexical tmp _))
(call (lexical tmp _)) (call (lexical tmp _))
(primcall throw . _)) (primcall raise-type-error . _))
(primcall wind (lexical tmp _) (lexical tmp _))) (primcall wind (lexical tmp _) (lexical tmp _)))
(let (tmp) (_) ((toplevel bar)) (let (tmp) (_) ((toplevel bar))
(seq (seq (primcall unwind) (seq (seq (primcall unwind)
@ -1234,7 +1234,7 @@
(primcall apply (primcall apply
(lexical handler _) (lexical handler _)
(lexical args _)))))) (lexical args _))))))
(primcall throw . _)))) (primcall raise-type-error . _))))
(pass-if-peval (pass-if-peval
;; `while' without `break' or `continue' has no prompts and gets its ;; `while' without `break' or `continue' has no prompts and gets its