diff options
author | Nikodemus Siivola <nikodemus@random-state.net> | 2008-12-04 19:02:08 +0000 |
---|---|---|
committer | Nikodemus Siivola <nikodemus@random-state.net> | 2008-12-04 19:02:08 +0000 |
commit | 90d05e4ae39a451ce13a25f4467d0d280ff49593 (patch) | |
tree | af1fcd4a9b9895711f664debb800c2b8f7da9b91 /tests/reader.impure.lisp | |
parent | f23ae013c574b6b2fef2230a95f5688050b17689 (diff) |
1.0.23.20: check for standard readtable modification
* CLHS says that frobbing the standard readtable is undefined.
* Patch by Tobias Ritterweiler.
Diffstat (limited to 'tests/reader.impure.lisp')
-rw-r--r-- | tests/reader.impure.lisp | 34 |
1 files changed, 28 insertions, 6 deletions
diff --git a/tests/reader.impure.lisp b/tests/reader.impure.lisp index 02f202dc0..e3782b8a1 100644 --- a/tests/reader.impure.lisp +++ b/tests/reader.impure.lisp @@ -125,13 +125,35 @@ (funcall fun) (assert (equal '(:ok) (read-from-string "{:ok)")))) +(with-test (:name standard-readtable-modified) + (macrolet ((test (form &optional op) + `(assert + (eq :error + (handler-case + (progn ,form t) + (sb-int:standard-readtable-modified-error (e) + ,@(when op + `((assert + (equal ,op (sb-kernel::standard-readtable-modified-operation e))))) + :error)))))) + (let ((rt *readtable*)) + (with-standard-io-syntax + (let ((srt *readtable*)) + (test (setf (readtable-case srt) :preserve) '(setf readtable-case)) + (test (copy-readtable rt srt) 'copy-readtable) + (test (set-syntax-from-char #\a #\a srt rt) 'set-syntax-from-char) + (test (set-macro-character #\a (constantly t) t srt) 'set-macro-character) + (test (make-dispatch-macro-character #\! t srt)) + (test (set-dispatch-macro-character #\# #\a (constantly t) srt) 'set-dispatch-macro-character)))))) + ;;; THIS SHOULD BE LAST as it frobs the standard readtable (with-test (:name set-macro-character-nil) - (let ((fun (lambda (&rest args) 'ok))) - ;; NIL means the standard readtable. - (assert (eq t (set-macro-character #\~ fun nil nil))) - (assert (eq fun (get-macro-character #\~ nil))) - (assert (eq t (set-dispatch-macro-character #\# #\~ fun nil))) - (assert (eq fun (get-dispatch-macro-character #\# #\~ nil))))) + (handler-bind ((sb-int:standard-readtable-modified-error #'continue)) + (let ((fun (lambda (&rest args) 'ok))) + ;; NIL means the standard readtable. + (assert (eq t (set-macro-character #\~ fun nil nil))) + (assert (eq fun (get-macro-character #\~ nil))) + (assert (eq t (set-dispatch-macro-character #\# #\~ fun nil))) + (assert (eq fun (get-dispatch-macro-character #\# #\~ nil)))))) ;;; success |