Hi all,

Attached is a more complete patch for #1609; we forgot to update
types.db entries for the various file "stat"ing procedures in
(chicken file posix), they now accept a port as well as string or
fixnum.

Please note that the patch attached to #1609 is incomplete; it
only updates the entry for file-type.

I've also updated file-truncate to do the same.

Cheers,
Peter
From 5bf53680ee1deea1020080e6dcccf38b1c640118 Mon Sep 17 00:00:00 2001
From: Peter Bex <[email protected]>
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

Attachment: signature.asc
Description: PGP signature

_______________________________________________
Chicken-hackers mailing list
[email protected]
https://lists.nongnu.org/mailman/listinfo/chicken-hackers

Reply via email to