diff options
author | Michael Gran <spk121@yahoo.com> | 2018-04-11 18:34:07 -0700 |
---|---|---|
committer | Michael Gran <spk121@yahoo.com> | 2018-04-11 18:36:08 -0700 |
commit | c56d2d102368d53f8557974d151c8dd857993bec (patch) | |
tree | 4e7c4a79d8d2a268cabe1997f1ad26a95118c4dc | |
parent | a2b20d8faf022e3d529e505476388fc7e51311cf (diff) | |
download | guile-c56d2d102368d53f8557974d151c8dd857993bec.tar.gz |
Fix binary output for mkstemp! on MinGW
* libguile/filesys.c (scm_i_mkstemp): Don't mask out O_BINARY flag
* test-suite/tests/posix.test ("binary mode-honored"): new test
-rw-r--r-- | libguile/filesys.c | 9 | ||||
-rw-r--r-- | test-suite/tests/posix.test | 19 |
2 files changed, 24 insertions, 4 deletions
diff --git a/libguile/filesys.c b/libguile/filesys.c index 05dd2bd16..db8b2423a 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -1507,9 +1507,14 @@ 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. */ + out to be the case. Of those flags, O_APPEND and O_BINARY (when + present) are the only ones of interest anyway, so limit to those + flags. */ +#if defined (O_BINARY) + open_flags &= O_APPEND | O_BINARY; +#else open_flags &= O_APPEND; +#endif mode_bits = scm_i_mode_bits (mode); } diff --git a/test-suite/tests/posix.test b/test-suite/tests/posix.test index 4dadd7784..fe130e2cd 100644 --- a/test-suite/tests/posix.test +++ b/test-suite/tests/posix.test @@ -1,7 +1,7 @@ ;;;; posix.test --- Test suite for Guile POSIX functions. -*- scheme -*- ;;;; ;;;; Copyright 2003, 2004, 2006, 2007, 2010, 2012, -;;;; 2015, 2017 Free Software Foundation, Inc. +;;;; 2015, 2017, 2018 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -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 |