From 0075b7f4dc2aaad157e866ec7be91ac9f6362b93 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Thu, 19 Jul 2018 17:45:54 +0200 Subject: [PATCH] r6rs-ports: Accept 'port-position' values greater than 2^32. Reported by Ricardo Wurmus . Fixes . * 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 567730530..0e9084853 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 ba3131f2e..e6ee10add 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.