[PATCH 3/3] Make `get-datum' conform more closely to R6RS semantics

[Andreas Rottmann]

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