From 8781261e4e8f6f74faaab86b7bfac018404a592a Mon Sep 17 00:00:00 2001
From: Douglas Katzman <dougk@google.com>
Date: Sun, 31 May 2015 11:39:57 -0400
Subject: [PATCH] Two definition-source-location fixes.

- Loading from .lisp failed to record toplevel-form-numbers
- Compiler was overly aggresive when coalescing
---
 src/code/source-location.lisp      |  9 ++++++---
 tests/compiler-2.impure-cload.lisp | 15 +++++++++++++++
 tests/load.impure.lisp             | 13 +++++++++++++
 3 files changed, 34 insertions(+), 3 deletions(-)

diff --git a/src/code/source-location.lisp b/src/code/source-location.lisp
index 9976057ae..9f8fcb0d9 100644
--- a/src/code/source-location.lisp
+++ b/src/code/source-location.lisp
@@ -32,13 +32,16 @@
                 (make-file-info-namestring
                  *compile-file-pathname*
                  (get-toplevelish-file-info *source-info*)))))
-         (tlf-num (when (boundp '*current-path*)
-                    (source-path-tlf-number *current-path*)))
+         (tlf-num (acond ((boundp '*current-path*)
+                          (source-path-tlf-number *current-path*))
+                         ((and source-info (source-info-file-info source-info))
+                          (1- (fill-pointer (file-info-forms it))))))
          (last (and source-info
                     (source-info-last-defn-source-loc source-info))))
     (if (and last
              (eql (definition-source-location-toplevel-form-number last) tlf-num)
-             (string= (definition-source-location-namestring last) namestring))
+             (string= (definition-source-location-namestring last) namestring)
+             (equal (definition-source-location-plist last) *source-plist*))
         last
         (let ((new (%make-definition-source-location namestring tlf-num)))
           (when source-info
diff --git a/tests/compiler-2.impure-cload.lisp b/tests/compiler-2.impure-cload.lisp
index 128dbb365..83052a8ce 100644
--- a/tests/compiler-2.impure-cload.lisp
+++ b/tests/compiler-2.impure-cload.lisp
@@ -89,3 +89,18 @@
   (multiple-value-bind (val foundp)
       (sb-int:info :variable :macro-expansion '%trash%)
     (assert (and (not val) (not foundp)))))
+
+;; This must be one toplevel form.
+;; In practice you'd never do anything like this I suspect.
+(progn
+  (defvar *foofoo1* 1)
+  (eval-when (:compile-toplevel)
+    (setq sb-c::*source-plist* '(strange "Yes")))
+  (defvar *foofoo2* 2))
+
+(with-test (:name :source-location-plist-invalid-memoization)
+  (assert (null (sb-c:definition-source-location-plist
+                    (sb-int:info :source-location :variable '*foofoo1*))))
+  (assert (equal (sb-c:definition-source-location-plist
+                     (sb-int:info :source-location :variable '*foofoo2*))
+                 '(strange "Yes"))))
diff --git a/tests/load.impure.lisp b/tests/load.impure.lisp
index f4c1bf50e..97477d795 100644
--- a/tests/load.impure.lisp
+++ b/tests/load.impure.lisp
@@ -13,6 +13,19 @@
 
 (defvar *tmp-filename* "load-test.tmp")
 
+;;; Loading from Lisp should set the TOPLEVEL-FORM-NUMBER slot
+(with-test (:name :load-lisp-assigns-tlf-num)
+  (with-open-file (f *tmp-filename* :direction :output
+                     :if-exists :supersede :if-does-not-exist :create)
+    (write '(defvar *var0* 'this-is-form-0) :stream f)
+    (write '(defvar *var1* 'this-is-form-1) :stream f))
+  (load *tmp-filename*)
+  (assert (eql 0 (sb-c:definition-source-location-toplevel-form-number
+                     (sb-int:info :source-location :variable '*var0*))))
+  (assert (eql 1 (sb-c:definition-source-location-toplevel-form-number
+                     (sb-int:info :source-location :variable '*var1*))))
+  (delete-file *tmp-filename*))
+
 ;;; Bug reported by Sean Ross: FASL loader set fill pointer to loaded
 ;;; simple arrays.
 
-- 
2.11.4.GIT