mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-20 11:40:18 +02:00
Fix peval bug that ignored excess args
* module/language/tree-il/peval.scm (peval): Fix arity check for type confusion (empty value of "rest" in this context was (), not #f). The effect was that we'd silently allow extra arguments to inlined calls. Thanks to Christopher Lam for the report! Fixes #38617. * test-suite/tests/peval.test ("partial evaluation"): Add a test.
This commit is contained in:
parent
fd2ffc649c
commit
cf53854d42
2 changed files with 20 additions and 3 deletions
|
@ -1457,7 +1457,7 @@ top-level bindings from ENV and return the resulting expression."
|
|||
opt-vals)))))
|
||||
|
||||
(cond
|
||||
((or (< nargs nreq) (and (not rest) (> nargs (+ nreq nopt))))
|
||||
((or (< nargs nreq) (and (null? rest) (> nargs (+ nreq nopt))))
|
||||
;; An error, or effecting arguments.
|
||||
(make-call src (for-call orig-proc) (map for-value orig-args)))
|
||||
((or (and=> (find-counter key counter) counter-recursive?)
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
;;;; tree-il.test --- test suite for compiling tree-il -*- scheme -*-
|
||||
;;;; Andy Wingo <wingo@pobox.com> --- May 2009
|
||||
;;;;
|
||||
;;;; Copyright (C) 2009-2014, 2017 Free Software Foundation, Inc.
|
||||
;;;; Copyright (C) 2009-2014, 2017, 2020 Free Software Foundation, Inc.
|
||||
;;;;
|
||||
;;;; This library is free software; you can redistribute it and/or
|
||||
;;;; modify it under the terms of the GNU Lesser General Public
|
||||
|
@ -1415,4 +1415,21 @@
|
|||
(call (lexical lp _)
|
||||
(lexical x* _))))))))
|
||||
(call (lexical lp _)
|
||||
(lexical x _))))))))
|
||||
(lexical x _)))))))
|
||||
|
||||
(pass-if-peval
|
||||
(lambda ()
|
||||
(define (add1 n) (+ 1 n))
|
||||
(add1 1 2))
|
||||
(lambda ()
|
||||
(lambda-case
|
||||
((() #f #f #f () ())
|
||||
(fix (add1)
|
||||
(_)
|
||||
((lambda ((name . add1))
|
||||
(lambda-case
|
||||
(((n) #f #f #f () (_))
|
||||
(primcall + (const 1) (lexical n _))))))
|
||||
(call (lexical add1 _)
|
||||
(const 1)
|
||||
(const 2))))))))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue