From: Nikodemus Siivola Date: Wed, 8 Jul 2009 13:34:56 +0000 (+0000) Subject: 1.0.29.54.rc5: fix load-time-value regressions X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=d0376c0b2e38ff518c85d50a5befd3a13e14d3e1;p=sbcl.git 1.0.29.54.rc5: fix load-time-value regressions * (SPECIFIIER-TYPE 'FUNCTION) is not a FUN-TYPE. * Don't allow constant moves from LTV TNs (better fix after release): this is the simple and obviously correct fix. * Also declaim the type of the correct function in the test-case from last commit. --- diff --git a/src/compiler/ltv.lisp b/src/compiler/ltv.lisp index b7c705c..a695b65 100644 --- a/src/compiler/ltv.lisp +++ b/src/compiler/ltv.lisp @@ -35,7 +35,10 @@ guaranteed to never be modified, so it can be put in read-only storage." (specifier-type 'function)) ((and (legal-fun-name-p op) (eq :declared (info :function :where-from op))) - (fun-type-returns (info :function :type op))) + (let ((ftype (info :function :type op))) + (if (fun-type-p ftype) + (fun-type-returns ftype) + *wild-type*))) (t *wild-type*)))) ((and (symbolp form) diff --git a/src/compiler/represent.lisp b/src/compiler/represent.lisp index 8d2418e..c4b92cc 100644 --- a/src/compiler/represent.lisp +++ b/src/compiler/represent.lisp @@ -414,7 +414,12 @@ (operand-restriction-ok (first (template-result-types info)) (if write-p op-ptype other-ptype) - :t-ok nil)) + :t-ok nil) + ;; KLUDGE: Move VOPs with constant SCs can't use + ;; load-time-value TNs. FIXME: if the VOPs were more + ;; clever they could -- this is the release bandaid. + (or (not (eq 'constant (sc-name op-sc))) + (tn-leaf op-tn))) (return info)))))) ;;; Emit a coercion VOP for OP BEFORE the specifed VOP or die trying. diff --git a/tests/compiler.impure-cload.lisp b/tests/compiler.impure-cload.lisp index bf6231e..edb4652 100644 --- a/tests/compiler.impure-cload.lisp +++ b/tests/compiler.impure-cload.lisp @@ -534,3 +534,14 @@ (assert (eq 'number (load-time-value-type-derivation-test-2))) (assert (not (ctu:find-value-cell-values #'load-time-value-auto-read-only-p))) (assert (ctu:find-value-cell-values #'load-time-value-boring))) + +(defun regression-1.0.29.54 () + (logior (1+ most-positive-fixnum) + (load-time-value (the fixnum (eval 1)) t))) + +(test-util:with-test (:name :regression-1.0.29.54) + (assert (= (+ most-positive-fixnum 2) (regression-1.0.29.54))) + (assert (eq 42 + (funcall (compile nil + `(lambda () + (load-time-value (values 42)))))))) diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp index 55bbd0e..f24c436 100644 --- a/tests/compiler.impure.lisp +++ b/tests/compiler.impure.lisp @@ -1122,12 +1122,12 @@ m13 m23 m33 m43 m14 m24 m34 m44))) (declaim (ftype (sb-int:sfunction ((simple-array single-float (3)) single-float) matrix) - rotate-around-bad)) + rotate-around)) (defun rotate-around (a radians) (let ((c (cos radians)) - (s (sin radians)) + (s (sin radians)) ;; The 1.0 here was misloaded on x86-64. - (g (- 1.0 (cos radians)))) + (g (- 1.0 (cos radians)))) (let* ((x (aref a 0)) (y (aref a 1)) (z (aref a 2)) diff --git a/version.lisp-expr b/version.lisp-expr index 93629ef..aecef95 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.29.54.rc4" +"1.0.29.54.rc5"