* configure.ac (AC_CHECK_FUNCS): search mkdtemp * doc/ref/posix.texi: document mkdtemp * libguile/filesys.c (scm_mkdtemp) [HAVE_MKDTEMP]: new procedure * libguile/filesys.h: declaration of scm_mkdtemp * test-suite/tests/filesys.test: new tests 'mkdtemp: number arg', 'mkdtemp: directory name template' and 'mkdtemp: directory created' --- configure.ac | 20 ++++++++++---------- doc/ref/posix.texi | 15 +++++++++++++++ libguile/filesys.c | 34 ++++++++++++++++++++++++++++++++++ libguile/filesys.h | 1 + test-suite/tests/filesys.test | 31 +++++++++++++++++++++++++++++++ 5 files changed, 91 insertions(+), 10 deletions(-)
diff --git a/configure.ac b/configure.ac index 3e96094f6..743a4c7e7 100644 --- a/configure.ac +++ b/configure.ac @@ -484,16 +484,16 @@ AC_CHECK_HEADERS([assert.h crt_externs.h]) # sched_getaffinity, sched_setaffinity - GNU extensions (glibc) # sendfile - non-POSIX, found in glibc # -AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid \ - fesetround ftime ftruncate fchown fchmod getcwd geteuid getsid \ - gettimeofday getuid getgid gmtime_r ioctl lstat mkdir mknod nice \ - readlink rename rmdir setegid seteuid \ - setlocale setuid setgid setpgid setsid sigaction siginterrupt stat64 \ - strptime symlink sync sysconf tcgetpgrp tcsetpgrp uname waitpid \ - strdup system usleep atexit on_exit chown link fcntl ttyname getpwent \ - getgrent kill getppid getpgrp fork setitimer getitimer strchr strcmp \ - index bcopy memcpy rindex truncate isblank _NSGetEnviron \ - strcoll strcoll_l strtod_l strtol_l newlocale uselocale utimensat \ +AC_CHECK_FUNCS([DINFINITY DQNAN cexp chsize clog clog10 ctermid \ + fesetround ftime ftruncate fchown fchmod getcwd geteuid getsid \ + gettimeofday getuid getgid gmtime_r ioctl lstat mkdir mkdtemp mknod \ + nice readlink rename rmdir setegid seteuid \ + setlocale setuid setgid setpgid setsid sigaction siginterrupt stat64 \ + strptime symlink sync sysconf tcgetpgrp tcsetpgrp uname waitpid \ + strdup system usleep atexit on_exit chown link fcntl ttyname getpwent \ + getgrent kill getppid getpgrp fork setitimer getitimer strchr strcmp \ + index bcopy memcpy rindex truncate isblank _NSGetEnviron \ + strcoll strcoll_l strtod_l strtol_l newlocale uselocale utimensat \ sched_getaffinity sched_setaffinity sendfile]) # The newlib C library uses _NL_ prefixed locale langinfo constants. diff --git a/doc/ref/posix.texi b/doc/ref/posix.texi index f34c5222d..9cb0be038 100644 --- a/doc/ref/posix.texi +++ b/doc/ref/posix.texi @@ -1020,6 +1020,21 @@ The file is automatically deleted when the port is closed or the program terminates. @end deffn +@deffn {Scheme Procedure} mkdtemp tmpl +@deffnx {C Function} scm_mkdtemp (tmpl) +@cindex temporary file +Create a new unique directory in the file system and return +its path. + +@var{tmpl} is a string specifying where the file should be created: it +must end with @samp{XXXXXX}. The return value is a string in which +those @samp{X}s will be changed to reflect the name of the directory +created. + +The directory mode will be @code{#o700}, as adjusted by the current +@code{umask}. +@end deffn + @deffn {Scheme Procedure} dirname filename @deffnx {C Function} scm_dirname (filename) Return the directory name component of the file name diff --git a/libguile/filesys.c b/libguile/filesys.c index 39bfd38cc..50f76c5a1 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -1544,6 +1544,40 @@ scm_mkstemp (SCM tmpl) return scm_i_mkstemp (tmpl, SCM_UNDEFINED); } +#if HAVE_MKDTEMP +SCM_DEFINE (scm_mkdtemp, "mkdtemp", 1, 0, 0, + (SCM tmpl), + "Create a new unique directory in the file system and return\n" + "its path.\n" + "\n" + "@var{tmpl} is a string specifying where the file should be\n" + "created: it must end with @samp{XXXXXX}. The return value is\n" + "a string that is the name of the directory created.\n" + "\n" + "The directory mode will be code{#o700}, as adjusted by the\n" + "current @code{umask}.") +#define FUNC_NAME s_scm_mkdtemp +{ + char *c_tmpl; + char *rv; + + SCM_VALIDATE_STRING (SCM_ARG1, tmpl); + + scm_dynwind_begin (0); + + c_tmpl = scm_to_locale_string (tmpl); + scm_dynwind_free (c_tmpl); + SCM_SYSCALL (rv = mkdtemp (c_tmpl)); + if (rv == NULL) + SCM_SYSERROR; + + scm_dynwind_end (); + + return scm_from_locale_string (c_tmpl); +} +#undef FUNC_NAME +#endif /* HAVE_MKDTEMP */ + /* Filename manipulation */ diff --git a/libguile/filesys.h b/libguile/filesys.h index f870ee434..ec4a74a48 100644 --- a/libguile/filesys.h +++ b/libguile/filesys.h @@ -65,6 +65,7 @@ SCM_API SCM scm_symlink (SCM oldpath, SCM newpath); SCM_API SCM scm_readlink (SCM path); SCM_API SCM scm_lstat (SCM str); SCM_API SCM scm_copy_file (SCM oldfile, SCM newfile); +SCM_API SCM scm_mkdtemp (SCM tmpl); SCM_API SCM scm_dirname (SCM filename); SCM_API SCM scm_basename (SCM filename, SCM suffix); SCM_API SCM scm_canonicalize_path (SCM path); diff --git a/test-suite/tests/filesys.test b/test-suite/tests/filesys.test index 9ec9f6172..f90ecd8a8 100644 --- a/test-suite/tests/filesys.test +++ b/test-suite/tests/filesys.test @@ -231,3 +231,34 @@ (delete-file (test-file)) (when (file-exists? (test-symlink)) (delete-file (test-symlink))) + + +(with-test-prefix "mkdtemp" + + (pass-if-exception "number arg" exception:wrong-type-arg + (if (not (defined? 'mkdtemp)) + (throw 'unresolved) + (mkdtemp 123))) + + (pass-if "directory name template" + (if (not (defined? 'mkdtemp)) + (throw 'unresolved) + (let* ((template "T-XXXXXX") + (str (mkdtemp template)) + (result (and + (string? str) + (not (string=? str template)) + (string-contains str "T-") + (= (string-length str 8))))) + (false-if-exception (rmdir str)) + result))) + + (pass-if "directory created" + (if (not (defined? 'mkdtemp)) + (throw 'unresolved) + (let* ((template "T-XXXXXX") + (str (mkdtemp template)) + (_stat (stat str)) + (result (eqv? 'directory (stat:type _stat)))) + (false-if-exception (rmdir str)) + result)))) -- 2.29.2