From ccb68c834800e6dcf0451885c6be9616ee66171e Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Fri, 26 Feb 2010 14:07:52 +0200 Subject: [PATCH] buglet in LVAR-MATCHES * LVAR-USE where it should have been LVAR-USES. Launchpad bug 523612. --- NEWS | 3 +++ src/compiler/ir1util.lisp | 5 ++++- tests/compiler.pure.lisp | 10 ++++++++++ 3 files changed, 17 insertions(+), 1 deletions(-) diff --git a/NEWS b/NEWS index 68ac632..05bc8f7 100644 --- a/NEWS +++ b/NEWS @@ -1,4 +1,7 @@ ;;;; -*- coding: utf-8; fill-column: 78 -*- + * bug fix: Fix compiler error involving MAKE-ARRAY and IF forms + in :INITIAL-CONTENTS. (lp#523612) + changes relative to sbcl-1.0.35: * new feature: SB-EXT:TYPEXPAND-1, SB-EXT:TYPEXPAND, and SB-EXT:TYPEXPAND-ALL behave exactly like their MACROEXPAND counterparts diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp index 257fbe5..6641386 100644 --- a/src/compiler/ir1util.lisp +++ b/src/compiler/ir1util.lisp @@ -2190,8 +2190,11 @@ is :ANY, the function name is not checked." (not (null (member (leaf-source-name leaf) names :test #'equal)))))))) +;;; Return true if LVAR's only use is a call to one of the named functions +;;; (or any function if none are specified) with the specified number of +;;; of arguments (or any number if number is not specified) (defun lvar-matches (lvar &key fun-names arg-count) - (let ((use (lvar-use lvar))) + (let ((use (lvar-uses lvar))) (and (combination-p use) (or (not fun-names) (multiple-value-bind (name ok) diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index a924be7..3df48f9 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -3419,3 +3419,13 @@ (compile nil src)))) (assert (not warningp)) (assert (= 1.0d0 (funcall fun))))) + +(with-test (:name :bug-523612) + (let ((fun + (compile nil + `(lambda (&key toff) + (make-array 3 :element-type 'double-float + :initial-contents + (if toff (list toff 0d0 0d0) (list 0d0 0d0 0d0))))))) + (assert (equalp (vector 0.0d0 0.0d0 0.0d0) (funcall fun :toff nil))) + (assert (equalp (vector 2.3d0 0.0d0 0.0d0) (funcall fun :toff 2.3d0))))) -- 1.6.0.2.307.gc427