1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00

Replace mutating mkdtemp! with non-mutating mkdtemp

* doc/ref/posix.texi: replace mkdtemp! and scm_mkdtemp_x documentation
    with documentation for mkdtemp and scm_mkdtemp
* libguile/filesys.c (scm_mkdtemp_x): procedure mkdtemp! removed
    (scm_mkdtemp): new procedure mkdtemp
* libguile/filesys.h: Remove declaration for scm_mkdtemp_x.  New declaration
    scm_mkdtemp.
* test-suite/tests/filesys.test: Remove mkdtemp! tests.  Add tests
    for mkdtemp.
This commit is contained in:
Michael Gran 2021-01-21 09:37:49 -08:00
parent c67cbc501f
commit 32bf48e4b7
4 changed files with 34 additions and 45 deletions

View file

@ -1020,23 +1020,23 @@ The file is automatically deleted when the port is closed
or the program terminates. or the program terminates.
@end deffn @end deffn
@deffn {Scheme Procedure} mkdtemp! tmpl @deffn {Scheme Procedure} mkdtemp tmpl
@deffnx {C Function} scm_mkdtemp_x (tmpl) @deffnx {C Function} scm_mkdtemp (tmpl)
@cindex temporary directory @cindex temporary directory
Create a new directory named in accordance with the template string Create a new directory named in accordance with the template string
@var{tmpl}. @var{tmpl}.
@var{tmpl} is a string specifying the directory's name. The last six @var{tmpl} is a string specifying the directory's name. The last six
characters of @var{tmpl} must be @samp{XXXXXX}, characters that will be characters of @var{tmpl} must be @samp{XXXXXX}. Upon successful
modified to ensure the directory name is unique. Upon successful execution, the name of the new directory is returned which has the same
execution, those @samp{X}s will be changed to reflect the name of the form as @var{tmpl} but with the @samp{XXXXXX} characters modified to
unique directory created. ensure the directory name is unique.
The permissions of the directory created are OS dependent, but, are The permissions of the directory created are OS dependent, but, are
usually @code{#o700}. usually @code{#o700}.
The return value is unspecified. An error may be thrown if the template An error may be thrown if the template has the wrong format or if the
has the wrong format or if the directory cannot be created. directory cannot be created.
@end deffn @end deffn
@deffn {Scheme Procedure} dirname filename @deffn {Scheme Procedure} dirname filename

View file

@ -1545,41 +1545,35 @@ scm_mkstemp (SCM tmpl)
} }
#if HAVE_MKDTEMP #if HAVE_MKDTEMP
SCM_DEFINE (scm_mkdtemp_x, "mkdtemp!", 1, 0, 0, SCM_DEFINE (scm_mkdtemp, "mkdtemp", 1, 0, 0,
(SCM tmpl), (SCM tmpl),
"Create a new unique directory in the file system named in\n" "Create a new unique directory in the file system named in\n"
"accordance with @var{tmpl}. The last 6 characters of the\n" "accordance with @var{tmpl}. The last six characters of the\n"
"template must be XXXXXX\n" "template must be 'XXXXXX'.\n"
"\n" "\n"
"Upon success, the template string, which must be mutable, will\n" "Upon success, this procedure returns the name of the\n"
"be modified in place with the name of the directory created.\n" "directory created.\n"
"The return value is unspecified.\n"
"\n" "\n"
"An error may be thrown if the template is incorrect or if\n" "An error may be thrown if the template is incorrect or if\n"
"the directory could not be created.\n") "the directory could not be created.\n")
#define FUNC_NAME s_scm_mkdtemp_x #define FUNC_NAME s_scm_mkdtemp
{ {
char *c_tmpl; char *c_tmpl;
char *rv; char *rv;
SCM new_dirname;
SCM_VALIDATE_STRING (SCM_ARG1, tmpl); SCM_VALIDATE_STRING (SCM_ARG1, tmpl);
/* Ensure tmpl is mutable. */
scm_i_string_start_writing (tmpl);
scm_i_string_stop_writing ();
scm_dynwind_begin (0); scm_dynwind_begin (0);
c_tmpl = scm_to_locale_string (tmpl); c_tmpl = scm_to_locale_string (tmpl);
scm_dynwind_free (c_tmpl); scm_dynwind_free (c_tmpl);
SCM_SYSCALL (rv = mkdtemp (c_tmpl)); SCM_SYSCALL (rv = mkdtemp (c_tmpl));
if (rv == NULL) if (rv == NULL)
SCM_SYSERROR; SCM_SYSERROR;
scm_substring_move_x (scm_from_locale_string (c_tmpl), new_dirname = scm_from_locale_string (c_tmpl);
SCM_INUM0, scm_string_length (tmpl),
tmpl, SCM_INUM0);
scm_dynwind_end (); scm_dynwind_end ();
return SCM_UNSPECIFIED; return new_dirname;
} }
#undef FUNC_NAME #undef FUNC_NAME
#endif /* HAVE_MKDTEMP */ #endif /* HAVE_MKDTEMP */

View file

@ -66,7 +66,7 @@ SCM_API SCM scm_readlink (SCM path);
SCM_API SCM scm_lstat (SCM str); SCM_API SCM scm_lstat (SCM str);
SCM_API SCM scm_copy_file (SCM oldfile, SCM newfile); SCM_API SCM scm_copy_file (SCM oldfile, SCM newfile);
SCM_API SCM scm_mkstemp (SCM tmpl); SCM_API SCM scm_mkstemp (SCM tmpl);
SCM_API SCM scm_mkdtemp_x (SCM tmpl); SCM_API SCM scm_mkdtemp (SCM tmpl);
SCM_API SCM scm_dirname (SCM filename); SCM_API SCM scm_dirname (SCM filename);
SCM_API SCM scm_basename (SCM filename, SCM suffix); SCM_API SCM scm_basename (SCM filename, SCM suffix);
SCM_API SCM scm_canonicalize_path (SCM path); SCM_API SCM scm_canonicalize_path (SCM path);

View file

@ -233,40 +233,35 @@
(delete-file (test-symlink))) (delete-file (test-symlink)))
(with-test-prefix "mkdtemp!" (with-test-prefix "mkdtemp"
(pass-if-exception "number arg" exception:wrong-type-arg (pass-if-exception "number arg" exception:wrong-type-arg
(if (not (defined? 'mkdtemp!)) (if (not (defined? 'mkdtemp))
(throw 'unresolved) (throw 'unresolved)
(mkdtemp! 123))) (mkdtemp 123)))
(pass-if "directory name template prefix is unmodified" (pass-if "template prefix is preserved"
(if (not (defined? 'mkdtemp!)) (if (not (defined? 'mkdtemp))
(throw 'unresolved) (throw 'unresolved)
(let ((template (string-copy "T-XXXXXX"))) (let* ((template "T-XXXXXX")
(mkdtemp! template) (name (mkdtemp template)))
(false-if-exception (rmdir template)) (false-if-exception (rmdir template))
(and (and
(string? template) (string? name)
(string-contains template "T-") (string-contains name "T-")
(= (string-length template) 8))))) (= (string-length name) 8)))))
(pass-if-exception "read-only template" exception:miscellaneous-error
(if (not (defined? 'mkdtemp!))
(throw 'unresolved)
(mkdtemp! (substring/read-only "T-XXXXXX" 0))))
(pass-if-exception "invalid template" exception:system-error (pass-if-exception "invalid template" exception:system-error
(if (not (defined? 'mkdtemp!)) (if (not (defined? 'mkdtemp))
(throw 'unresolved) (throw 'unresolved)
(mkdtemp! (string-copy "T-AAAAAA" 0)))) (mkdtemp "T-AAAAAA")))
(pass-if "directory created" (pass-if "directory created"
(if (not (defined? 'mkdtemp!)) (if (not (defined? 'mkdtemp))
(throw 'unresolved) (throw 'unresolved)
(let ((template (string-copy "T-XXXXXX"))) (let* ((template "T-XXXXXX")
(mkdtemp! template) (name (mkdtemp template)))
(let* ((_stat (stat template)) (let* ((_stat (stat name))
(result (eqv? 'directory (stat:type _stat)))) (result (eqv? 'directory (stat:type _stat))))
(false-if-exception (rmdir template)) (false-if-exception (rmdir template))
result))))) result)))))