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:
parent
c67cbc501f
commit
32bf48e4b7
4 changed files with 34 additions and 45 deletions
|
@ -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
|
||||||
|
|
|
@ -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 */
|
||||||
|
|
|
@ -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);
|
||||||
|
|
|
@ -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)))))
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue