From 18811631b81a9e7d4270c44896483199f3b7c7ac Mon Sep 17 00:00:00 2001 From: Alexey Dejneka Date: Fri, 30 Apr 2004 10:55:12 +0000 Subject: [PATCH] 0.8.10.2: * Fix bug 313, reported by Antonio Menezes Leitao: in PROPAGATE-FUN-CHANGE before applying source transform, check that LEAF corresponds to a global function, not to some random named identifier. --- BUGS | 13 +------------ src/compiler/ir1opt.lisp | 4 +++- tests/compiler.impure-cload.lisp | 7 +++++++ version.lisp-expr | 2 +- 4 files changed, 12 insertions(+), 14 deletions(-) diff --git a/BUGS b/BUGS index 1c30bdd..35172a6 100644 --- a/BUGS +++ b/BUGS @@ -1389,15 +1389,4 @@ WORKAROUND: (probably related to the bug 280.) 313: "source-transforms are Lisp-1" - (reported by Antonio Menezes Leitao on cll) - - PROPAGATE-FUN-CHANGE when checking, whether source transform is - applicable, does not check variable/function original position of the - COMBINATION-FUN. So the following functions are miscompiled: - - (defun foo (cadr) (if (functionp cadr) (funcall cadr 1) nil)) - - (defvar cadr) - (defun foo (cadr) (funcall (truly-the function cadr) 1)) - - (check with (FOO #'IDENTITY)) + (fixed in 0.8.10.2) diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp index 9bf0a58..bfad3a0 100644 --- a/src/compiler/ir1opt.lisp +++ b/src/compiler/ir1opt.lisp @@ -905,7 +905,9 @@ (lvar-uses (basic-combination-fun call)) call)) ((not leaf)) - ((and (leaf-has-source-name-p leaf) + ((and (global-var-p leaf) + (eq (global-var-kind leaf) :global-function) + (leaf-has-source-name-p leaf) (or (info :function :source-transform (leaf-source-name leaf)) (and info (ir1-attributep (fun-info-attributes info) diff --git a/tests/compiler.impure-cload.lisp b/tests/compiler.impure-cload.lisp index e42ec62..b0514a8 100644 --- a/tests/compiler.impure-cload.lisp +++ b/tests/compiler.impure-cload.lisp @@ -360,5 +360,12 @@ (let ((list (multiple-value-list (values-consumer #'values-producer)))) (assert (= (length list) 8)) (assert (null (nth 7 list)))) + +;;; bug 313: source transforms were "lisp-1" +(defun srctran-lisp1-1 (cadr) (if (functionp cadr) (funcall cadr 1) nil)) +(assert (eql (funcall (eval #'srctran-lisp1-1) #'identity) 1)) +(defvar caar) +(defun srctran-lisp1-2 (caar) (funcall (sb-ext:truly-the function caar) 1)) +(assert (eql (funcall (eval #'srctran-lisp1-2) #'identity) 1)) (sb-ext:quit :unix-status 104) diff --git a/version.lisp-expr b/version.lisp-expr index 540f76e..926a8ac 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".) -"0.8.10.1" +"0.8.10.2" -- 1.7.10.4