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

Fix binary output on files created by mkstemp!

Browse source 
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
Download patch file Download diff file Expand all files Collapse all files

6
libguile/filesys.c
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
useful, as O_RDWR|O_CREAT|O_EXCL are implicitly added. It also
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
of interest anyway, so limit to that flag. */
open_flags &= O_APPEND;
out to be the case. Of those flags, O_APPEND and O_BINARY are
the only ones of interest anyway, so limit to those flags. */
open_flags &= O_APPEND | O_BINARY;
mode_bits = scm_i_mode_bits (mode);
}

17
test-suite/tests/posix.test
View file

@ -76,7 +76,22 @@
(result (not (string=? str template))))
(close-port port)
(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