0.8.10.49:
authorChristophe Rhodes <csr21@cam.ac.uk>
Mon, 24 May 2004 11:41:23 +0000 (11:41 +0000)
committerChristophe Rhodes <csr21@cam.ac.uk>
Mon, 24 May 2004 11:41:23 +0000 (11:41 +0000)
Fix #S reader bug regarding coercion of slot names to keyword
arguments (Kalle Niemitalo sbcl-devel 2004-05-23)

NEWS
src/code/sharpm.lisp
tests/reader.impure.lisp
version.lisp-expr

diff --git a/NEWS b/NEWS
index c591c77..e014912 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -2453,6 +2453,8 @@ changes in sbcl-0.8.11 relative to sbcl-0.8.10:
   * fixed bugs 280 and 312: the checking for multiple definitions in a
     file is less likely to become confused by uses of inline
     functions.
+  * fixed bug: the #S reader macro performs the keyword coercion
+    specified for slot names.  (reported by Kalle Niemitalo)
   * optimization: rearranged the expansion of various defining macros
     so that each expands into only one top-level form in a
     :LOAD-TOPLEVEL context; this appears to decrease fasl sizes by
index 6615bb9..6bae634 100644 (file)
          (%reader-error
           stream "The ~S structure does not have a default constructor."
           (car body)))
-       (apply (fdefinition def-con) (rest body))))))
+       (when (and (atom (rest body))
+                  (not (null (rest body))))
+         (%reader-error
+          stream "improper list for #S: ~S." body))
+       (apply (fdefinition def-con)
+              (loop for tail on (rest body) by #'cddr
+                    with slot-name = (and (consp tail) (car tail))
+                    do (progn
+                         (when (null (cdr tail))
+                           (%reader-error
+                            stream
+                            "the arglist for the ~S constructor in #S ~
+                              has an odd length: ~S."
+                            (car body) (rest body)))
+                         (when (or (atom (cdr tail))
+                                   (and (atom (cddr tail))
+                                        (not (null (cddr tail)))))
+                           (%reader-error
+                            stream
+                            "the arglist for the ~S constructor in #S ~
+                              is improper: ~S."
+                            (car body) (rest body)))
+                         (when (not (typep (car tail) 'string-designator))
+                           (%reader-error
+                            stream
+                            "a slot name in #S is not a string ~
+                              designator: ~S."
+                            slot-name))
+                         (when (not (keywordp slot-name))
+                           (style-warn "in #S ~S, the use of non-keywords ~
+                                         as slot specifiers is deprecated: ~S."
+                                       (car body) slot-name)))
+                    collect (intern (string (car tail)) *keyword-package*)
+                    collect (cadr tail)))))))
 \f
 ;;;; reading numbers: the #B, #C, #O, #R, and #X readmacros
 
index b71a2ee..46be9f9 100644 (file)
 ;;; CSR managed to break the #S reader macro in the process of merging
 ;;; SB-PCL:CLASS and CL:CLASS -- make sure it works
 (defstruct readable-struct a)
-(assert (eq (readable-struct-a
-            (read-from-string "#S(READABLE-STRUCT :A T)"))
-           t))
+(macrolet
+    ((frob (string)
+       `(assert (eq (readable-struct-a (read-from-string ,string)) t))))
+  (frob "#S(READABLE-STRUCT :A T)")
+  (frob "#S(READABLE-STRUCT A T)")
+  (frob "#S(READABLE-STRUCT \"A\" T)")
+  (frob "#S(READABLE-STRUCT #\\A T)")
+  (frob "#S(READABLE-STRUCT #\\A T :A NIL)"))
+(macrolet
+    ((frob (string)
+       `(assert (raises-error? (read-from-string ,string) reader-error))))
+  (frob "#S(READABLE-STRUCT . :A)")
+  (frob "#S(READABLE-STRUCT :A . T)")
+  (frob "#S(READABLE-STRUCT :A T . :A)")
+  (frob "#S(READABLE-STRUCT :A T :A . T)"))
 
 ;;; reported by Henrik Motakef
 (defpackage "")
index 9cb7aeb..488ac76 100644 (file)
@@ -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.10.48"
+"0.8.10.49"