summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2023-01-16 15:33:18 +0100
committerLudovic Courtès <ludo@gnu.org>2023-01-16 15:33:18 +0100
commit51152392ef04b053e3c7b2576473df2df9d08fe0 (patch)
tree69be36ea6cfa7189897f88172162cf3109cea794
parente441c34f1666921f6b15597c1aa3a50596a129d7 (diff)
downloadguile-51152392ef04b053e3c7b2576473df2df9d08fe0.tar.gz
Do not expand 'make-vector' primcall with wrong number of arguments.
Fixes <https://bugs.gnu.org/60522>. Reported by Sascha Ziemann <ceving@gmail.com>. * module/language/tree-il/primitives.scm (make-vector): Return #f when passed an incorrect number of arguments. * test-suite/tests/peval.test ("partial evaluation"): Add tests.
-rw-r--r--module/language/tree-il/primitives.scm6
-rw-r--r--test-suite/tests/peval.test13
2 files changed, 14 insertions, 5 deletions
diff --git a/module/language/tree-il/primitives.scm b/module/language/tree-il/primitives.scm
index 135a1f56f..1d85c0624 100644
--- a/module/language/tree-il/primitives.scm
+++ b/module/language/tree-il/primitives.scm
@@ -1,6 +1,6 @@
;;; open-coding primitive procedures
-;; Copyright (C) 2009-2015, 2017-2022 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015, 2017-2023 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
@@ -471,8 +471,8 @@
(make-primcall src 'make-vector (list len (make-const src *unspecified*))))
((src len init)
(make-primcall src 'make-vector (list len init)))
- ((src . args)
- (make-call src (make-primitive-ref src 'make-vector) args))))
+ ((src . args) ;wrong number of arguments
+ #f)))
(define-primitive-expander caar (x) (car (car x)))
(define-primitive-expander cadr (x) (car (cdr x)))
diff --git a/test-suite/tests/peval.test b/test-suite/tests/peval.test
index 89b4870f6..a2e4975d9 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 <wingo@pobox.com> --- May 2009
;;;;
-;;;; Copyright (C) 2009-2014, 2017, 2020, 2022 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009-2014, 2017, 2020, 2022-2023 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
@@ -1445,7 +1445,16 @@
(primcall + (const 1) (lexical n _))))))
(call (lexical add1 _)
(const 1)
- (const 2))))))))
+ (const 2)))))))
+
+ (pass-if-peval (make-vector 123 x)
+ (primcall make-vector (const 123) (toplevel x)))
+
+ (pass-if-peval (make-vector)
+ ;; This used to trigger an infinite loop between
+ ;; 'resolve-primitives' and 'expand-primcall':
+ ;; <https://bugs.gnu.org/60522>.
+ (primcall make-vector)))
(with-test-prefix "eqv?"
(pass-if-peval (eqv? x #f)