From bdb53694a70062532aa735e4cb37db51e9cd7254 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Fri, 14 Jan 2005 18:09:01 +0000 Subject: [PATCH] 0.8.18.32: Fixes for Rubout and Backspace syntax (PFD ansi-tests) --- NEWS | 2 ++ src/code/reader.lisp | 63 ++++++++++++++++++++++++++--------------------- src/code/readtable.lisp | 8 +++++- version.lisp-expr | 2 +- 4 files changed, 45 insertions(+), 30 deletions(-) diff --git a/NEWS b/NEWS index 9df9311..addba38 100644 --- a/NEWS +++ b/NEWS @@ -40,6 +40,8 @@ changes in sbcl-0.8.19 relative to sbcl-0.8.18: the correct number of arguments. ** READ-FROM-STRING returns the mandated second value when applied to displaced strings. + ** the #\Rubout and #\Backspace characters are treated as invalid + constituent characters by the tokenizer. changes in sbcl-0.8.18 relative to sbcl-0.8.17: * new feature: reloading changed shared object files with diff --git a/src/code/reader.lisp b/src/code/reader.lisp index 8391d6d..40b6e1e 100644 --- a/src/code/reader.lisp +++ b/src/code/reader.lisp @@ -167,7 +167,9 @@ (!set-secondary-attribute #\f +char-attr-constituent-expt+) (!set-secondary-attribute #\d +char-attr-constituent-expt+) (!set-secondary-attribute #\s +char-attr-constituent-expt+) - (!set-secondary-attribute #\l +char-attr-constituent-expt+)) + (!set-secondary-attribute #\l +char-attr-constituent-expt+) + (!set-secondary-attribute (code-char 8) +char-attr-invalid+) + (!set-secondary-attribute (code-char 127) +char-attr-invalid+)) (defmacro get-secondary-attribute (char) `(elt *secondary-attribute-table* @@ -662,9 +664,11 @@ (aref ,attarray (char-code ,char)) (gethash ,char ,atthash +char-attr-constituent+)))) (declare (fixnum att)) - (if (<= att +char-attr-terminating-macro+) - +char-attr-delimiter+ - att))) + (cond + ((<= att +char-attr-terminating-macro+) +char-attr-delimiter+) + ((= att +char-attr-invalid+) + (%reader-error stream "invalid constituent")) + (t att)))) ;;; Return the character class for CHAR, which might be part of a ;;; rational number. @@ -673,13 +677,13 @@ (aref ,attarray (char-code ,char)) (gethash ,char ,atthash +char-attr-constituent+)))) (declare (fixnum att)) - (if (<= att +char-attr-terminating-macro+) - +char-attr-delimiter+ - (if (digit-char-p ,char *read-base*) - +char-attr-constituent-digit+ - (if (= att +char-attr-constituent-digit+) - +char-attr-constituent+ - att))))) + (cond + ((<= att +char-attr-terminating-macro+) +char-attr-delimiter+) + ((digit-char-p ,char *read-base*) +char-attr-constituent-digit+) + ((= att +char-attr-constituent-digit+) +char-attr-constituent+) + ((= att +char-attr-invalid+) + (%reader-error stream "invalid constituent")) + (t att)))) ;;; Return the character class for a char which might be part of a ;;; rational or floating number. (Assume that it is a digit if it @@ -689,23 +693,25 @@ (aref ,attarray (char-code ,char)) (gethash ,char ,atthash +char-attr-constituent+)))) (declare (fixnum att)) - (if possibly-rational - (setq possibly-rational - (or (digit-char-p ,char *read-base*) - (= att +char-attr-constituent-slash+)))) - (if possibly-float - (setq possibly-float - (or (digit-char-p ,char 10) - (= att +char-attr-constituent-dot+)))) - (if (<= att +char-attr-terminating-macro+) - +char-attr-delimiter+ - (if (digit-char-p ,char (max *read-base* 10)) - (if (digit-char-p ,char *read-base*) - (if (= att +char-attr-constituent-expt+) - +char-attr-constituent-digit-or-expt+ - +char-attr-constituent-digit+) - +char-attr-constituent-decimal-digit+) - att)))) + (when possibly-rational + (setq possibly-rational + (or (digit-char-p ,char *read-base*) + (= att +char-attr-constituent-slash+)))) + (when possibly-float + (setq possibly-float + (or (digit-char-p ,char 10) + (= att +char-attr-constituent-dot+)))) + (cond + ((<= att +char-attr-terminating-macro+) +char-attr-delimiter+) + ((digit-char-p ,char (max *read-base* 10)) + (if (digit-char-p ,char *read-base*) + (if (= att +char-attr-constituent-expt+) + +char-attr-constituent-digit-or-expt+ + +char-attr-constituent-digit+) + +char-attr-constituent-decimal-digit+)) + ((= att +char-attr-invalid+) + (%reader-error stream "invalid constituent")) + (t att)))) ;;;; token fetching @@ -799,6 +805,7 @@ (#.+char-attr-escape+ (go ESCAPE)) (#.+char-attr-package-delimiter+ (go COLON)) (#.+char-attr-multiple-escape+ (go MULT-ESCAPE)) + (#.+char-attr-invalid+ (%reader-error "invalid constituent")) ;; can't have eof, whitespace, or terminating macro as first char! (t (go SYMBOL))) SIGN ; saw "sign" diff --git a/src/code/readtable.lisp b/src/code/readtable.lisp index 250381e..5f712e4 100644 --- a/src/code/readtable.lisp +++ b/src/code/readtable.lisp @@ -16,6 +16,11 @@ ;;; constants for readtable character attributes. These are all as in ;;; the manual. +;;; +;;; FIXME: wait a minute. Firstly, I doubt they're in the manual. +;;; Secondly, the numerical order of these constants is coupled with +;;; code in CHAR-CLASS{,2,3} in the reader implementation, so beware +;;; when changing them. (def!constant +char-attr-whitespace+ 0) (def!constant +char-attr-terminating-macro+ 1) (def!constant +char-attr-escape+ 2) @@ -36,7 +41,8 @@ (def!constant +char-attr-multiple-escape+ 11) (def!constant +char-attr-package-delimiter+ 12) -(def!constant +char-attr-delimiter+ 13) ; (a fake for READ-UNQUALIFIED-TOKEN) +(def!constant +char-attr-invalid+ 13) +(def!constant +char-attr-delimiter+ 14) ; (a fake for READ-UNQUALIFIED-TOKEN) (sb!xc:defstruct (readtable (:conc-name nil) (:predicate readtablep) diff --git a/version.lisp-expr b/version.lisp-expr index a4f197f..4f91139 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".) -"0.8.18.31" +"0.8.18.32" -- 1.7.10.4