From: Juho Snellman <jsnell@iki.fi>
Date: Wed, 2 Jan 2008 23:07:15 +0000 (+0000)
Subject: 1.0.13.11: ensure that sb-cover records don't clash with constants in user code
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=77a7ce93218e71f21268661611530a129002a8e6;p=sbcl.git

1.0.13.11: ensure that sb-cover records don't clash with constants in user code

        * If a code coverage instrumentation record is coalesced with another
          constant in the same file, the "we know what we're doing" comment
          in INSTRUMENT-COVERAGE about modifying constants no longer applies.
          Changes to the record will be reflected in the other constant too,
          which is probably not what the user expected.
        * Ensure that coalescing cannot happen by using a symbol internal to
          SB-C as the CDR of the record (instead of NIL).
        * Reported separately by Christophe Rhodes and Rahul Jain.
---

diff --git a/contrib/sb-cover/cover.lisp b/contrib/sb-cover/cover.lisp
index 8a38551..d697492 100644
--- a/contrib/sb-cover/cover.lisp
+++ b/contrib/sb-cover/cover.lisp
@@ -390,9 +390,9 @@ table.summary tr.subheading td { text-align: left; font-weight: bold; padding-le
            unless (member (caar record) '(:then :else))
            collect (list mode
                          (car record)
-                         (ecase (cdr record)
-                           ((t) 1)
-                           ((nil) 2)))))
+                         (if (sb-c::code-coverage-record-marked record)
+                             1
+                             2))))
     (:branch
      (let ((hash (make-hash-table :test 'equal)))
        (dolist (record records)
@@ -400,7 +400,7 @@ table.summary tr.subheading td { text-align: left; font-weight: bold; padding-le
            (when (member (car path) '(:then :else))
              (setf (gethash (cdr path) hash)
                    (logior (gethash (cdr path) hash 0)
-                           (ash (if (cdr record)
+                           (ash (if (sb-c::code-coverage-record-marked record)
                                     1
                                     2)
                                 (if (eql (car path) :then)
diff --git a/contrib/sb-cover/test-data-3.lisp b/contrib/sb-cover/test-data-3.lisp
new file mode 100644
index 0000000..3b2a515
--- /dev/null
+++ b/contrib/sb-cover/test-data-3.lisp
@@ -0,0 +1,8 @@
+(declaim (optimize sb-c::store-coverage-data))
+
+(defun test-1 ()
+  (print '((1 3 1))))
+
+(defun test-2 ()
+  (assert (equal (test-1)
+                 (list (list 1 3 1)))))
diff --git a/contrib/sb-cover/tests.lisp b/contrib/sb-cover/tests.lisp
index 6fb3d9a..7903b80 100644
--- a/contrib/sb-cover/tests.lisp
+++ b/contrib/sb-cover/tests.lisp
@@ -92,3 +92,9 @@
 ;; Complete branch coverage
 (assert (= (sb-cover::ok-of (getf sb-cover::*counts* :branch))
            (sb-cover::all-of (getf sb-cover::*counts* :branch))))
+
+;; Check for presence of constant coalescing bugs
+
+(load (compile-file (merge-pathnames #p"test-data-3.lisp" *path*)))
+(test-2)
+
diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp
index f19f445..2b0e386 100644
--- a/src/compiler/ir1tran.lisp
+++ b/src/compiler/ir1tran.lisp
@@ -832,9 +832,18 @@
 
 ;;;; code coverage
 
+;;; Used as the CDR of the code coverage instrumentation records
+;;; (instead of NIL) to ensure that any well-behaving user code will
+;;; not have constants EQUAL to that record. This avoids problems with
+;;; the records getting coalesced with non-record conses, which then
+;;; get mutated when the instrumentation runs. Note that it's
+;;; important for multiple records for the same location to be
+;;; coalesced. -- JES, 2008-01-02
+(defconstant +code-coverage-unmarked+ '%code-coverage-unmarked%)
+
 ;;; Check the policy for whether we should generate code coverage
 ;;; instrumentation. If not, just return the original START
-;;; ctran. Otherwise ninsert code coverage instrumentation after
+;;; ctran. Otherwise insert code coverage instrumentation after
 ;;; START, and return the new ctran.
 (defun instrument-coverage (start mode form)
   ;; We don't actually use FORM for anything, it's just convenient to
@@ -857,7 +866,7 @@
                    ;; each instrument for the same block.
                    (or (gethash path *code-coverage-records*)
                        (setf (gethash path *code-coverage-records*)
-                             (cons path nil))))
+                             (cons path +code-coverage-unmarked+))))
                   (next (make-ctran))
                   (*allow-instrumenting* nil))
               (push (ctran-block start)
@@ -900,9 +909,15 @@
   (maphash (lambda (info cc)
              (declare (ignore info))
              (dolist (cc-entry cc)
-               (setf (cdr cc-entry) nil)))
+               (setf (cdr cc-entry) +code-coverage-unmarked+)))
            *code-coverage-info*))
 
+(defun code-coverage-record-marked (record)
+  (aver (consp record))
+  (ecase (cdr record)
+    ((#.+code-coverage-unmarked+) nil)
+    ((t) t)))
+
 
 ;;;; converting combinations
 
diff --git a/version.lisp-expr b/version.lisp-expr
index f1d5354..8e4dd51 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.13.10"
+"1.0.13.11"