From 8a33bf220856487a5cde4b183476b6ab5103983a Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Mon, 12 Dec 2011 14:42:35 +0200 Subject: [PATCH] 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 --- NEWS | 3 ++- doc/manual/beyond-ansi.texinfo | 8 ++++++-- src/code/reader.lisp | 6 ++++-- tests/reader.pure.lisp | 8 +++++++- 4 files changed, 19 insertions(+), 6 deletions(-) diff --git a/NEWS b/NEWS index 297d20b..cec67b6 100644 --- 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 :: - 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 --- 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 -:: +:: @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 --- 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 :: 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 :: 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 --- 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!))))) -- 1.7.10.4