From 4a90772f91fa17ea6565591eed34c484c3722419 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Mon, 11 May 2009 11:17:51 +0000 Subject: [PATCH] 1.0.28.36: better logic for failure-to-stack-allocate notes * Elide if the use is a REF, not if the source form is a symbol. * Tests. --- src/compiler/physenvanal.lisp | 7 +++---- tests/dynamic-extent.impure.lisp | 41 ++++++++++++++++++++++++++++++++++++++ version.lisp-expr | 2 +- 3 files changed, 45 insertions(+), 5 deletions(-) diff --git a/src/compiler/physenvanal.lisp b/src/compiler/physenvanal.lisp index 0b92341..ee3874e 100644 --- a/src/compiler/physenvanal.lisp +++ b/src/compiler/physenvanal.lisp @@ -341,10 +341,9 @@ (real-dx-lvars real))) (t (do-uses (use lvar) - (let ((source (find-original-source (node-source-path use)))) - (unless (symbolp source) - (compiler-notify "could not stack allocate the result of ~S" - source)))) + (unless (ref-p use) + (compiler-notify "could not stack allocate the result of ~S" + (find-original-source (node-source-path use))))) (setf (lvar-dynamic-extent lvar) nil))))) (node ; DX closure (let* ((call what) diff --git a/tests/dynamic-extent.impure.lisp b/tests/dynamic-extent.impure.lisp index ae9a31c..99d925a 100644 --- a/tests/dynamic-extent.impure.lisp +++ b/tests/dynamic-extent.impure.lisp @@ -654,4 +654,45 @@ (array-total-size array))) (with-test (:name :length-and-words-packed-in-same-tn) (assert (= 1 (length-and-words-packed-in-same-tn -3)))) + +(with-test (:name :handler-case-bogus-compiler-note) + (handler-bind ((compiler-note #'error)) + ;; Taken from SWANK, used to signal a bogus stack allocation + ;; failure note. + (compile nil + `(lambda (files fasl-dir load) + (let ((needs-recompile nil)) + (dolist (src files) + (let ((dest (binary-pathname src fasl-dir))) + (handler-case + (progn + (when (or needs-recompile + (not (probe-file dest)) + (file-newer-p src dest)) + (setq needs-recompile t) + (ensure-directories-exist dest) + (compile-file src :output-file dest :print nil :verbose t)) + (when load + (load dest :verbose t))) + (serious-condition (c) + (handle-loadtime-error c dest)))))))))) + +(with-test (:name :dx-compiler-notes) + (let ((n 0)) + (handler-bind ((compiler-note (lambda (c) + (declare (ignore cc)) + (incf n)))) + (compile nil `(lambda (x) + (let ((v (make-array x))) + (declare (dynamic-extent v)) + (length v)))) + (assert (= 1 n)) + (compile nil `(lambda (x) + (let ((y (if (plusp x) + (true x) + (true (- x))))) + (declare (dynamic-extent y)) + (print y) + nil))) + (assert (= 3 n))))) diff --git a/version.lisp-expr b/version.lisp-expr index 81d5744..f4bcad0 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.28.35" +"1.0.28.36" -- 1.7.10.4