1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00

Fix binary output on files created by mkstemp!

Some operating systems require a O_BINARY flag.

* libguile/filesys.c (scm_i_mkstemp): Don't mask out O_BINARY flag
* test-suite/tests/posix.test ("binary mode honored"): new test
This commit is contained in:
Mike Gran 2019-02-09 16:59:38 -08:00 committed by Andy Wingo
parent 08926cdcd0
commit a5df94e78c
2 changed files with 19 additions and 4 deletions

View file

@ -1513,9 +1513,9 @@ SCM_DEFINE (scm_i_mkstemp, "mkstemp!", 1, 1, 0,
/* mkostemp(2) only defines O_APPEND, O_SYNC, and O_CLOEXEC to be /* mkostemp(2) only defines O_APPEND, O_SYNC, and O_CLOEXEC to be
useful, as O_RDWR|O_CREAT|O_EXCL are implicitly added. It also useful, as O_RDWR|O_CREAT|O_EXCL are implicitly added. It also
notes that other flags may error on some systems, which turns notes that other flags may error on some systems, which turns
out to be the case. Of those flags, O_APPEND is the only one out to be the case. Of those flags, O_APPEND and O_BINARY are
of interest anyway, so limit to that flag. */ the only ones of interest anyway, so limit to those flags. */
open_flags &= O_APPEND; open_flags &= O_APPEND | O_BINARY;
mode_bits = scm_i_mode_bits (mode); mode_bits = scm_i_mode_bits (mode);
} }

View file

@ -76,7 +76,22 @@
(result (not (string=? str template)))) (result (not (string=? str template))))
(close-port port) (close-port port)
(delete-file str) (delete-file str)
result))) result))
(pass-if "binary mode honored"
(let* ((template "T-XXXXXX")
(str (string-copy template))
(outport (mkstemp! str "wb")))
(display "\n" outport)
(close-port outport)
(let* ((inport (open-input-file str #:binary #t))
(char1 (read-char inport))
(char2 (read-char inport))
(result (and (char=? char1 #\newline)
(eof-object? char2))))
(close-port inport)
(delete-file str)
result))))
;; ;;
;; putenv ;; putenv