1
Fork 0
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:
Andy Wingo 2020-01-12 21:11:09 +01:00
parent fd2ffc649c
commit cf53854d42
2 changed files with 20 additions and 3 deletions

View file

@ -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?)

View file

@ -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))))))))