dnl
define(GUILE_CONFIGURE_COPYRIGHT,[[
-Copyright 1998-2020 Free Software Foundation, Inc.
+Copyright 1998-2021 Free Software Foundation, Inc.
This file is part of Guile.
# 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.
@c -*-texinfo-*-
@c This is part of the GNU Guile Reference Manual.
@c Copyright (C) 1996, 1997, 2000, 2001, 2002, 2003, 2004, 2006, 2007,
-@c 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2017 Free Software Foundation, Inc.
+@c 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2017, 2021 Free Software Foundation, Inc.
@c See the file guile.texi for copying conditions.
@node POSIX
or the program terminates.
@end deffn
+@deffn {Scheme Procedure} mkdtemp! tmpl
+@deffnx {C Function} scm_mkdtemp_x (tmpl)
+@cindex temporary directory
+Create a new directory named in accordance with the template string
+@var{tmpl}.
+
+@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
+modified to ensure the directory name is unique. Upon successful
+execution, those @samp{X}s will be changed to reflect the name of the
+unique directory created.
+
+The permissions of the directory created are OS dependent, but, are
+usually @code{#o700}.
+
+The return value is unspecified. An error may be thrown if the template
+has the wrong format or if the directory cannot be created.
+@end deffn
+
@deffn {Scheme Procedure} dirname filename
@deffnx {C Function} scm_dirname (filename)
Return the directory name component of the file name
-/* Copyright 1996-2002,2004,2006,2009-2019
+/* Copyright 1996-2002,2004,2006,2009-2019,2021
Free Software Foundation, Inc.
This file is part of Guile.
return scm_i_mkstemp (tmpl, SCM_UNDEFINED);
}
+#if HAVE_MKDTEMP
+SCM_DEFINE (scm_mkdtemp_x, "mkdtemp!", 1, 0, 0,
+ (SCM tmpl),
+ "Create a new unique directory in the file system named in\n"
+ "accordance with @var{tmpl}. The last 6 characters of the\n"
+ "template must be XXXXXX\n"
+ "\n"
+ "Upon success, the template string -- if mutable -- will be\n"
+ "modified in place with the name of the directory created.\n"
+ "The name will also be the return value.\n"
+ "\n"
+ "An error may be thrown if the template is incorrect or if\n"
+ "the directory could not be created.\n")
+#define FUNC_NAME s_scm_mkdtemp_x
+{
+ char *c_tmpl;
+ char *rv;
+
+ 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);
+ c_tmpl = scm_to_locale_string (tmpl);
+ scm_dynwind_free (c_tmpl);
+ SCM_SYSCALL (rv = mkdtemp (c_tmpl));
+ if (rv == NULL)
+ SCM_SYSERROR;
+ scm_substring_move_x (scm_from_locale_string (c_tmpl),
+ SCM_INUM0, scm_string_length (tmpl),
+ tmpl, SCM_INUM0);
+ scm_dynwind_end ();
+
+ return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+#endif /* HAVE_MKDTEMP */
+
\f
/* Filename manipulation */
SCM_API SCM scm_lstat (SCM str);
SCM_API SCM scm_copy_file (SCM oldfile, SCM newfile);
SCM_API SCM scm_mkstemp (SCM tmpl);
+SCM_API SCM scm_mkdtemp_x (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);
(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 prefix is unmodified"
+ (if (not (defined? 'mkdtemp!))
+ (throw 'unresolved)
+ (let ((template (string-copy "T-XXXXXX")))
+ (mkdtemp! template)
+ (false-if-exception (rmdir template))
+ (and
+ (string? template)
+ (string-contains template "T-")
+ (= (string-length template) 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
+ (if (not (defined? 'mkdtemp!))
+ (throw 'unresolved)
+ (mkdtemp! (string-copy "T-AAAAAA" 0))))
+
+ (pass-if "directory created"
+ (if (not (defined? 'mkdtemp!))
+ (throw 'unresolved)
+ (let ((template (string-copy "T-XXXXXX")))
+ (mkdtemp! template)
+ (let* ((_stat (stat template))
+ (result (eqv? 'directory (stat:type _stat))))
+ (false-if-exception (rmdir template))
+ result)))))
projects / platform / upstream / guile.git / commitdiff