[Guile-commits] branch master 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 master
in repository guile.

The following commit(s) were added to refs/heads/master by this push:
     new cf53854  Fix peval bug that ignored excess args
cf53854 is described below

commit cf53854d42d4e260459896cb0c4b071608398b96
Author: Andy Wingo <address@hidden>
AuthorDate: Sun Jan 12 21:11:09 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 |  2 +-
 test-suite/tests/peval.test       | 21 +++++++++++++++++++--
 2 files changed, 20 insertions(+), 3 deletions(-)

diff --git a/module/language/tree-il/peval.scm 
b/module/language/tree-il/peval.scm
index f11640f..b400c71 100644
--- a/module/language/tree-il/peval.scm
+++ b/module/language/tree-il/peval.scm
@@ -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?)
diff --git a/test-suite/tests/peval.test b/test-suite/tests/peval.test
index 22b78f6..2eecc82 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, 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))))))))