[Guile-commits] 49/58: r6rs-ports: Accept 'port-position' values greater than 2^32.

[Andy Wingo]

wingo pushed a commit to branch lightning
in repository guile.

commit 0075b7f4dc2aaad157e866ec7be91ac9f6362b93
Author: Ludovic Courtès <address@hidden>
Date:   Thu Jul 19 17:45:54 2018 +0200

    r6rs-ports: Accept 'port-position' values greater than 2^32.
    
    Reported by Ricardo Wurmus <address@hidden>.
    Fixes <https://bugs.gnu.org/32161>.
    
    * libguile/r6rs-ports.c (custom_binary_port_seek): Use 'scm_to_off_t'
    instead of 'scm_to_int'.
    * test-suite/tests/r6rs-ports.test ("8.2.7 Input Ports")["custom binary
    input port position, long offset"]: New test.
---
 libguile/r6rs-ports.c            |  2 +-
 test-suite/tests/r6rs-ports.test | 12 +++++++++++-
 2 files changed, 12 insertions(+), 2 deletions(-)

diff --git a/libguile/r6rs-ports.c b/libguile/r6rs-ports.c
index 5677305..0e90848 100644
--- a/libguile/r6rs-ports.c
+++ b/libguile/r6rs-ports.c
@@ -225,7 +225,7 @@ custom_binary_port_seek (SCM port, scm_t_off offset, int 
whence)
          scm_wrong_type_arg_msg (FUNC_NAME, 0, port,
                                  "R6RS custom binary port with "
                                  "`port-position' support");
-       c_result = scm_to_int (result);
+       c_result = scm_to_off_t (result);
        if (offset == 0)
          /* We just want to know the current position.  */
          break;
diff --git a/test-suite/tests/r6rs-ports.test b/test-suite/tests/r6rs-ports.test
index ba3131f..e6ee10a 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-2012, 2013-2015 Free Software Foundation, Inc.
+;;;; Copyright (C) 2009-2012, 2013-2015, 2018 Free Software Foundation, Inc.
 ;;;; Ludovic Courtès
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
@@ -498,6 +498,16 @@ not `set-port-position!'"
                          (u8-list->bytevector
                           (map char->integer (string->list "Port!")))))))
 
+  (pass-if-equal "custom binary input port position, long offset"
+      (expt 2 42)
+    ;; In Guile <= 2.2.4, 'seek' would throw to 'out-of-range'.
+    (let* ((port (make-custom-binary-input-port "the port"
+                                                (const 0)
+                                                (const (expt 2 42))
+                                                #f #f)))
+      (port-position port)))
+
+
   (pass-if-equal "custom binary input port buffered partial reads"
       "Hello Port!"
     ;; Check what happens when READ! returns less than COUNT bytes.