From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Fri, 12 Mar 2010 09:38:25 +0000 (+0000)
Subject: 1.0.36.21: stricter handling of invalid backquote expressions
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=5adc3a40aa34bca37376b5e0b536ecd9f35d469d;p=sbcl.git

1.0.36.21: stricter handling of invalid backquote expressions

 Based on patch by: Stas Boukarev <stassats@gmail.com>

 Fixed launchpad bug #309093.
---

diff --git a/NEWS b/NEWS
index 8137cca..b85c0c0 100644
--- a/NEWS
+++ b/NEWS
@@ -35,6 +35,8 @@ changes relative to sbcl-1.0.36:
     (lp#535658)
   * bug fix: SB-CLTL2:DECLARATION-INFORMATION did not take
     SB-EXT:RESTRICT-COMPILER-POLICY into account. (lp#313337)
+  * bug fix: Comma inside a backquoted array or structure resulted in nonsense
+    values instead of signaling an error. (lp#309093)
 
 changes in sbcl-1.0.36 relative to sbcl-1.0.35:
   * new feature: SB-EXT:TYPEXPAND-1, SB-EXT:TYPEXPAND, and
diff --git a/src/code/backq.lisp b/src/code/backq.lisp
index 6aa1a70..45a3ebd 100644
--- a/src/code/backq.lisp
+++ b/src/code/backq.lisp
@@ -46,6 +46,7 @@
 (defvar *bq-at-flag* '(|,@|))
 (defvar *bq-dot-flag* '(|,.|))
 (defvar *bq-vector-flag* '(|bqv|))
+(defvar *bq-error* "Comma not inside a backquote.")
 
 (/show0 "backq.lisp 50")
 
@@ -68,7 +69,7 @@
   (unless (> *backquote-count* 0)
     (when *read-suppress*
       (return-from comma-macro nil))
-    (simple-reader-error stream "comma not inside a backquote"))
+    (simple-reader-error stream *bq-error*))
   (let ((c (read-char stream))
         (*backquote-count* (1- *backquote-count*)))
     (cond ((char= c #\@)
diff --git a/src/code/sharpm.lisp b/src/code/sharpm.lisp
index a628872..0e7c28e 100644
--- a/src/code/sharpm.lisp
+++ b/src/code/sharpm.lisp
@@ -93,10 +93,15 @@
   (when *read-suppress*
     (read stream t nil t)
     (return-from sharp-A nil))
-  (unless dimensions (simple-reader-error stream
-                                          "no dimensions argument to #A"))
+  (unless dimensions
+    (simple-reader-error stream "No dimensions argument to #A."))
   (collect ((dims))
-    (let* ((contents (read stream t nil t))
+    (let* ((*bq-error*
+            (if (zerop *backquote-count*)
+                *bq-error*
+                "Comma inside a backquoted array (not a list or general vector.)"))
+           (*backquote-count* 0)
+           (contents (read stream t nil t))
            (seq contents))
       (dotimes (axis dimensions
                      (make-array (dims) :initial-contents contents))
@@ -122,8 +127,14 @@
   (when *read-suppress*
     (read stream t nil t)
     (return-from sharp-S nil))
-  (let ((body (if (char= (read-char stream t) #\( )
-                  (read-list stream nil)
+  (let* ((*bq-error*
+          (if (zerop *backquote-count*)
+              *bq-error*
+              "Comma inside backquoted structure (not a list or general vector.)"))
+         (*backquote-count* 0)
+         (body (if (char= (read-char stream t) #\( )
+                  (let ((*backquote-count* -1))
+                    (read-list stream nil))
                   (simple-reader-error stream "non-list following #S"))))
     (unless (listp body)
       (simple-reader-error stream "non-list following #S: ~S" body))
diff --git a/tests/reader.pure.lisp b/tests/reader.pure.lisp
index a127d31..f0ba954 100644
--- a/tests/reader.pure.lisp
+++ b/tests/reader.pure.lisp
@@ -254,4 +254,11 @@
   (multiple-value-bind (reader-fn non-terminating-p)
       (get-macro-character #\" (copy-readtable nil))
     (declare (ignore reader-fn))
-    (assert (not non-terminating-p))))
\ No newline at end of file
+    (assert (not non-terminating-p))))
+
+(with-test (:name :bug-309093)
+  (assert (eq :error
+              (handler-case
+                  (read-from-string "`#2A((,(1+ 0) 0) (0 0))")
+                (reader-error ()
+                  :error)))))
diff --git a/version.lisp-expr b/version.lisp-expr
index dcf3f76..de81b35 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.36.20"
+"1.0.36.21"