Raymond Toy pushed to branch issue-373-handle-temp-files at cmucl / cmucl Commits: 32f4adb8 by Raymond Toy at 2025-11-10T09:32:05-08:00 Allow specifying a directory for the temp file or directory Add a new keyword arg :directory that specifies a directory where the temporary file or directory is. If not provided an OS-dependent directory is used. This applies to both `with-temporary-file` and `with-temporary-directory`. - - - - - 14902acd by Raymond Toy at 2025-11-10T10:09:12-08:00 Implement "rm -r" in Lisp Instead of using "rm -rf" to delete the temporary directory produced by `with-temporary-directory`, do the deletion in lisp so we don't have to fork/exec. The new function `recursively-delete-directory` recursively deletes a directory and all its contents. - - - - - 2 changed files: - src/code/extensions.lisp - src/i18n/locale/cmucl.pot Changes: ===================================== src/code/extensions.lisp ===================================== @@ -632,30 +632,31 @@ (unless (alien:null-alien path) (alien:free-alien path))))) -;; Create a template suitable for mkstemp and mkdtemp. PREFIX is -;; string (or NIL) provided by the macros and is used as is as the -;; template prefix. If PREFIX is NIL, the prefix is obtained by -;; appending DEFAULT-NAME to the OS-dependent temporary path. In all -;; cases, we append exactly 6 X's to create the finale template. -(defun create-template (prefix default-name) +;; Create a template suitable for mkstemp and mkdtemp. DIRECTORY is +;; the directory for the template. If DIRECTORY is NIL, an +;; OS-dependent location is used. PREFIX is string that is the prefix +;; for the filename for the template. In all cases, we append exactly +;; 6 X's to create the finale template. +(defun create-template (directory prefix) (concatenate 'string - (or prefix - (concatenate 'string - (get-os-temp-path) - default-name)) + (or directory + (get-os-temp-path)) + "/" + prefix "XXXXXX")) ;;; WITH-TEMPORARY-FILE -- Public -(defmacro with-temporary-file ((filename &key prefix) +(defmacro with-temporary-file ((filename &key directory (prefix "cmucl-temp-file-")) &parse-body (forms decls)) _N"Creates a temporary file with a name bound to Filename which a - namestring. If Prefix is not provided, the temporary file is created - in a OS-dependent location. Otherwise the prefix is used as a prefix - for the name. On completion, the file is automatically removed." + namestring. If Directory is not provided, the temporary file is created + in a OS-dependent location. The Prefix is a prefix to the file name + to be created. If not provided a default prefix is used. + On completion, the file is automatically removed." (let ((fd (gensym "FD-")) (file-template (gensym "TEMP-PATH-")) (unique-filename (gensym "UNIQUE-FILENAME-"))) - `(let ((,file-template (create-template ,prefix "cmucl-temp-file-")) + `(let ((,file-template (create-template ,directory ,prefix)) ,unique-filename) (unwind-protect (let (,fd) @@ -673,17 +674,34 @@ (when (pathnamep ,filename) (delete-file ,filename)))))) +(defun recursive-delete-directory (dir) + _N"Recursively delete the directory DIR. All files and subdirectories of + DIR are removed. DIR must be a pathname to a directory. Any NAME + or TYPE components in DIR are ignored." + (declare (type pathname dir)) + ;; Find all the files or directories in DIR. + (dolist (path (directory (merge-pathnames "*.*" dir))) + ;; If the path is a directory, recursively delete the directory. + ;; Otherwise delete the file. We do not follow any symlinks. + (if (eq (unix:unix-file-kind (namestring path)) :directory) + (recursive-delete-directory path) + (delete-file path))) + ;; Finally delete the directory. + (unix:unix-rmdir (namestring dir)) + (values)) + ;;; WITH-TEMPORARY-DIRECTORY -- Public -(defmacro with-temporary-directory ((dirname &key prefix) +(defmacro with-temporary-directory ((dirname &key directory (prefix "cmucl-temp-dir-")) &parse-body (forms decls)) - _N"Return a namestring to a temporary directory. If Prefix is not - provided, the directory is created in an OS-dependent location. - Otherwise, the Prefix is a string that is used as a prefix for the - name of the temporary directory. The directory and all its contents - are automatically removed afterward." + _N"Return a namestring to a temporary directory. If Directory is not + provided, the directory is created in an OS-dependent location. The + Prefix is a string that is used as a prefix for the name of the + temporary directory. If Prefix is not given, a default prefix is + used. The directory and all its contents are automatically removed + afterward." (let ((err (gensym "ERR-")) (dir-template (gensym "DIR-TEMPLATE-"))) - `(let ((,dir-template (create-template ,prefix "cmucl-temp-dir-")) + `(let ((,dir-template (create-template ,directory ,prefix)) ,dirname ,err) (unwind-protect (progn @@ -699,4 +717,4 @@ ;; If a temp directory was created, remove it and all its ;; contents. Is there a better way? (when ,dirname - (ext:run-program "/bin/rm" (list "-rf" (namestring ,dirname)))))))) + (recursive-delete-directory (namestring ,dirname))))))) ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -5998,25 +5998,23 @@ msgid "" " is returned to that path. The path ends with a \"/\" character." msgstr "" -#: src/code/extensions.lisp -msgid "Return a stream to a temporary file that is automatically created." -msgstr "" - #: src/code/extensions.lisp msgid "" "Creates a temporary file with a name bound to Filename which a\n" -" namestring. If Prefix is not provided, the temporary file is created\n" -" in a OS-dependent location. Otherwise the prefix is used as a prefix\n" -" for the name. On completion, the file is automatically removed." +" namestring. If Directory is not provided, the temporary file is created\n" +" in a OS-dependent location. The Prefix is a prefix to the file name\n" +" to be created. If not provided a default prefix is used.\n" +" On completion, the file is automatically removed." msgstr "" #: src/code/extensions.lisp msgid "" -"Return a namestring to a temporary directory. If Prefix is not\n" -" provided, the directory is created in an OS-dependent location.\n" -" Otherwise, the Prefix is a string that is used as a prefix for the\n" -" name of the temporary directory. The directory and all its contents\n" -" are automatically removed afterward." +"Return a namestring to a temporary directory. If Directory is not\n" +" provided, the directory is created in an OS-dependent location. The\n" +" Prefix is a string that is used as a prefix for the name of the\n" +" temporary directory. If Prefix is not given, a default prefix is\n" +" used. The directory and all its contents are automatically removed\n" +" afterward." msgstr "" #: src/code/commandline.lisp View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/cc969535d9f546a5ab79b77... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/cc969535d9f546a5ab79b77... You're receiving this email because of your account on gitlab.common-lisp.net.