From 5193965ff7688f7d748962405343ed666bf616b2 Mon Sep 17 00:00:00 2001 From: Paul Khuong Date: Sat, 19 Oct 2013 17:47:47 -0400 Subject: [PATCH] Warn when wrapping constants with THE of multiple value types IR1 translation was too eager in eliminating redundant THE forms when the value is a constant. We now also make sure that the asserted type accepts single values. Reported by Nathan Trapuzzano on sbcl-help. --- NEWS | 5 ++++- src/compiler/ir1-translators.lisp | 2 ++ tests/compiler.pure.lisp | 10 ++++++++++ 3 files changed, 16 insertions(+), 1 deletion(-) diff --git a/NEWS b/NEWS index 64ec424..c2fe8cd 100644 --- a/NEWS +++ b/NEWS @@ -17,10 +17,13 @@ changes relative to sbcl-1.1.12: vectors from FASLs. (Reported by Jan Moringen) * bug fix: COMPILE can now succefully compile setf functions. (Reported by Douglas Katzman) - * bug fix: run-prorgram performs more correct escaping of arguments on + * bug fix: run-program performs more correct escaping of arguments on Windows. (lp#1239242) * bug fix: function-lambda-expression on generic functions returns the actual name. + * bug fix: (the [type] [constant]) now warns when [constant] matches + [type] except for the number of values. (Reported by Nathan Trapuzzano + on sbcl-help) changes in sbcl-1.1.12 relative to sbcl-1.1.11: * enhancement: Add sb-bsd-sockets:socket-shutdown, for calling diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp index add4fa1..7bd2bfb 100644 --- a/src/compiler/ir1-translators.lisp +++ b/src/compiler/ir1-translators.lisp @@ -912,6 +912,8 @@ other." (values-subtypep (make-single-value-type (leaf-type value)) type)) (and (sb!xc:constantp value) + (or (not (values-type-p type)) + (values-type-may-be-single-value-p type)) (ctypep (constant-form-value value) (single-value-type type)))) (ir1-convert start next result value)) diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index 83353e1..92079e7 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -4870,3 +4870,13 @@ (test `(lambda (x y) (setf (apply #'aref x y) 21))) (test `(lambda (x y) (setf (apply #'bit x y) 1))) (test `(lambda (x y) (setf (apply #'sbit x y) 0))))) + +(with-test (:name :warn-on-the-values-constant) + (multiple-value-bind (fun warnings-p failure-p) + (compile nil + ;; The compiler used to elide this test without + ;; noting that the type demands multiple values. + '(lambda () (the (values fixnum fixnum) 1))) + (declare (ignore warnings-p)) + (assert (functionp fun)) + (assert failure-p))) -- 1.7.10.4