[Guile-commits] branch master updated: Add mkstemp; undocument mkstemp!

[Andy Wingo]

This is an automated email from the git hooks/post-receive script.

wingo pushed a commit to branch master
in repository guile.

The following commit(s) were added to refs/heads/master by this push:
     new 85433fc  Add mkstemp; undocument mkstemp!
85433fc is described below

commit 85433fc2b122dc78342c3c83941949d1d9318399
Author: Andy Wingo <wingo@pobox.com>
AuthorDate: Wed Mar 10 20:35:58 2021 +0100

    Add mkstemp; undocument mkstemp!
    
    * doc/ref/posix.texi (File System): Update to document mkstemp only.
    * libguile/filesys.c: Make a mkstemp that doesn't modify the input
    template.  Instead the caller has to get the file name from
    port-filename.
    (scm_mkstemp): Use the new mkstemp to implement mkstemp!.  Can't
    deprecate yet though as the replacement hasn't been there for long
    enough.
    * libguile/posix.c (scm_tempnam): Update to mention mkstemp instead.
    * module/system/base/compile.scm (call-with-output-file/atomic): Use
    mkstemp.
    * test-suite/tests/posix.test:
    * test-suite/tests/r6rs-files.test: Use mkstemp.
    * NEWS: Update.
---
 NEWS                             |  4 ++-
 doc/ref/posix.texi               | 25 ++++++++------
 libguile/filesys.c               | 74 +++++++++++++++++++++++++++++-----------
 libguile/posix.c                 |  6 ++--
 module/system/base/compile.scm   | 12 +++----
 test-suite/tests/posix.test      | 24 ++++---------
 test-suite/tests/r6rs-files.test | 12 +++----
 7 files changed, 93 insertions(+), 64 deletions(-)

diff --git a/NEWS b/NEWS
index 3a8be50..b24e3d9 100644
--- a/NEWS
+++ b/NEWS
@@ -156,7 +156,9 @@ See "Environment Variables" in the manual.
 
 See "File System" in the manual.  There is still `mkstemp!' but we
 recommend that new code uses `mkstemp', which does not mutate the
-contents of the "template" argument string.
+contents of the "template" argument string.  Instead for `mkstemp' you
+get the name of the newly-created file by calling `port-filename' on the
+returned port.
 
 ** `(system foreign-library)' module
 
diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi
index e78e151..7633bd5 100644
--- a/doc/ref/posix.texi
+++ b/doc/ref/posix.texi
@@ -981,27 +981,30 @@ and causing you to overwrite that.
 The safe way is to create the file using @code{open} with
 @code{O_EXCL} to avoid any overwriting.  A loop can try again with
 another name if the file exists (error @code{EEXIST}).
-@code{mkstemp!} below does that.
+@code{mkstemp} below does that.
 @end deffn
 
-@deffn {Scheme Procedure} mkstemp! tmpl [mode]
-@deffnx {C Function} scm_mkstemp (tmpl)
+@deffn {Scheme Procedure} mkstemp tmpl [mode]
 @cindex temporary file
 Create a new unique file in the file system and return a new buffered
 port open for reading and writing to the file.
 
 @var{tmpl} is a string specifying where the file should be created: it
-must end with @samp{XXXXXX} and those @samp{X}s will be changed in the
-string to return the name of the file.  (@code{port-filename} on the
-port also gives the name.)
+must end with @samp{XXXXXX}.  The name of the newly created file will be
+the same as @var{tmpl}, but with those @samp{X}s changed, and can be
+determined by calling @code{port-filename} on the returned port.
 
-POSIX doesn't specify the permissions mode of the file, on GNU and
-most systems it's @code{#o600}.  An application can use @code{chmod}
-to relax that if desired.  For example @code{#o666} less @code{umask},
-which is usual for ordinary file creation,
+Note that the newly created file is not deleted automatically by Guile;
+probably the caller should arrange to call @code{delete-file} when the
+file is no longer needed.
+
+POSIX doesn't specify the permissions mode of the file.  On GNU and most
+systems it's @code{#o600}; an application can use @code{chmod} to relax
+that if desired.  For example @code{#o666} less @code{umask}, which is
+usual for ordinary file creation,
 
 @example
-(let ((port (mkstemp! (string-copy "/tmp/myfile-XXXXXX"))))
+(let ((port (mkstemp "/tmp/myfile-XXXXXX")))
   (chmod port (logand #o666 (lognot (umask))))
   ...)
 @end example
diff --git a/libguile/filesys.c b/libguile/filesys.c
index 1b0af6e..7ca46c8 100644
--- a/libguile/filesys.c
+++ b/libguile/filesys.c
@@ -1454,24 +1454,29 @@ SCM_DEFINE (scm_umask, "umask", 0, 1, 0,
 #undef FUNC_NAME
 
 SCM_INTERNAL SCM scm_i_mkstemp (SCM, SCM);
-SCM_DEFINE (scm_i_mkstemp, "mkstemp!", 1, 1, 0,
+SCM_DEFINE (scm_i_mkstemp, "mkstemp", 1, 1, 0,
            (SCM tmpl, SCM mode),
-           "Create a new unique file in the file system and return a new\n"
-           "buffered port open for reading and writing to the file.\n"
+           "Create a new unique file in the file system.  Return\n"
+           "a buffered port open for reading and writing to the file.\n"
            "\n"
            "@var{tmpl} is a string specifying where the file should be\n"
-           "created: it must end with @samp{XXXXXX} and those @samp{X}s\n"
-           "will be changed in the string to return the name of the file.\n"
-           "(@code{port-filename} on the port also gives the name.)\n"
-           "\n"
-           "POSIX doesn't specify the permissions mode of the file, on GNU\n"
-           "and most systems it's @code{#o600}.  An application can use\n"
-           "@code{chmod} to relax that if desired.  For example\n"
+           "created: it must end with @samp{XXXXXX}.  The name of the\n"
+            "newly created file will be the same as @var{tmpl}, but with\n"
+            "those @samp{X}s changed, and can be determined by calling\n"
+            "@code{port-filename} on the returned port.\n"
+            "\n"
+            "Note that the newly created file is not deleted automatically\n"
+            "by Guile; probably the caller should arrange to call\n"
+            "@code{delete-file} when the file is no longer needed.\n"
+            "\n"
+           "POSIX doesn't specify the permissions mode of the file.\n"
+            "On GNU and most systems it's @code{#o600}.  An application can\n"
+            "use @code{chmod} to relax that if desired.  For example\n"
            "@code{#o666} less @code{umask}, which is usual for ordinary\n"
            "file creation,\n"
            "\n"
            "@example\n"
-           "(let ((port (mkstemp! (string-copy \"/tmp/myfile-XXXXXX\"))))\n"
+           "(let ((port (mkstemp \"/tmp/myfile-XXXXXX\")))\n"
            "  (chmod port (logand #o666 (lognot (umask))))\n"
            "  ...)\n"
            "@end example\n"
@@ -1491,10 +1496,6 @@ SCM_DEFINE (scm_i_mkstemp, "mkstemp!", 1, 1, 0,
   if (!SCM_UNBNDP (mode))
     SCM_VALIDATE_STRING (SCM_ARG2, mode);
 
-  /* Ensure tmpl is mutable.  */
-  scm_i_string_start_writing (tmpl);
-  scm_i_string_stop_writing ();
-
   scm_dynwind_begin (0);
 
   c_tmpl = scm_to_locale_string (tmpl);
@@ -1523,13 +1524,10 @@ SCM_DEFINE (scm_i_mkstemp, "mkstemp!", 1, 1, 0,
   if (rv == -1)
     SCM_SYSERROR;
 
-  scm_substring_move_x (scm_from_locale_string (c_tmpl),
-                       SCM_INUM0, scm_string_length (tmpl),
-                       tmpl, SCM_INUM0);
-
+  SCM name = scm_from_locale_string (c_tmpl);
   scm_dynwind_end ();
 
-  port = scm_i_fdes_to_port (rv, mode_bits, tmpl, 0);
+  port = scm_i_fdes_to_port (rv, mode_bits, name, 0);
   if (is_binary)
     /* Use the binary-friendly ISO-8859-1 encoding. */
     scm_i_set_port_encoding_x (port, NULL);
@@ -1538,6 +1536,42 @@ SCM_DEFINE (scm_i_mkstemp, "mkstemp!", 1, 1, 0,
 }
 #undef FUNC_NAME
 
+SCM_INTERNAL SCM scm_i_mkstemp_x (SCM, SCM);
+SCM_DEFINE (scm_i_mkstemp_x, "mkstemp!", 1, 1, 0,
+           (SCM tmpl, SCM mode),
+           "Create a new unique file in the file system and return a new\n"
+           "buffered port open for reading and writing to the file.\n"
+           "\n"
+           "@var{tmpl} is a string specifying where the file should be\n"
+           "created: it must end with @samp{XXXXXX} and those @samp{X}s\n"
+           "will be changed in the string to return the name of the file.\n"
+           "(@code{port-filename} on the port also gives the name.)\n"
+           "\n"
+           "POSIX doesn't specify the permissions mode of the file, on GNU\n"
+           "and most systems it's @code{#o600}.  An application can use\n"
+           "@code{chmod} to relax that if desired.  For example\n"
+           "@code{#o666} less @code{umask}, which is usual for ordinary\n"
+           "file creation,\n"
+           "\n"
+           "@example\n"
+           "(let ((port (mkstemp! (string-copy \"/tmp/myfile-XXXXXX\"))))\n"
+           "  (chmod port (logand #o666 (lognot (umask))))\n"
+           "  ...)\n"
+           "@end example\n"
+            "\n"
+            "The optional @var{mode} argument specifies a mode, as a string\n"
+            "in the same format that @code{open-file} takes.  It defaults\n"
+            "to @code{\"w+\"}.")
+#define FUNC_NAME s_scm_i_mkstemp_x
+{
+  SCM ret = scm_i_mkstemp (tmpl, mode);
+  scm_substring_move_x (scm_port_filename (ret),
+                       SCM_INUM0, scm_string_length (tmpl),
+                       tmpl, SCM_INUM0);
+  return ret;
+}
+#undef FUNC_NAME
+
 SCM
 scm_mkstemp (SCM tmpl)
 {
diff --git a/libguile/posix.c b/libguile/posix.c
index 4776900..eaf12de 100644
--- a/libguile/posix.c
+++ b/libguile/posix.c
@@ -1,4 +1,4 @@
-/* Copyright 1995-2014,2016-2019
+/* Copyright 1995-2014,2016-2019,2021
      Free Software Foundation, Inc.
 
    This file is part of Guile.
@@ -1572,14 +1572,14 @@ SCM_DEFINE (scm_tmpnam, "tmpnam", 0, 0, 0,
            "existing file.  However there is no guarantee that another\n"
            "process will not create the file after @code{tmpnam} is called.\n"
            "Care should be taken if opening the file, e.g., use the\n"
-           "@code{O_EXCL} open flag or use @code{mkstemp!} instead.")
+           "@code{O_EXCL} open flag or use @code{mkstemp} instead.")
 #define FUNC_NAME s_scm_tmpnam
 {
   char name[L_tmpnam];
   char *rv;
 
   scm_c_issue_deprecation_warning
-      ("Use of tmpnam is deprecated.  Use mkstemp! instead.");
+      ("Use of tmpnam is deprecated.  Use mkstemp instead.");
 
   SCM_SYSCALL (rv = tmpnam (name));
   if (rv == NULL)
diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index 567765d..9ec9cbb 100644
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -1,6 +1,6 @@
 ;;; High-level compiler interface
 
-;; Copyright (C) 2001,2005,2008-2013,2016,2020 Free Software Foundation, Inc.
+;; Copyright (C) 2001,2005,2008-2013,2016,2020,2021 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 License as published by
@@ -60,8 +60,8 @@
 
 ;; emacs: (put 'call-with-output-file/atomic 'scheme-indent-function 1)
 (define* (call-with-output-file/atomic filename proc #:optional reference)
-  (let* ((template (string-append filename ".XXXXXX"))
-         (tmp (mkstemp! template "wb")))
+  (let* ((tmp (mkstemp (string-append filename ".XXXXXX") "wb"))
+         (tmpname (port-filename tmp)))
     (call-once
      (lambda ()
        (with-throw-handler #t
@@ -71,12 +71,12 @@
            ;; work on systems without fchmod, like MinGW.
            (let ((perms (or (false-if-exception (stat:perms (stat reference)))
                             (lognot (umask)))))
-             (chmod template (logand #o0666 perms)))
+             (chmod tmpname (logand #o0666 perms)))
            (close-port tmp)
-           (rename-file template filename))
+           (rename-file tmpname filename))
          (lambda args
            (close-port tmp)
-           (delete-file template)))))))
+           (delete-file tmpname)))))))
 
 (define (ensure-language x)
   (if (language? x)
diff --git a/test-suite/tests/posix.test b/test-suite/tests/posix.test
index 135f09c..1e552d1 100644
--- a/test-suite/tests/posix.test
+++ b/test-suite/tests/posix.test
@@ -1,6 +1,6 @@
 ;;;; posix.test --- Test suite for Guile POSIX functions. -*- scheme -*-
 ;;;;
-;;;; Copyright 2003-2004,2006-2007,2010,2012,2015,2017-2019
+;;;; Copyright 2003-2004,2006-2007,2010,2012,2015,2017-2019,2021
 ;;;;   Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
@@ -55,10 +55,10 @@
 
   
 ;;
-;; mkstemp!
+;; mkstemp
 ;;
 
-(with-test-prefix "mkstemp!"
+(with-test-prefix "mkstemp"
 
   ;; the temporary names used in the tests here are kept to 8 characters so
   ;; they'll work on a DOS 8.3 file system
@@ -69,28 +69,18 @@
   (pass-if-exception "number arg" exception:wrong-type-arg
     (mkstemp! 123))
 
-  (pass-if "filename string modified"
-    (let* ((template "T-XXXXXX")
-           (str      (string-copy template))
-           (port     (mkstemp! str))
-           (result   (not (string=? str template))))
-      (close-port port)
-      (delete-file str)
-      result))
-
   (pass-if "binary mode honored"
-    (let* ((template "T-XXXXXX")
-           (str      (string-copy template))
-           (outport  (mkstemp! str "wb")))
+    (let* ((outport  (mkstemp "T-XXXXXX" "wb"))
+           (filename (port-filename outport)))
       (display "\n" outport)
       (close-port outport)
-      (let* ((inport (open-input-file str #:binary #t))
+      (let* ((inport (open-input-file filename #:binary #t))
              (char1  (read-char inport))
              (char2  (read-char inport))
              (result (and (char=? char1 #\newline)
                           (eof-object? char2))))
         (close-port inport)
-        (delete-file str)
+        (delete-file filename)
         result))))
 
 ;;
diff --git a/test-suite/tests/r6rs-files.test b/test-suite/tests/r6rs-files.test
index 9b31a82..86065a1 100644
--- a/test-suite/tests/r6rs-files.test
+++ b/test-suite/tests/r6rs-files.test
@@ -1,6 +1,6 @@
-;;; r6rs-files.test --- Test suite for R6RS (rnrs unicode)
+;;; r6rs-files.test --- Test suite for R6RS (rnrs unicode)  -*- scheme -*-
 
-;;      Copyright (C) 2010 Free Software Foundation, Inc.
+;;      Copyright (C) 2010, 2021 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
@@ -18,13 +18,13 @@
 
 
 (define-module (test-suite test-rnrs-files)
-  :use-module ((rnrs exceptions) :version (6))
-  :use-module ((rnrs files) :version (6))
-  :use-module (test-suite lib))
+  #:use-module (rnrs exceptions)
+  #:use-module (rnrs files)
+  #:use-module (test-suite lib))
 
 (with-test-prefix "delete-file"
   (pass-if "delete-file deletes file"
-    (let* ((port (mkstemp! "T-XXXXXX"))
+    (let* ((port (mkstemp "T-XXXXXX"))
            (filename (port-filename port)))
       (close-port port)
       (delete-file filename)