Fix read.scm bugs related to nonstandard reader options
authorAndy Wingo <wingo@pobox.com>
Wed, 17 Feb 2021 14:21:39 +0000 (15:21 +0100)
committerAndy Wingo <wingo@pobox.com>
Wed, 17 Feb 2021 14:24:34 +0000 (15:24 +0100)
* module/ice-9/read.scm (compute-reader-options): Fix handling of reader
  options, inline and otherwise.

module/ice-9/read.scm

index af9cfd2b2a49bfc6a41e48d22669a7de52d928f1..ae4f7455861a4f924c03e58e64f3a680a63a4d0f 100644 (file)
@@ -93,7 +93,7 @@
               (ash (assq-ref values (and=> (memq key options) cadr)) field)))
     (logior (bool 'positions bitfield:record-positions?)
             (bool 'case-insensitive bitfield:case-insensitive?)
-            (enum 'keyword-style '((#f . 0) (prefix . 1) (postfix . 2))
+            (enum 'keywords '((#f . 0) (prefix . 1) (postfix . 2))
                   bitfield:keyword-style)
             (bool 'r6rs-hex-escapes bitfield:r6rs-escapes?)
             (bool 'square-brackets bitfield:square-brackets?)
             (bool 'r7rs-symbols bitfield:r7rs-symbols?))))
 
 (define (set-option options field new)
-  (logior new (logand options (lognot (ash #b11 field)))))
+  (logior (ash new field) (logand options (lognot (ash #b11 field)))))
 
 (define (set-port-read-option! port field value)
-  (let ((options (or (%port-property port 'port-read-options)
-                     read-options-inherit-all))
-        (new (ash value field)))
-    (%set-port-property! port 'port-read-options
-                         (set-option options field new)
-                         )))
+  (%set-port-property! port 'port-read-options
+                       (set-option (or (%port-property port 'port-read-options)
+                                       read-options-inherit-all)
+                                   field value)))
 
 (define* (read #:optional (port (current-input-port)))
   ;; init read options
            (len (string-length str)))
       (cond
        ((and (eq? (keyword-style) keyword-style-postfix)
-             (> len 0) (eqv? #\: (string-ref str (1- len))))
+             (> len 1) (eqv? #\: (string-ref str (1- len))))
         (let ((str (substring str 0 (1- len))))
           (symbol->keyword
            (string->symbol
                       ;; Skip intraline whitespace before continuing.
                       (let lp ()
                         (let ((ch (peek)))
-                          (unless (or (eof-object? ch)
-                                      (eqv? ch #\tab)
-                                      (eq? (char-general-category ch) 'Zs))
+                          (when (and (not (eof-object? ch))
+                                     (or (eqv? ch #\tab)
+                                         (eq? (char-general-category ch) 'Zs)))
                             (next)
                             (lp))))))
                    ;; Accept "\(" for use at the beginning of