[PATCH] Fix `get-string-n!' &i/o-decoding exception behavior

[PATCH] Fix `get-string-n!' &i/o-decoding exception behavior

[Andreas Rottmann]

Previously, `get-string-n!' from `(rnrs io ports)' would not throw the
exception required by R6RS, and could not easily do so due to being
implemented entirely in C.

This change fixes this by introducing a corresponding internal C
function reporting errors by return value and reimplementing the
`get-string-n!' in Scheme on top of that.  Along with `get-string-n!',
`get-string-n' gets fixed, inheriting the correct behavior.

* libguile/ports.c (scm_i_getc): New function, a version of `scm_getc'
  not using exceptions.
  (scm_getc): Implemented using `scm_i_getc'.
* libguile/ports.h (scm_i_getc): Add prototype marked SCM_INTERNAL.

* libguile/r6rs-ports.c (scm_i_get_string_n_x): Exception-free version
  of `get-string-n!', making use of `scm_i_getc'.
  (scm_get_string_n_x): Removed, now implemented in Scheme.

* module/ice-9/binary-ports.scm (get-string-n!): Removed from export
  list, it doesn't fit the module module purpose anyway.
* module/rnrs/io/ports.scm (%get-string-n): Newly defined by internal
  reference to `(ice-9 binary-ports)'.
  (get-string-n!): Implemented in Scheme on top of `%get-string-n!'.

* test-suite/tests/r6rs-ports.test ("8.2.9 Textual
  input")["read-error"]: Activate commented-out exception-behavior tests
  of `get-string-n!'.
  ["decoding error"]: New test prefix with tests for `get-char',
  `get-string-n!' and `get-string-n' and `get-line'.
---
 libguile/ports.c                 |   20 ++++++++++++++++----
 libguile/ports.h                 |    1 +
 libguile/r6rs-ports.c            |   21 +++++++++++----------
 module/ice-9/binary-ports.scm    |    6 +++---
 module/rnrs/io/ports.scm         |   14 ++++++++++++++
 test-suite/tests/r6rs-ports.test |   24 ++++++++++++++++++++----
 6 files changed, 65 insertions(+), 21 deletions(-)

diff --git a/libguile/ports.c b/libguile/ports.c
index 55808e2..b653af4 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -1392,12 +1392,10 @@ scm_t_wchar
 scm_getc (SCM port)
 #define FUNC_NAME "scm_getc"
 {
-  int err;
-  size_t len;
+  int err = 0;
   scm_t_wchar codepoint;
-  char buf[SCM_MBCHAR_BUF_SIZE];
 
-  err = get_codepoint (port, &codepoint, buf, &len);
+  codepoint = scm_i_getc (port, &err);
   if (SCM_UNLIKELY (err != 0))
     /* At this point PORT should point past the invalid encoding, as per
        R6RS-lib Section 8.2.4.  */
@@ -1407,6 +1405,20 @@ scm_getc (SCM port)
 }
 #undef FUNC_NAME
 
+/* Read a codepoint from PORT and return it.  This version reports
+   errors via the ERROR argument instead of via exceptions. */
+scm_t_wchar
+scm_i_getc (SCM port, int *error)
+{
+  size_t len;
+  scm_t_wchar codepoint;
+  char buf[SCM_MBCHAR_BUF_SIZE];
+
+  *error = get_codepoint (port, &codepoint, buf, &len);
+
+  return codepoint;
+}
+
 /* this should only be called when the read buffer is empty.  it
    tries to refill the read buffer.  it returns the first char from
    the port, which is either EOF or *(pt->read_pos).  */
diff --git a/libguile/ports.h b/libguile/ports.h
index d4d59b7..2f70056 100644
--- a/libguile/ports.h
+++ b/libguile/ports.h
@@ -281,6 +281,7 @@ SCM_API SCM scm_force_output (SCM port);
 SCM_API SCM scm_flush_all_ports (void);
 SCM_API SCM scm_read_char (SCM port);
 SCM_API scm_t_wchar scm_getc (SCM port);
+SCM_INTERNAL scm_t_wchar scm_i_getc (SCM port, int *error);
 SCM_API size_t scm_c_read (SCM port, void *buffer, size_t size);
 SCM_API void scm_c_write (SCM port, const void *buffer, size_t size);
 SCM_API void scm_lfwrite (const char *ptr, size_t size, SCM port);
diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c
index e867429..bd10081 100644
--- a/libguile/r6rs-ports.c
+++ b/libguile/r6rs-ports.c
@@ -1242,18 +1242,17 @@ SCM_DEFINE (scm_i_make_transcoded_port,
 \f
 /* Textual I/O */
 
-SCM_DEFINE (scm_get_string_n_x,
-            "get-string-n!", 4, 0, 0,
+SCM_DEFINE (scm_i_get_string_n_x,
+            "%get-string-n!", 4, 0, 0,
             (SCM port, SCM str, SCM start, SCM count),
-            "Read up to @var{count} characters from @var{port} into "
-            "@var{str}, starting at @var{start}.  If no characters "
-            "can be read before the end of file is encountered, the end "
-            "of file object is returned.  Otherwise, the number of "
-            "characters read is returned.")
-#define FUNC_NAME s_scm_get_string_n_x
+            "Read up to @var{count} characters from @var{port} into @var{str}, "
+            "starting at @var{start}. Returns the end of file object, a list "
+            "containing an errno value, or the number of characters read.")
+#define FUNC_NAME s_scm_i_get_string_n_x
 {
   size_t c_start, c_count, c_len, c_end, j;
   scm_t_wchar c;
+  int err;
 
   SCM_VALIDATE_OPINPORT (1, port);
   SCM_VALIDATE_STRING (2, str);
@@ -1267,8 +1266,10 @@ SCM_DEFINE (scm_get_string_n_x,
 
   for (j = c_start; j < c_end; j++)
     {
-      c = scm_getc (port);
-      if (c == EOF)
+      c = scm_i_getc (port, &err);
+      if (SCM_UNLIKELY (err != 0))
+        return scm_list_1 (scm_from_int (err));
+      else if (SCM_UNLIKELY (c == EOF))
         {
           size_t chars_read = j - c_start;
           return chars_read == 0 ? SCM_EOF_VAL : scm_from_size_t (chars_read);
diff --git a/module/ice-9/binary-ports.scm b/module/ice-9/binary-ports.scm
index c07900b..3f7b9e6 100644
--- a/module/ice-9/binary-ports.scm
+++ b/module/ice-9/binary-ports.scm
@@ -37,14 +37,14 @@
             get-bytevector-n!
             get-bytevector-some
             get-bytevector-all
-            get-string-n!
             put-u8
             put-bytevector
             open-bytevector-output-port
             make-custom-binary-output-port))
 
-;; Note that this extension also defines %make-transcoded-port, which is
-;; not exported but is used by (rnrs io ports).
+;; Note that this extension also defines `%make-transcoded-port' and
+;; `%get-string-n!', which are not exported but used by `(rnrs io
+;; ports)'.
 
 (load-extension (string-append "libguile-" (effective-version))
                 "scm_init_r6rs_ports")
diff --git a/module/rnrs/io/ports.scm b/module/rnrs/io/ports.scm
index fddb491..fb8c795 100644
--- a/module/rnrs/io/ports.scm
+++ b/module/rnrs/io/ports.scm
@@ -445,6 +445,20 @@ return the characters accumulated in that port."
 (define (get-string-all port)
   (with-textual-input-conditions port (read-delimited "" port 'concat)))
 
+(define %get-string-n! (@@ (ice-9 binary-ports) %get-string-n!))
+
+(define (get-string-n! port str start count)
+  "Read up to @var{count} characters from @var{port} into @var{str},
+starting at @var{start}.  If no characters can be read before the end of
+file is encountered, the end of file object is returned.  Otherwise, the
+number of characters read is returned."
+  (with-i/o-port-error port make-i/o-read-error
+    (lambda ()
+      (let ((result (%get-string-n! port str start count)))
+        (if (pair? result)
+            (raise (make-i/o-decoding-error port))
+            result)))))
+
 (define (get-string-n port count)
   "Read up to @var{count} characters from @var{port}.
 If no characters could be read before encountering the end of file,
diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test
index 46da67f..b1d0f25 100644
--- a/test-suite/tests/r6rs-ports.test
+++ b/test-suite/tests/r6rs-ports.test
@@ -633,6 +633,16 @@
       (binary-port? (standard-error-port)))))
 
 \f
+;; Create a textual input port in UTF-8 encoding reading from a byte
+;; vector containing an invalid UTF-8 sequence. Thus any read from that
+;; port should result in an &i/o-decoding-error condition being raised.
+(define (make-invalid-utf8-port)
+  (transcoded-port
+   (open-bytevector-input-port '#vu8(#xFE #xFF))
+   (make-transcoder (utf-8-codec)
+                    (native-eol-style)
+                    (error-handling-mode raise))))
+
 (with-test-prefix "8.2.6  Input and output ports"
 
   (pass-if "transcoded-port [output]"
@@ -724,19 +734,25 @@
       (get-char (make-failing-port)))
     (pass-if-condition "lookahead-char" i/o-read-error?
       (lookahead-char (make-failing-port)))
-    ;; FIXME: these are not yet exception-correct
-    #|
     (pass-if-condition "get-string-n" i/o-read-error?
       (get-string-n (make-failing-port) 5))
     (pass-if-condition "get-string-n!" i/o-read-error?
       (get-string-n! (make-failing-port) (make-string 5) 0 5))
-    |#
     (pass-if-condition "get-string-all" i/o-read-error?
       (get-string-all (make-failing-port 100)))
     (pass-if-condition "get-line" i/o-read-error?
       (get-line (make-failing-port)))
     (pass-if-condition "get-datum" i/o-read-error?
-      (get-datum (make-failing-port)))))
+      (get-datum (make-failing-port))))
+  (with-test-prefix "decoding error"
+    (pass-if-condition "get-char" i/o-decoding-error?
+      (get-char (make-invalid-utf8-port)))
+    (pass-if-condition "get-string-n" i/o-decoding-error?
+      (get-string-n (make-invalid-utf8-port) 2))
+    (pass-if-condition "get-string-n!" i/o-decoding-error?
+      (get-string-n! (make-invalid-utf8-port) (make-string 5) 0 5))
+    (pass-if-condition "get-line" i/o-decoding-error?
+      (get-line (make-invalid-utf8-port)))))
 
 (define (encoding-error-predicate char)
   (lambda (c)
-- 
1.7.10.4

Re: [PATCH] Fix `get-string-n!' &i/o-decoding exception behavior

[Mark H Weaver]

Hi Andreas,

Thanks for the patch.  See below for my comments.

Andreas Rottmann <a.rottmann@gmx.at> writes:

> Previously, `get-string-n!' from `(rnrs io ports)' would not throw the
> exception required by R6RS, and could not easily do so due to being
> implemented entirely in C.
>
> This change fixes this by introducing a corresponding internal C
> function reporting errors by return value and reimplementing the
> `get-string-n!' in Scheme on top of that.  Along with `get-string-n!',
> `get-string-n' gets fixed, inheriting the correct behavior.
>
> * libguile/ports.c (scm_i_getc): New function, a version of `scm_getc'
>   not using exceptions.
>   (scm_getc): Implemented using `scm_i_getc'.
> * libguile/ports.h (scm_i_getc): Add prototype marked SCM_INTERNAL.
>
> * libguile/r6rs-ports.c (scm_i_get_string_n_x): Exception-free version
>   of `get-string-n!', making use of `scm_i_getc'.
>   (scm_get_string_n_x): Removed, now implemented in Scheme.
>
> * module/ice-9/binary-ports.scm (get-string-n!): Removed from export
>   list, it doesn't fit the module module purpose anyway.
> * module/rnrs/io/ports.scm (%get-string-n): Newly defined by internal
>   reference to `(ice-9 binary-ports)'.
>   (get-string-n!): Implemented in Scheme on top of `%get-string-n!'.
>
> * test-suite/tests/r6rs-ports.test ("8.2.9 Textual
>   input")["read-error"]: Activate commented-out exception-behavior tests
>   of `get-string-n!'.
>   ["decoding error"]: New test prefix with tests for `get-char',
>   `get-string-n!' and `get-string-n' and `get-line'.
> ---
>  libguile/ports.c                 |   20 ++++++++++++++++----
>  libguile/ports.h                 |    1 +
>  libguile/r6rs-ports.c            |   21 +++++++++++----------
>  module/ice-9/binary-ports.scm    |    6 +++---
>  module/rnrs/io/ports.scm         |   14 ++++++++++++++
>  test-suite/tests/r6rs-ports.test |   24 ++++++++++++++++++++----
>  6 files changed, 65 insertions(+), 21 deletions(-)
>
> diff --git a/libguile/ports.c b/libguile/ports.c
> index 55808e2..b653af4 100644
> --- a/libguile/ports.c
> +++ b/libguile/ports.c
> @@ -1392,12 +1392,10 @@ scm_t_wchar
>  scm_getc (SCM port)
>  #define FUNC_NAME "scm_getc"
>  {
> -  int err;
> -  size_t len;
> +  int err = 0;
>    scm_t_wchar codepoint;
> -  char buf[SCM_MBCHAR_BUF_SIZE];
>  
> -  err = get_codepoint (port, &codepoint, buf, &len);
> +  codepoint = scm_i_getc (port, &err);
>    if (SCM_UNLIKELY (err != 0))
>      /* At this point PORT should point past the invalid encoding, as per
>         R6RS-lib Section 8.2.4.  */
> @@ -1407,6 +1405,20 @@ scm_getc (SCM port)
>  }
>  #undef FUNC_NAME
>  
> +/* Read a codepoint from PORT and return it.  This version reports
> +   errors via the ERROR argument instead of via exceptions. */
> +scm_t_wchar
> +scm_i_getc (SCM port, int *error)
> +{
> +  size_t len;
> +  scm_t_wchar codepoint;
> +  char buf[SCM_MBCHAR_BUF_SIZE];
> +
> +  *error = get_codepoint (port, &codepoint, buf, &len);
> +
> +  return codepoint;
> +}

Given how trivial 'scm_i_getc' is, I think I'd prefer to leave
'scm_getc' alone, to avoid the additional overhead of another non-static
C function call, which has to be done via the procedure linkage table
(PLT) when libguile is a shared library and is thus not entirely
trivial.

> diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c
> index e867429..bd10081 100644
> --- a/libguile/r6rs-ports.c
> +++ b/libguile/r6rs-ports.c
> @@ -1242,18 +1242,17 @@ SCM_DEFINE (scm_i_make_transcoded_port,
>  \f
>  /* Textual I/O */
>  
> -SCM_DEFINE (scm_get_string_n_x,
> -            "get-string-n!", 4, 0, 0,
> +SCM_DEFINE (scm_i_get_string_n_x,
> +            "%get-string-n!", 4, 0, 0,

I'm a little bit nervous about this.  Although it is not documented in
the manual, 'scm_get_string_n_x' is declared in r6rs-ports.h as SCM_API.
I'm not sure it's safe to make that go away.

Why not leave the API as-is, and in the event of an error, just raise
the proper R6RS exception from within 'scm_get_string_n_x'?

> diff --git a/module/ice-9/binary-ports.scm b/module/ice-9/binary-ports.scm
> index c07900b..3f7b9e6 100644
> --- a/module/ice-9/binary-ports.scm
> +++ b/module/ice-9/binary-ports.scm
> @@ -37,14 +37,14 @@
>              get-bytevector-n!
>              get-bytevector-some
>              get-bytevector-all
> -            get-string-n!

Users may have come to rely on this export from (ice-9 binary-ports).
I don't think it's safe to remove it.

    Regards,
      Mark

Re: [PATCH] Fix `get-string-n!' &i/o-decoding exception behavior

[Andreas Rottmann]

Mark H Weaver <mhw@netris.org> writes:

> Hi Andreas,
>
> Thanks for the patch.  See below for my comments.
>
> Andreas Rottmann <a.rottmann@gmx.at> writes:
>
>> diff --git a/libguile/ports.c b/libguile/ports.c
>> index 55808e2..b653af4 100644
>> --- a/libguile/ports.c
>> +++ b/libguile/ports.c
>> @@ -1392,12 +1392,10 @@ scm_t_wchar
>>  scm_getc (SCM port)
>>  #define FUNC_NAME "scm_getc"
>>  {
>> -  int err;
>> -  size_t len;
>> +  int err = 0;
>>    scm_t_wchar codepoint;
>> -  char buf[SCM_MBCHAR_BUF_SIZE];
>>  
>> -  err = get_codepoint (port, &codepoint, buf, &len);
>> +  codepoint = scm_i_getc (port, &err);
>>    if (SCM_UNLIKELY (err != 0))
>>      /* At this point PORT should point past the invalid encoding, as per
>>         R6RS-lib Section 8.2.4.  */
>> @@ -1407,6 +1405,20 @@ scm_getc (SCM port)
>>  }
>>  #undef FUNC_NAME
>>  
>> +/* Read a codepoint from PORT and return it.  This version reports
>> +   errors via the ERROR argument instead of via exceptions. */
>> +scm_t_wchar
>> +scm_i_getc (SCM port, int *error)
>> +{
>> +  size_t len;
>> +  scm_t_wchar codepoint;
>> +  char buf[SCM_MBCHAR_BUF_SIZE];
>> +
>> +  *error = get_codepoint (port, &codepoint, buf, &len);
>> +
>> +  return codepoint;
>> +}
>
> Given how trivial 'scm_i_getc' is, I think I'd prefer to leave
> 'scm_getc' alone, to avoid the additional overhead of another non-static
> C function call, which has to be done via the procedure linkage table
> (PLT) when libguile is a shared library and is thus not entirely
> trivial.
>
Yup, that's fine with me.

>> diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c
>> index e867429..bd10081 100644
>> --- a/libguile/r6rs-ports.c
>> +++ b/libguile/r6rs-ports.c
>> @@ -1242,18 +1242,17 @@ SCM_DEFINE (scm_i_make_transcoded_port,
>>  \f
>>  /* Textual I/O */
>>  
>> -SCM_DEFINE (scm_get_string_n_x,
>> -            "get-string-n!", 4, 0, 0,
>> +SCM_DEFINE (scm_i_get_string_n_x,
>> +            "%get-string-n!", 4, 0, 0,
>
> I'm a little bit nervous about this.  Although it is not documented in
> the manual, 'scm_get_string_n_x' is declared in r6rs-ports.h as SCM_API.
> I'm not sure it's safe to make that go away.
>
Oh, I missed that one; thanks.

> Why not leave the API as-is, and in the event of an error, just raise
> the proper R6RS exception from within 'scm_get_string_n_x'?
>
The problem here is that we have no easy way to raise R6RS exceptions
from C code, AFAICT.  It is certainly possible, but if it involves
convoluted code of doing imports of condition types and appropriate
constructors, then constructing a proper invocation, all in C, I'd
rather avoid it.  I think the tendency (in general, also in Guile's
implementation) was to do more things in Scheme, and less in C.

However, exceptions are a difficult topic; if we want efficient
(i.e. ones not requiring setting up exception converters on each call)
implementations of R6RS I/O procedures eventually, we'd either

(a) need to expose exception-less primitives (like I attempted with
    scm_i_get_c and scm_i_get_string_n_x), and use those to implement
    the actual exception-throwing procedures in Scheme, or

(b) if you really want this done (or doable) fully in C, I think we'd
    first provide an API (at least an internal one), to make it possible
    to easily raise R6RS conditions from C.

In that sense, it's unfortunate that r6rs-ports.h is public API at all,
since it effectively prevents us from using strategy (a), at least
without going through a deprecation phase. These functions are now all
broken wrt. exceptions -- do we want to fix this at the C level as well,
or rather deprecate them, and DTRT (only) for their Scheme counterparts?

>> diff --git a/module/ice-9/binary-ports.scm b/module/ice-9/binary-ports.scm
>> index c07900b..3f7b9e6 100644
>> --- a/module/ice-9/binary-ports.scm
>> +++ b/module/ice-9/binary-ports.scm
>> @@ -37,14 +37,14 @@
>>              get-bytevector-n!
>>              get-bytevector-some
>>              get-bytevector-all
>> -            get-string-n!
>
> Users may have come to rely on this export from (ice-9 binary-ports).
> I don't think it's safe to remove it.
>
Hmm, yeah, that has bothered me a bit as well, but I forgot to
explicitly point it out making the patch potentially unsuitable for
stable.  Nevertheless, having textual I/O procedures in `(ice-9
binary-ports)' seems quite a bit strange; maybe leave it there (for
stable-2.0) but mark that binding as deprecated -- if users want R6RS
textual I/O, they know where to find it ;-). 

Also, I'm not sure if procedures in `(ice-9 ...)' can be expected to be
throw R6RS conditions at all...

Regards, Rotty
-- 
Andreas Rottmann -- <http://rotty.xx.vu/>

Re: [PATCH] Fix `get-string-n!' &i/o-decoding exception behavior

[Mark H Weaver]

Andreas Rottmann <a.rottmann@gmx.at> writes:

> Mark H Weaver <mhw@netris.org> writes:
>
>> Why not leave the API as-is, and in the event of an error, just raise
>> the proper R6RS exception from within 'scm_get_string_n_x'?
>>
> The problem here is that we have no easy way to raise R6RS exceptions
> from C code, AFAICT.  It is certainly possible, but if it involves
> convoluted code of doing imports of condition types and appropriate
> constructors, then constructing a proper invocation, all in C, I'd
> rather avoid it.

It's not that bad.  In Guile 2.0 we have some convenient procedures for
accessing arbitrary Scheme variables from C.

Looking at your patch, I see that if '%get-string-n!' returned an error,
then you did:

  (raise (make-i/o-decoding-error port))

This can be written in C as follows:

  scm_call_1 (scm_c_public_ref ("rnrs exceptions", "raise"),
              scm_call_1 (scm_c_public_ref ("rnrs io ports",
                                            "make-i/o-decoding-error")));

Alternatively, you could write one or more private helper procedures in
Scheme to raise R6RS exceptions, and call those private helpers from C
using 'scm_c_private_ref' instead of 'scm_c_public_ref'.

What do you think?

   Regards,
     Mark

Re: [PATCH] Fix `get-string-n!' &i/o-decoding exception behavior

[Mark H Weaver]

I wrote:
>   (raise (make-i/o-decoding-error port))
>
> This can be written in C as follows:
>
>   scm_call_1 (scm_c_public_ref ("rnrs exceptions", "raise"),
>               scm_call_1 (scm_c_public_ref ("rnrs io ports",
>                                             "make-i/o-decoding-error")));

Sorry, I forgot to pass 'port'.  It should be:

   scm_call_1 (scm_c_public_ref ("rnrs exceptions", "raise"),
               scm_call_1 (scm_c_public_ref ("rnrs io ports",
                                             "make-i/o-decoding-error"),
                           port));

       Mark

Re: [PATCH] Fix `get-string-n!' &i/o-decoding exception behavior

[Andreas Rottmann]

Mark H Weaver <mhw@netris.org> writes:

> Andreas Rottmann <a.rottmann@gmx.at> writes:
>
>> Mark H Weaver <mhw@netris.org> writes:
>>
>>> Why not leave the API as-is, and in the event of an error, just raise
>>> the proper R6RS exception from within 'scm_get_string_n_x'?
>>>
>> The problem here is that we have no easy way to raise R6RS exceptions
>> from C code, AFAICT.  It is certainly possible, but if it involves
>> convoluted code of doing imports of condition types and appropriate
>> constructors, then constructing a proper invocation, all in C, I'd
>> rather avoid it.
>
> It's not that bad.  In Guile 2.0 we have some convenient procedures for
> accessing arbitrary Scheme variables from C.
>
> Looking at your patch, I see that if '%get-string-n!' returned an error,
> then you did:
>
>   (raise (make-i/o-decoding-error port))
>
> This can be written in C as follows:
>
>   scm_call_1 (scm_c_public_ref ("rnrs exceptions", "raise"),
>               scm_call_1 (scm_c_public_ref ("rnrs io ports",
>                                             "make-i/o-decoding-error")));
>
> Alternatively, you could write one or more private helper procedures in
> Scheme to raise R6RS exceptions, and call those private helpers from C
> using 'scm_c_private_ref' instead of 'scm_c_public_ref'.
>
> What do you think?
>
OK, I'll give this approach a try; I suspect it will indeed result in
the least churn.

Regards, Rotty
-- 
Andreas Rottmann -- <http://rotty.xx.vu/>