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.

diff --git a/src/compiler/physenvanal.lisp b/src/compiler/physenvanal.lisp
index 0b92341..ee3874e 100644 (file)
--- 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 (file)
--- 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)))))
 \f

diff --git a/version.lisp-expr b/version.lisp-expr
index 81d5744..f4bcad0 100644 (file)
--- 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"