~ chicken-core (chicken-5) 06b760e7799f08faa5ac08d9d23adca1fec0b366

commit 06b760e7799f08faa5ac08d9d23adca1fec0b366
Author:     Peter Bex <peter@more-magic.net>
AuthorDate: Thu Apr 18 21:44:13 2019 +0200
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Mon Apr 22 14:52:51 2019 +1200

    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
    
    Signed-off-by: Evan Hanson <evhan@foldling.org>

diff --git a/NEWS b/NEWS
index c8f21f8b..d1e37aad 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..514c59a1 100644
--- a/manual/Acknowledgements
+++ b/manual/Acknowledgements
@@ -24,9 +24,9 @@ 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,
-Peter Keller, Christian Kellermann, Brad Kind, Ron Kneusel, "Kooda", Matthias
-Köppe, Krysztof Kowalczyk, Andre Kühne, Todd R. Kueny Sr, Goran
+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
 Latowicki, Kristian Lein-Mathisen, "LemonBoy", John Lenz,
 Kirill Lisovsky, Jürgen Lorenz, Kon Lovett, Lam Luu, Arthur Maciel,
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..90b29080 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)