This is an automated email from the git hooks/post-receive script. wingo pushed a commit to branch stable-2.2 in repository guile.
The following commit(s) were added to refs/heads/stable-2.2 by this push: new aa0bfa2 Fix peval bug that ignored excess args aa0bfa2 is described below commit aa0bfa2f9387262ad972674c4d1d88e0e3d863b3 Author: Andy Wingo <wi...@pobox.com> AuthorDate: Sun Jan 12 21:05:19 2020 +0100 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. --- module/language/tree-il/peval.scm | 4 ++-- test-suite/tests/peval.test | 21 +++++++++++++++++++-- 2 files changed, 21 insertions(+), 4 deletions(-) diff --git a/module/language/tree-il/peval.scm b/module/language/tree-il/peval.scm index 13b7d9b..c9db7be 100644 --- a/module/language/tree-il/peval.scm +++ b/module/language/tree-il/peval.scm @@ -1,6 +1,6 @@ ;;; Tree-IL partial evaluator -;; Copyright (C) 2011-2014 Free Software Foundation, Inc. +;; Copyright (C) 2011-2014, 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 @@ -1480,7 +1480,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?) diff --git a/test-suite/tests/peval.test b/test-suite/tests/peval.test index 4e2ccf9..82cf335 100644 --- a/test-suite/tests/peval.test +++ b/test-suite/tests/peval.test @@ -1,7 +1,7 @@ ;;;; tree-il.test --- test suite for compiling tree-il -*- scheme -*- ;;;; Andy Wingo <wi...@pobox.com> --- May 2009 ;;;; -;;;; Copyright (C) 2009-2014 Free Software Foundation, Inc. +;;;; Copyright (C) 2009-2014, 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 @@ -1413,4 +1413,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 () ()) + (letrec* (add1) + (_) + ((lambda ((name . add1)) + (lambda-case + (((n) #f #f #f () (_)) + (primcall + (const 1) (lexical n _)))))) + (call (lexical add1 _) + (const 1) + (const 2))))))))