mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-09 13:30:26 +02:00
Code Activity

Do not expand 'make-vector' primcall with wrong number of arguments.

Browse source 
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.
This commit is contained in:
Ludovic Courtès 2023-01-16 15:33:18 +01:00
parent e441c34f16
commit 51152392ef
2 changed files with 14 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

6
module/language/tree-il/primitives.scm
View file

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

13
test-suite/tests/peval.test
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, 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)