[Guile-commits] branch stable-2.2 updated: Fix peval bug that ignored excess args

[Andy Wingo]

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