mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-30 15:00:21 +02:00
Code Activity

r6rs-ports: Accept 'port-position' values greater than 2^32.

Browse source 
Reported by Ricardo Wurmus <rekado@elephly.net>.
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.
This commit is contained in:
Ludovic Courtès 2018-07-19 17:45:54 +02:00
parent 59a06d8392
commit d677aca5c5
2 changed files with 13 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

4
libguile/r6rs-ports.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 2009, 2010, 2011, 2013-2015 Free Software Foundation, Inc. /* Copyright (C) 2009, 2010, 2011, 2013-2015, 2018 Free Software Foundation, Inc.
* *
* This library is free software; you can redistribute it and/or * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * modify it under the terms of the GNU Lesser General Public License
@ -219,7 +219,7 @@ custom_binary_port_seek (SCM port, scm_t_off offset, int whence)
scm_wrong_type_arg_msg (FUNC_NAME, 0, port, scm_wrong_type_arg_msg (FUNC_NAME, 0, port,
"R6RS custom binary port with " "R6RS custom binary port with "
"`port-position' support"); "`port-position' support");
c_result = scm_to_int (result); c_result = scm_to_off_t (result);
if (offset == 0) if (offset == 0)
/* We just want to know the current position. */ /* We just want to know the current position. */
break; break;

12
test-suite/tests/r6rs-ports.test
View file

@ -1,6 +1,6 @@
;;;; r6rs-ports.test --- R6RS I/O port tests. -*- coding: utf-8; -*- ;;;; 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 ;;;; Ludovic Courtès
;;;; ;;;;
;;;; This library is free software; you can redistribute it and/or ;;;; This library is free software; you can redistribute it and/or
@ -498,6 +498,16 @@ not `set-port-position!'"
(u8-list->bytevector (u8-list->bytevector
(map char->integer (string->list "Port!"))))))) (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" (pass-if-equal "custom binary input port buffered partial reads"
"Hello Port!" "Hello Port!"
;; Check what happens when READ! returns less than COUNT bytes. ;; Check what happens when READ! returns less than COUNT bytes.