With Guile's default reader options, R6RS hex escape and EOL escape behavior is missing. This change enables the former via the `r6rs-hex-escapes' option, and gets us closer to the latter by setting `hungry-eol-escapes'.
* libguile/r6rs-ports.c (R6RS_READ_OPTION_MASK): New macro, defines which reader options need fixed values according to R6RS. (r6rs_read_options): New internal constant, defining the values of the relevant reader options. (scm_i_get_datum): New internal helper calling `scm_i_read' using the R6RS reader options. * module/rnrs/io/ports.scm (get-datum): Call `%get-datum' instead of `read'. * test-suite/tests/r6rs-ports.test ("8.2.9 Textual input")["get-datum"]: New tests. --- libguile/r6rs-ports.c | 29 ++++++++++++++++++++++++ module/rnrs/io/ports.scm | 2 +- test-suite/tests/r6rs-ports.test | 45 ++++++++++++++++++++++++++++++++++++++ 3 files changed, 75 insertions(+), 1 deletion(-) diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c index 19dea8d..973953a 100644 --- a/libguile/r6rs-ports.c +++ b/libguile/r6rs-ports.c @@ -174,6 +174,35 @@ SCM_DEFINE (scm_i_make_transcoded_port, } #undef FUNC_NAME +#define R6RS_READ_OPTION_MASK \ + ((1 << SCM_READ_OPTION_KEYWORD_STYLE) \ + | (1 << SCM_READ_OPTION_R6RS_ESCAPES_P) \ + | (1 << SCM_READ_OPTION_CASE_INSENSITIVE_P) \ + | (1 << SCM_READ_OPTION_SQUARE_BRACKETS_P) \ + | (1 << SCM_READ_OPTION_HUNGRY_EOL_ESCAPES_P)) + +static const scm_t_read_opts r6rs_read_options = { + SCM_KEYWORD_STYLE_HASH_PREFIX, + 0, /* copy_source_p, not relevant */ + 0, /* record_positions_p, not relevant */ + 0, /* case_insensitive_p */ + 1, /* r6rs_escapes_p */ + 1, /* square_brackets_p */ + 1, /* hungry_eol_escapes_p */ + 0, /* curly_infix_p, compatible extension */ + 0, /* neoteric_p, not relevant */ +}; + +SCM_DEFINE (scm_i_get_datum, + "%get-datum", 1, 0, 0, + (SCM port), + "Read a datum in R6RS syntax from @var{port}") +#define FUNC_NAME s_scm_i_get_datum +{ + return scm_i_read(port, &r6rs_read_options, R6RS_READ_OPTION_MASK); +} +#undef FUNC_NAME + /* Initialization. */ diff --git a/module/rnrs/io/ports.scm b/module/rnrs/io/ports.scm index ee8c05a..b2828cd 100644 --- a/module/rnrs/io/ports.scm +++ b/module/rnrs/io/ports.scm @@ -458,7 +458,7 @@ return the characters accumulated in that port." (with-textual-input-conditions port (read-char port))) (define (get-datum port) - (with-textual-input-conditions port (read port))) + (with-textual-input-conditions port (%get-datum port))) (define (get-line port) (with-textual-input-conditions port (read-line port 'trim))) diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test index ed49598..6a92987 100644 --- a/test-suite/tests/r6rs-ports.test +++ b/test-suite/tests/r6rs-ports.test @@ -707,6 +707,16 @@ (eq? (error-handling-mode replace) (transcoder-error-handling-mode t)))))) +;; FIXME: duplicated from reader.test +(define (with-read-options opts thunk) + (let ((saved-options (read-options))) + (dynamic-wind + (lambda () + (read-options opts)) + thunk + (lambda () + (read-options saved-options))))) + (with-test-prefix "8.2.9 Textual input" (pass-if "get-string-n [short]" @@ -724,6 +734,41 @@ (s (string-copy "Isn't XXX great?"))) (and (= 3 (get-string-n! port s 6 3)) (string=? s "Isn't GNU great?")))) + (with-test-prefix "get-datum" + (let ((string->datum + (lambda (s) + ;; We should check against all possible permutations of + ;; read options, but we just enable (and leave disabled) + ;; the ones that each would break R6RS individually. + (with-read-options '(keywords prefix case-insensitive hungry-eol-escapes) + (lambda () (get-datum (open-input-string s))))))) + (pass-if "symbol" + (eq? (string->datum "foo") 'foo)) + (pass-if "symbol [starting with colon]" + (eq? ':foo (string->datum ":foo"))) + (pass-if "symbol ending with colon" + (eq? 'foo: (string->datum "foo:"))) + (pass-if "string" + (string=? "foo" (string->datum "\"foo\""))) + (pass-if "string [with hex escapes]" + (string=? "bar\nA" (string->datum "\"bar\\x0A;\\x41;\""))) + (pass-if "string [hungry EOL]" + (string=? "bar baz" (string->datum "\"bar \\\n baz\""))) + ;; FIXME: actually, R6RS demands an even more hungry EOL escape + ;; than the reader currently implements: also any whitespace + ;; between the backslash and the newline should vanish. Currently, + ;; the reader barfs on that. + (pass-if "string [hungry EOL, space also before newline]" + (throw 'unresolved) + (string=? "bar baz" (string->datum "\"bar \\ \n baz\""))) + (pass-if "number [decimal]" + (= (string->datum "42") 42)) + (pass-if "number [hexadecimal]" + (= (string->datum "#x2A") 42)) + (pass-if "number [octal]" + (= (string->datum "#o0777") 511)) + (pass-if "number [binary]" + (= (string->datum "#b101010") 42)))) (with-test-prefix "read error" (pass-if-condition "get-char" i/o-read-error? -- 1.7.10.4