1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-27 21:40:34 +02:00

‘seek’ now accepts ‘SEEK_DATA’ and ‘SEEK_HOLE’ where supported.

* libguile/ports.c (scm_seek): Let SEEK_DATA and SEEK_HOLE through.
(scm_init_ice_9_ports): Define ‘SEEK_DATA’ and ‘SEEK_HOLE’.
* module/ice-9/ports.scm: Export ‘SEEK_DATA’ and ‘SEEK_HOLE’ when
defined.
* test-suite/tests/ports.test ("size of sparse file")
("SEEK_DATA while on data", "SEEK_DATA while in hole")
("SEEK_HOLE while in hole"): New tests.
* NEWS: Update.
This commit is contained in:
Ludovic Courtès 2024-04-15 19:48:10 +02:00
parent 4a0c2433d9
commit 696acfc9e5
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
5 changed files with 119 additions and 10 deletions

View file

@ -1,8 +1,8 @@
;;;; ports.test --- Guile I/O ports. -*- coding: utf-8; mode: scheme; -*-
;;;; Jim Blandy <jimb@red-bean.com> --- May 1999
;;;;
;;;; Copyright (C) 1999, 2001, 2004, 2006, 2007, 2009, 2010,
;;;; 2011, 2012, 2013, 2014, 2015, 2017, 2019, 2020, 2021 Free Software Foundation, Inc.
;;;; Copyright (C) 1999, 2001, 2004, 2006-2007, 2009-2015, 2017, 2019-2021,
;;;; 2024 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
@ -185,6 +185,52 @@
(close-port iport))
(delete-file filename))
(let* ((file (test-file))
(port (open-output-file file)))
(seek port 4096 SEEK_SET)
(display "bye." port)
(close-port port)
(pass-if-equal "size of sparse file"
4100
(stat:size (stat file)))
(pass-if-equal "SEEK_DATA while on data"
4096
(if (defined? 'SEEK_DATA)
(call-with-input-file file
(lambda (port)
(catch 'system-error
(lambda ()
(seek port 4096 SEEK_DATA))
(lambda _
(throw 'unresolved)))))
(throw 'unresolved)))
(pass-if-equal "SEEK_DATA while in hole"
4096
(if (defined? 'SEEK_DATA)
(call-with-input-file file
(lambda (port)
(catch 'system-error
(lambda ()
(seek port 10 SEEK_DATA))
(lambda _
(throw 'unresolved)))))
(throw 'unresolved)))
(pass-if-equal "SEEK_HOLE while in hole"
10
(if (defined? 'SEEK_HOLE)
(call-with-input-file file
(lambda (port)
(catch 'system-error
(lambda ()
(seek port 10 SEEK_HOLE))
(lambda _
(throw 'unresolved)))))
(throw 'unresolved))))
;;; unusual characters.
(let* ((filename (test-file))
(port (open-output-file filename)))