[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.9-144-gc9d55a7

[Ludovic Courtès]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=c9d55a7e4ec079a735af40df6e652db5585e6826

The branch, stable-2.0 has been updated
       via  c9d55a7e4ec079a735af40df6e652db5585e6826 (commit)
      from  7af706e36ee5c866edc5c0749cf0f49d7531bba0 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit c9d55a7e4ec079a735af40df6e652db5585e6826
Author: Ludovic Courtès <address@hidden>
Date:   Mon Jan 13 23:15:28 2014 +0100

    'port-position' works on CBIPs that do not support 'set-port-position!'.
    
    * libguile/r6rs-ports.c (cbp_seek)[WHENCE == SEEK_CUR]: Break out of the
      switch statement when OFFSET is zero.
      Pass 'scm_wrong_type_arg_msg' a phrase suitable for use after
      "expecting".
    * test-suite/tests/r6rs-ports.test ("7.2.7 Input Ports")["custom binary
      input port supports `port-position', not `set-port-position!'"]: New
      test.

-----------------------------------------------------------------------

Summary of changes:
 libguile/r6rs-ports.c            |   17 ++++++++++-------
 test-suite/tests/r6rs-ports.test |   11 ++++++++++-
 2 files changed, 20 insertions(+), 8 deletions(-)

diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c
index fecc5bd..790c24c 100644
--- a/libguile/r6rs-ports.c
+++ b/libguile/r6rs-ports.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 2009, 2010, 2011, 2013 Free Software Foundation, Inc.
+/* Copyright (C) 2009, 2010, 2011, 2013, 2014 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -224,10 +224,14 @@ cbp_seek (SCM port, scm_t_off offset, int whence)
          result = scm_call_0 (get_position_proc);
        else
          scm_wrong_type_arg_msg (FUNC_NAME, 0, port,
-                                 "R6RS custom binary port does not "
-                                 "support `port-position'");
-
-       offset += scm_to_int (result);
+                                 "R6RS custom binary port with "
+                                 "`port-position' support");
+       c_result = scm_to_int (result);
+       if (offset == 0)
+         /* We just want to know the current position.  */
+         break;
+
+       offset += c_result;
        /* Fall through.  */
       }
 
@@ -240,8 +244,7 @@ cbp_seek (SCM port, scm_t_off offset, int whence)
          result = scm_call_1 (set_position_proc, scm_from_int (offset));
        else
          scm_wrong_type_arg_msg (FUNC_NAME, 0, port,
-                                 "R6RS custom binary port does not "
-                                 "support `set-port-position!'");
+                                 "seekable R6RS custom binary port");
 
        /* Assuming setting the position succeeded.  */
        c_result = offset;
diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test
index 2db2c56..eaae29f 100644
--- a/test-suite/tests/r6rs-ports.test
+++ b/test-suite/tests/r6rs-ports.test
@@ -1,6 +1,6 @@
 ;;;; r6rs-ports.test --- R6RS I/O port tests.   -*- coding: utf-8; -*-
 ;;;;
-;;;; Copyright (C) 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009, 2010, 2011, 2012, 2014 Free Software Foundation, Inc.
 ;;;; Ludovic Courtès
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
@@ -411,6 +411,15 @@
       (not (or (port-has-port-position? port)
                (port-has-set-port-position!? port)))))
 
+  (pass-if-equal "custom binary input port supports `port-position', \
+not `set-port-position!'"
+      42
+    (let ((port (make-custom-binary-input-port "the port" (const 0)
+                                               (const 42) #f #f)))
+      (and (port-has-port-position? port)
+           (not (port-has-set-port-position!? port))
+           (port-position port))))
+
   (pass-if "custom binary input port supports `port-position'"
     (let* ((str "Hello Port!")
            (source (open-bytevector-input-port


hooks/post-receive
-- 
GNU Guile