mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 12:20:26 +02:00
Code Activity

Fix read.scm bugs related to nonstandard reader options

Browse source 
* module/ice-9/read.scm (compute-reader-options): Fix handling of reader
  options, inline and otherwise.
This commit is contained in:
Andy Wingo 2021-02-17 15:21:39 +01:00
parent 6353b448cc
commit 7244461a11
1 changed files with 10 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

20
module/ice-9/read.scm
View file

@ -93,7 +93,7 @@
(ash (assq-ref values (and=> (memq key options) cadr)) field))) (ash (assq-ref values (and=> (memq key options) cadr)) field)))
(logior (bool 'positions bitfield:record-positions?) (logior (bool 'positions bitfield:record-positions?)
(bool 'case-insensitive bitfield:case-insensitive?) (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) bitfield:keyword-style)
(bool 'r6rs-hex-escapes bitfield:r6rs-escapes?) (bool 'r6rs-hex-escapes bitfield:r6rs-escapes?)
(bool 'square-brackets bitfield:square-brackets?) (bool 'square-brackets bitfield:square-brackets?)
@ -102,15 +102,13 @@
(bool 'r7rs-symbols bitfield:r7rs-symbols?)))) (bool 'r7rs-symbols bitfield:r7rs-symbols?))))
(define (set-option options field new) (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) (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-port-property! port 'port-read-options
(set-option options field new) (set-option (or (%port-property port 'port-read-options)
))) read-options-inherit-all)
field value)))
(define* (read #:optional (port (current-input-port))) (define* (read #:optional (port (current-input-port)))
;; init read options ;; init read options
@ -208,7 +206,7 @@
(len (string-length str))) (len (string-length str)))
(cond (cond
((and (eq? (keyword-style) keyword-style-postfix) ((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)))) (let ((str (substring str 0 (1- len))))
(symbol->keyword (symbol->keyword
(string->symbol (string->symbol
@ -325,9 +323,9 @@
;; Skip intraline whitespace before continuing. ;; Skip intraline whitespace before continuing.
(let lp () (let lp ()
(let ((ch (peek))) (let ((ch (peek)))
(unless (or (eof-object? ch) (when (and (not (eof-object? ch))
(eqv? ch #\tab) (or (eqv? ch #\tab)
(eq? (char-general-category ch) 'Zs)) (eq? (char-general-category ch) 'Zs)))
(next) (next)
(lp)))))) (lp))))))
;; Accept "\(" for use at the beginning of ;; Accept "\(" for use at the beginning of