suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix symbol prining with #\uFEFF characters

Browse Source 
Since the reader now treats #\uFEFF as whitespace, adjust the printer to
escape \uFEFFa.

Thanks, Xsmith!

Writing an actual #\uFEFF character seems bad, even escaped, but
Racket's symbol syntax doesn't have a kind of escaping that uses
different characters than the one to be represented.

Closes #3486
This commit is contained in:
Matthew Flatt 2020-11-06 12:20:47 -07:00
parent 6b7a184297
commit 128174594e
4 changed files with 69 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
pkgs/racket-test-core/tests/racket/print.rktl
View File

@ -67,6 +67,7 @@
(ptest "'||" '||) (ptest "'||" '||)
(ptest "'|;|" '|;|) (ptest "'|;|" '|;|)
(ptest "'|`|" '|`|) (ptest "'|`|" '|`|)
(ptest "'|\uFEFF_|" (string->symbol "\uFEFF_"))
(ptest "'#:apple" '#:apple) (ptest "'#:apple" '#:apple)
(ptest "'#:|apple pie|" '#:|apple pie|) (ptest "'#:|apple pie|" '#:|apple pie|)
(ptest "'#:|.|" '#:|.|) (ptest "'#:|.|" '#:|.|)

3
racket/src/bc/src/symbol.c
View File

@ -659,7 +659,8 @@ const char *scheme_symbol_name_and_size(Scheme_Object *sym, uintptr_t *length, i
/* space is OK in type symbols */ /* space is OK in type symbols */
} else } else
has_space = 1; has_space = 1;
} else if (isSpecial(ch)) } else if (isSpecial(ch)
|| (ch == 0xFEFF)) /* BOM, treated as whitespace by the reader */
has_special = 1; has_special = 1;
else if (ch == '|') else if (ch == '|')
has_pipe = 1; has_pipe = 1;

124
racket/src/cs/schemified/io.scm
View File

@ -20908,94 +20908,100 @@
(if or-part_11 (if or-part_11
or-part_11 or-part_11
(let ((or-part_12 (let ((or-part_12
(if (char=? (char=?
ch_0 ch_0
'#\x7c) '#\xfeff)))
(let ((or-part_12
(not
config8_0)))
(if or-part_12
or-part_12
(config-get
config8_0
1/read-accept-bar-quote)))
#f)))
(if or-part_12 (if or-part_12
or-part_12 or-part_12
(let ((or-part_13 (let ((or-part_13
(if for-type?9_0 (if (char=?
ch_0
'#\x7c)
(let ((or-part_13 (let ((or-part_13
(char=? (not
ch_0 config8_0)))
'#\x3c)))
(if or-part_13 (if or-part_13
or-part_13 or-part_13
(char=? (config-get
ch_0 config8_0
'#\x3e))) 1/read-accept-bar-quote)))
#f))) #f)))
(if or-part_13 (if or-part_13
or-part_13 or-part_13
(let ((or-part_14 (let ((or-part_14
(if (char-whitespace? (if for-type?9_0
ch_0)
(let ((or-part_14 (let ((or-part_14
(not (char=?
for-type?9_0))) ch_0
'#\x3c)))
(if or-part_14 (if or-part_14
or-part_14 or-part_14
(not (char=?
(char=? ch_0
ch_0 '#\x3e)))
'#\x20))))
#f))) #f)))
(if or-part_14 (if or-part_14
or-part_14 or-part_14
(let ((or-part_15 (let ((or-part_15
(if (char=? (if (char-whitespace?
ch_0 ch_0)
'#\x23) (let ((or-part_15
(if (zero? (not
i_0) for-type?9_0)))
(let ((or-part_15 (if or-part_15
(< or-part_15
(string-length (not
str_0) (char=?
2))) ch_0
(if or-part_15 '#\x20))))
or-part_15
(not
(char=?
(string-ref
str_0
1)
'#\x25))))
#f)
#f))) #f)))
(if or-part_15 (if or-part_15
or-part_15 or-part_15
(let ((or-part_16 (let ((or-part_16
(if (char=? (if (char=?
ch_0 ch_0
'#\x2e) '#\x23)
(if (zero? (if (zero?
i_0) i_0)
(= (let ((or-part_16
(string-length (<
str_0) (string-length
1) str_0)
2)))
(if or-part_16
or-part_16
(not
(char=?
(string-ref
str_0
1)
'#\x25))))
#f) #f)
#f))) #f)))
(if or-part_16 (if or-part_16
or-part_16 or-part_16
(if (not (let ((or-part_17
case-sensitive?_0) (if (char=?
(not ch_0
(char=? '#\x2e)
ch_0 (if (zero?
(char-foldcase i_0)
ch_0))) (=
#f)))))))))))))))))))))))))))))))))))))))) (string-length
str_0)
1)
#f)
#f)))
(if or-part_17
or-part_17
(if (not
case-sensitive?_0)
(not
(char=?
ch_0
(char-foldcase
ch_0)))
#f))))))))))))))))))))))))))))))))))))))))))
(loop_0 (loop_0
(|#%name| (|#%name|
loop loop

1
racket/src/io/print/symbol.rkt
View File

@ -35,6 +35,7 @@
(char=? ch #\,) (char=? ch #\,)
(char=? ch #\;) (char=? ch #\;)
(char=? ch #\`) (char=? ch #\`)
(char=? ch #\uFEFF) ; BOM, treated as whitespace by the reader
(and (char=? ch #\|) (and (char=? ch #\|)
(or (not config) (config-get config read-accept-bar-quote))) (or (not config) (config-get config read-accept-bar-quote)))
(and for-type? (and for-type?