protect against read-time package-lock circumvention from LOCKED::(BAR)

  Instead of binding *PACKAGE*, bind *READER-PACKAGE* which only
  affects the package READ-TOKEN interns into in the absence of a
  prefix.

  lp#902806

diff --git a/NEWS b/NEWS
index 297d20b..cec67b6 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -8,7 +8,8 @@ changes relative to sbcl-1.0.54:
        (Mainly useful for building 32-bit SBCL's on x86-64 hosts, not
        full-blows cross-compilation.)
   * enhancement: extended package prefix syntax <pkgname>::<form-in-package>
-    which allows specifying the name of the package for a whole form.
+    which allows specifying name of the default interning package for the
+    whole form.
   * enhancement: when *READ-EVAL* is true, arrays with element type other than
     T can be printed readably using #.-based syntax. (Thanks to Robert Brown)
   * enhancement: MAKE-ALIEN signals a storage-condition instead of returning a

diff --git a/doc/manual/beyond-ansi.texinfo b/doc/manual/beyond-ansi.texinfo
index 1e684d4..0c72409 100644 (file)
--- a/doc/manual/beyond-ansi.texinfo
+++ b/doc/manual/beyond-ansi.texinfo
@@ -26,10 +26,11 @@ it still has quite a few.  @xref{Contributed Modules}.
 @cindex Reader Extensions
 
 SBCL supports extended package prefix syntax, which allows specifying
-the package to read an arbitrary form in:
+an alternate package instead of @code{*package*} for the reader to use
+as the default package for interning symbols:
 
 @lisp
-<package-name>::<form-in-package>
+<package-name>::<form-with-interning-into-package>
 @end lisp
 
 Example:
@@ -38,6 +39,9 @@ Example:
   'foo::(bar quux zot) == '(foo::bar foo::quux foo::zot)
 @end lisp
 
+Doesn't alter @code{*package*}: if @code{foo::bar} would cause a
+read-time package lock violation, so does @code{foo::(bar)}.
+
 @node  Garbage Collection
 @comment  node-name,  next,  previous,  up
 @section Garbage Collection

diff --git a/src/code/reader.lisp b/src/code/reader.lisp
index 77ab6f0..afc6650 100644 (file)
--- a/src/code/reader.lisp
+++ b/src/code/reader.lisp
@@ -904,6 +904,8 @@ standard Lisp readtable when NIL."
                (cond (all-lower (raise-em))
                      (all-upper (lower-em))))))))))))
 
+(defvar *reader-package* nil)
+
 (defun read-token (stream firstchar)
   #!+sb-doc
   "Default readmacro function. Handles numbers, symbols, and SBCL's
@@ -1262,7 +1264,7 @@ extended <package-name>::<form-in-package> syntax."
         (#.+char-attr-delimiter+
          (unread-char char stream)
          (if package-designator
-             (let ((*package* (%find-package-or-lose package-designator)))
+             (let* ((*reader-package* (%find-package-or-lose package-designator)))
                (return (read stream t nil t)))
              (simple-reader-error stream
                                   "illegal terminating character after a double-colon: ~S"
@@ -1278,7 +1280,7 @@ extended <package-name>::<form-in-package> syntax."
       (casify-read-buffer escapes)
       (let ((found (if package-designator
                        (%find-package-or-lose package-designator)
-                       (sane-package))))
+                       (or *reader-package* (sane-package)))))
         (if (or (zerop colons) (= colons 2) (eq found *keyword-package*))
             (return (intern* *read-buffer* *ouch-ptr* found))
             (multiple-value-bind (symbol test)

diff --git a/tests/reader.pure.lisp b/tests/reader.pure.lisp
index 1fbd790..7d29b18 100644 (file)
--- a/tests/reader.pure.lisp
+++ b/tests/reader.pure.lisp
@@ -276,4 +276,10 @@
 
 (with-test (:name :read-in-package-syntax)
   (assert (equal '(sb-c::a (sb-kernel::x sb-kernel::y) sb-c::b)
-                 (read-from-string "sb-c::(a sb-kernel::(x y) b)"))))
+                 (read-from-string "sb-c::(a sb-kernel::(x y) b)")))
+  #+sb-package-locks
+  (assert (eq :violated!
+              (handler-case
+                  (read-from-string "cl::'foo")
+                (package-lock-violation ()
+                  :violated!)))))