diff --git a/libguile/read.c b/libguile/read.c index a05a86d40..4b6828b8a 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -1230,7 +1230,7 @@ scm_read_extended_symbol (scm_t_wchar chr, SCM port) #{This is all a symbol name}# So here, CHR is expected to be `{'. */ - int saw_brace = 0, finished = 0; + int saw_brace = 0; size_t len = 0; SCM buf = scm_i_make_string (1024, NULL, 0); @@ -1242,20 +1242,57 @@ scm_read_extended_symbol (scm_t_wchar chr, SCM port) { if (chr == '#') { - finished = 1; break; } else { saw_brace = 0; scm_i_string_set_x (buf, len++, '}'); - scm_i_string_set_x (buf, len++, chr); } } - else if (chr == '}') + + if (chr == '}') saw_brace = 1; + else if (chr == '\\') + { + /* It used to be that print.c would print extended-read-syntax + symbols with backslashes before "non-standard" chars, but + this routine wouldn't do anything with those escapes. + Bummer. What we've done is to change print.c to output + R6RS hex escapes for those characters, relying on the fact + that the extended read syntax would never put a `\' before + an `x'. For now, we just ignore other instances of + backslash in the string. */ + switch ((chr = scm_getc (port))) + { + case EOF: + goto done; + case 'x': + { + scm_t_wchar c; + + SCM_READ_HEX_ESCAPE (10, ';'); + scm_i_string_set_x (buf, len++, c); + break; + + str_eof: + chr = EOF; + goto done; + + bad_escaped: + scm_i_string_stop_writing (); + scm_i_input_error ("scm_read_extended_symbol", port, + "illegal character in escape sequence: ~S", + scm_list_1 (SCM_MAKE_CHAR (c))); + break; + } + default: + scm_i_string_set_x (buf, len++, chr); + break; + } + } else - scm_i_string_set_x (buf, len++, chr); + scm_i_string_set_x (buf, len++, chr); if (len >= scm_i_string_length (buf) - 2) { @@ -1267,11 +1304,13 @@ scm_read_extended_symbol (scm_t_wchar chr, SCM port) len = 0; buf = scm_i_string_start_writing (buf); } - - if (finished) - break; } + + done: scm_i_string_stop_writing (); + if (chr == EOF) + scm_i_input_error ("scm_read_extended_symbol", port, + "end of file while reading symbol", SCM_EOL); return (scm_string_to_symbol (scm_c_substring (buf, 0, len))); } diff --git a/test-suite/tests/reader.test b/test-suite/tests/reader.test index 1d6cc41ff..7027d3255 100644 --- a/test-suite/tests/reader.test +++ b/test-suite/tests/reader.test @@ -36,6 +36,8 @@ (cons 'read-error "Unknown # object: .*$")) (define exception:eof-in-string (cons 'read-error "end of file in string constant$")) +(define exception:eof-in-symbol + (cons 'read-error "end of file while reading symbol$")) (define exception:illegal-escape (cons 'read-error "illegal character in escape sequence: .*$")) (define exception:missing-expression @@ -424,6 +426,16 @@ ("#,foo" . (unsyntax foo)) ("#,@foo" . (unsyntax-splicing foo))))) +(with-test-prefix "#{}#" + (pass-if (equal? (read-string "#{}#") '#{}#)) + (pass-if (equal? (read-string "#{a}#") 'a)) + (pass-if (equal? (read-string "#{a b}#") '#{a b}#)) + (begin-deprecated + (pass-if (equal? (read-string "#{a\\ b}#") '#{a b}#))) + (pass-if-exception "#{" exception:eof-in-symbol + (read-string "#{")) + (pass-if (equal? (read-string "#{a\\x20;b}#") '#{a b}#))) + ;;; Local Variables: ;;; eval: (put 'with-read-options 'scheme-indent-function 1)