[Guile-commits] 01/01: Fix binary output on files created by mkstemp!

[Mike Gran]

mike121 pushed a commit to branch stable-2.2
in repository guile.

commit 78468baa118d316050a27e43250966e52ffd3d54
Author: Mike Gran <address@hidden>
Date:   Sat Feb 9 16:59:38 2019 -0800

    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
---
 libguile/filesys.c          |  8 ++++----
 test-suite/tests/posix.test | 19 +++++++++++++++++--
 2 files changed, 21 insertions(+), 6 deletions(-)

diff --git a/libguile/filesys.c b/libguile/filesys.c
index e1aeeed..1a8dfa0 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1996-2002, 2004, 2006, 2009-2018
+/* Copyright (C) 1996-2002, 2004, 2006, 2009-2019
  *   Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
@@ -1507,9 +1507,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);
     }
 
diff --git a/test-suite/tests/posix.test b/test-suite/tests/posix.test
index 63b4513..d3170c7 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, 2018 Free Software Foundation, Inc.
+;;;;   2015, 2017, 2018, 2019 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