From 5bf53680ee1deea1020080e6dcccf38b1c640118 Mon Sep 17 00:00:00 2001 From: Peter Bex Date: Thu, 18 Apr 2019 21:44:13 +0200 Subject: [PATCH] Fix types.db entries for posix file procedures and change file-truncate We've made many of these procedures accept either strings (naming the file), fixnums (indicating a file descriptor) or a port. The port was missing from several procedure entries in the types database. The file-truncate procedure was an odd one out, it still only accepted a file name or a descriptor; this has been fixed by also accepting a port now. This fixes #1609, by Robert Jensen --- NEWS | 4 ++++ manual/Acknowledgements | 2 +- manual/Module (chicken file posix) | 4 ++-- posixunix.scm | 7 ++++--- types.db | 30 +++++++++++++++--------------- 5 files changed, 26 insertions(+), 21 deletions(-) diff --git a/NEWS b/NEWS index 5e8a133a..ddf0fc4d 100644 --- a/NEWS +++ b/NEWS @@ -8,6 +8,10 @@ - In (chicken file posix), the values of perm/irgrp, perm/iwgrp, perm/ixgrp, perm/iroth, perm/iwoth and perm/ixoth are now correctly defined (they were all for "usr"; #1602, thanks to Eric Hoffman). + - In (chicken file posix), `file-truncate` now accepts also accepts + port objects, for consistency with other file procedures. + All such procedures from (chicken file posix) now have the correct + types in types.db (fixes #1609, thanks to Robert Jensen) - Runtime system - Removed the unused, undocumented (and incorrect!) C functions diff --git a/manual/Acknowledgements b/manual/Acknowledgements index 73b48dbb..53502380 100644 --- a/manual/Acknowledgements +++ b/manual/Acknowledgements @@ -24,7 +24,7 @@ Gryski, Matt Gushee, Andreas Gustafsson, Sven Hartrumpf, Jun-ichiro itojun Hagino, Ahdi Hargo, Matthias Heiler, Karl M. Hegbloom, Moritz Heidkamp, William P. Heinemann, Bill Hoffman, Eric Hoffman, Bruce Hoult, Hans Hübner, Markus Hülsmann, Götz Isenmann, Paulo Jabardo, Wietse Jacobs, David Janssens, -Christian Jäger, Matt Jones, Dale Jordan, Valentin Kamyshenko, Daishi Kato, +Christian Jäger, Robert Jensen, Matt Jones, Dale Jordan, Valentin Kamyshenko, Daishi Kato, Peter Keller, Christian Kellermann, Brad Kind, Ron Kneusel, "Kooda", Matthias Köppe, Krysztof Kowalczyk, Andre Kühne, Todd R. Kueny Sr, Goran Krampe, David Krentzlin, Ben Kurtz, Michele La Monaca, Micky diff --git a/manual/Module (chicken file posix) b/manual/Module (chicken file posix) index 9823f0bb..1140ef19 100644 --- a/manual/Module (chicken file posix) +++ b/manual/Module (chicken file posix) @@ -373,8 +373,8 @@ object, {{MODE}} should be a fixnum. Truncates the file {{FILE}} to the length {{OFFSET}}, which should be an integer. If the file-size is smaller or equal to -{{OFFSET}} then nothing is done. {{FILE}} should be a filename -or a file-descriptor. +{{OFFSET}} then nothing is done. {{FILE}} should be a filename, +a file-descriptor or a port object. '''NOTE''': On native Windows builds (all except cygwin), this procedure is unimplemented and will raise an error. diff --git a/posixunix.scm b/posixunix.scm index ad1f42c4..9b3cf6b5 100644 --- a/posixunix.scm +++ b/posixunix.scm @@ -968,9 +968,10 @@ static int set_file_mtime(char *filename, C_word atime, C_word mtime) (set! chicken.file.posix#file-truncate (lambda (fname off) (##sys#check-exact-integer off 'file-truncate) - (when (fx< (cond [(string? fname) (##core#inline "C_truncate" (##sys#make-c-string fname 'file-truncate) off)] - [(fixnum? fname) (##core#inline "C_ftruncate" fname off)] - [else (##sys#error 'file-truncate "invalid file" fname)] ) + (when (fx< (cond ((string? fname) (##core#inline "C_truncate" (##sys#make-c-string fname 'file-truncate) off)) + ((port? fname) (##core#inline "C_ftruncate" (chicken.file.posix#port->fileno fname) off)) + ((fixnum? fname) (##core#inline "C_ftruncate" fname off)) + (else (##sys#error 'file-truncate "invalid file" fname)) ) 0) (posix-error #:file-error 'file-truncate "cannot truncate file" fname off) ) ) ) diff --git a/types.db b/types.db index fcf9d9b0..9131145d 100644 --- a/types.db +++ b/types.db @@ -1964,32 +1964,32 @@ (chicken.file.posix#file-close (#(procedure #:clean #:enforce) chicken.file.posix#file-close (fixnum) undefined)) (chicken.file.posix#file-control (#(procedure #:clean #:enforce) chicken.file.posix#file-control (fixnum fixnum #!optional fixnum) fixnum)) (chicken.file.posix#file-creation-mode (#(procedure #:clean #:enforce) chicken.file.posix#file-creation-mode (#!optional fixnum) fixnum)) -(chicken.file.posix#file-group (#(procedure #:clean #:enforce) chicken.file.posix#file-owner ((or string fixnum)) fixnum)) +(chicken.file.posix#file-group (#(procedure #:clean #:enforce) chicken.file.posix#file-owner ((or string fixnum port)) fixnum)) (chicken.file.posix#file-link (#(procedure #:clean #:enforce) chicken.file.posix#file-link (string string) undefined)) (chicken.file.posix#file-lock (#(procedure #:clean #:enforce) chicken.file.posix#file-lock (port #!optional fixnum integer) (struct lock))) (chicken.file.posix#file-lock/blocking (#(procedure #:clean #:enforce) chicken.file.posix#file-lock/blocking (port #!optional fixnum integer) (struct lock))) (chicken.file.posix#file-mkstemp (#(procedure #:clean #:enforce) chicken.file.posix#file-mkstemp (string) fixnum string)) (chicken.file.posix#file-open (#(procedure #:clean #:enforce) chicken.file.posix#file-open (string fixnum #!optional fixnum) fixnum)) -(chicken.file.posix#file-owner (#(procedure #:clean #:enforce) chicken.file.posix#file-owner ((or string fixnum)) fixnum)) -(chicken.file.posix#file-permissions (#(procedure #:clean #:enforce) chicken.file.posix#file-permissions ((or string fixnum)) fixnum)) +(chicken.file.posix#file-owner (#(procedure #:clean #:enforce) chicken.file.posix#file-owner ((or string fixnum port)) fixnum)) +(chicken.file.posix#file-permissions (#(procedure #:clean #:enforce) chicken.file.posix#file-permissions ((or string fixnum port)) fixnum)) (chicken.file.posix#file-position (#(procedure #:clean #:enforce) chicken.file.posix#file-position ((or port fixnum)) integer)) (chicken.file.posix#file-read (#(procedure #:clean #:enforce) chicken.file.posix#file-read (fixnum fixnum #!optional *) list)) (chicken.file.posix#file-select (#(procedure #:clean #:enforce) chicken.file.posix#file-select ((or (list-of fixnum) fixnum false) (or (list-of fixnum) fixnum false) #!optional fixnum) * *)) -(chicken.file.posix#file-size (#(procedure #:clean #:enforce) chicken.file.posix#file-size ((or string fixnum)) integer)) -(chicken.file.posix#file-stat (#(procedure #:clean #:enforce) chicken.file.posix#file-stat ((or string fixnum) #!optional *) (vector-of integer))) +(chicken.file.posix#file-size (#(procedure #:clean #:enforce) chicken.file.posix#file-size ((or string fixnum port)) integer)) +(chicken.file.posix#file-stat (#(procedure #:clean #:enforce) chicken.file.posix#file-stat ((or string fixnum port) #!optional *) (vector-of integer))) (chicken.file.posix#file-test-lock (#(procedure #:clean #:enforce) chicken.file.posix#file-test-lock (port #!optional fixnum *) boolean)) -(chicken.file.posix#file-truncate (#(procedure #:clean #:enforce) chicken.file.posix#file-truncate ((or string fixnum) integer) undefined)) +(chicken.file.posix#file-truncate (#(procedure #:clean #:enforce) chicken.file.posix#file-truncate ((or string fixnum output-port) integer) undefined)) (chicken.file.posix#file-unlock (#(procedure #:clean #:enforce) chicken.file.posix#file-unlock ((struct lock)) undefined)) (chicken.file.posix#file-write (#(procedure #:clean #:enforce) chicken.file.posix#file-write (fixnum * #!optional fixnum) fixnum)) -(chicken.file.posix#file-type (#(procedure #:clean #:enforce) chicken.file.posix#file-type ((or string fixnum) #!optional * *) symbol)) - -(chicken.file.posix#block-device? (#(procedure #:clean #:enforce) chicken.file.posix#block-device? ((or string fixnum)) boolean)) -(chicken.file.posix#character-device? (#(procedure #:clean #:enforce) chicken.file.posix#character-device? ((or string fixnum)) boolean)) -(chicken.file.posix#directory? (#(procedure #:clean #:enforce) chicken.file.posix#directory? ((or string fixnum)) boolean)) -(chicken.file.posix#fifo? (#(procedure #:clean #:enforce) chicken.file.posix#fifo? ((or string fixnum)) boolean)) -(chicken.file.posix#regular-file? (#(procedure #:clean #:enforce) chicken.file.posix#regular-file? ((or string fixnum)) boolean)) -(chicken.file.posix#socket? (#(procedure #:clean #:enforce) chicken.file.posix#socket? ((or string fixnum)) boolean)) -(chicken.file.posix#symbolic-link? (#(procedure #:clean #:enforce) chicken.file.posix#symbolic-link? ((or string fixnum)) boolean)) +(chicken.file.posix#file-type (#(procedure #:clean #:enforce) chicken.file.posix#file-type ((or string fixnum port) #!optional * *) symbol)) + +(chicken.file.posix#block-device? (#(procedure #:clean #:enforce) chicken.file.posix#block-device? ((or string fixnum port)) boolean)) +(chicken.file.posix#character-device? (#(procedure #:clean #:enforce) chicken.file.posix#character-device? ((or string fixnum port)) boolean)) +(chicken.file.posix#directory? (#(procedure #:clean #:enforce) chicken.file.posix#directory? ((or string fixnum port)) boolean)) +(chicken.file.posix#fifo? (#(procedure #:clean #:enforce) chicken.file.posix#fifo? ((or string fixnum port)) boolean)) +(chicken.file.posix#regular-file? (#(procedure #:clean #:enforce) chicken.file.posix#regular-file? ((or string fixnum port)) boolean)) +(chicken.file.posix#socket? (#(procedure #:clean #:enforce) chicken.file.posix#socket? ((or string fixnum port)) boolean)) +(chicken.file.posix#symbolic-link? (#(procedure #:clean #:enforce) chicken.file.posix#symbolic-link? ((or string fixnum port)) boolean)) (chicken.file.posix#fileno/stderr fixnum) (chicken.file.posix#fileno/stdin fixnum) -- 2.11.0