summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2021-03-10 20:35:58 +0100
committerAndy Wingo <wingo@pobox.com>2021-03-10 20:40:10 +0100
commit85433fc2b122dc78342c3c83941949d1d9318399 (patch)
tree2fff776765468df861dc8a8c5e80f551b4905a5f
parent89a299102ff3597a48febe1fb6d3097fddcda40e (diff)
downloadguile-85433fc2b122dc78342c3c83941949d1d9318399.tar.gz
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.
-rw-r--r--NEWS4
-rw-r--r--doc/ref/posix.texi25
-rw-r--r--libguile/filesys.c74
-rw-r--r--libguile/posix.c6
-rw-r--r--module/system/base/compile.scm12
-rw-r--r--test-suite/tests/posix.test24
-rw-r--r--test-suite/tests/r6rs-files.test12
7 files changed, 93 insertions, 64 deletions
diff --git a/NEWS b/NEWS
index 3a8be50ce..b24e3d999 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 e78e1510c..7633bd5a3 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 1b0af6e14..7ca46c8af 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 47769003a..eaf12de32 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 567765dc0..9ec9cbb0f 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 135f09c11..1e552d16f 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 9b31a8296..86065a193 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)