Raymond Toy pushed to branch issue-373-handle-temp-files at cmucl / cmucl Commits: 71b5e795 by Raymond Toy at 2025-11-11T18:37:08-08:00 Let os_temporary_directory append a slash if needed. Update ext::get-os-temp-path so that it doesn't append a slash since os_temporary_directory does. Update pot file for new docstring too. - - - - - 4 changed files: - src/code/extensions.lisp - src/i18n/locale/cmucl.pot - src/lisp/Darwin-os.c - src/lisp/Linux-os.c Changes: ===================================== src/code/extensions.lisp ===================================== @@ -624,11 +624,7 @@ (error "Unable to find path to temporary directory")) (unwind-protect - (let* ((string (unix::%file->name (cast path c-call:c-string))) - (len (length string))) - (if (char= #\/ (aref string (1- len))) - string - (concatenate 'string string "/"))) + (unix::%file->name (cast path c-call:c-string)) (unless (alien:null-alien path) (alien:free-alien path))))) @@ -674,6 +670,7 @@ (when (pathnamep ,filename) (delete-file ,filename)))))) +#+nil (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 @@ -690,6 +687,25 @@ (unix:unix-rmdir (namestring dir)) (values)) +(defun delete-directory (dirname &key recursive) + _N"Delete the directory Dirname. If the Recursive is non-NIL, + recursively delete the directory Dirname including all files and + subdirectories. Dirname must be a pathname to a directory. Any NAME + or TYPE components in Dirname are ignored." + (declare (type pathname dirname)) + (when recusive + ;; Find all the files or directories in DIRNAME. + (dolist (path (directory (merge-pathnames "*.*" dirname))) + ;; 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) + (delete-directory path :recursive t) + (delete-file path)))) + ;; Finally delete the directory. + (unix:unix-rmdir (namestring dir)) + (values)) + + ;;; WITH-TEMPORARY-DIRECTORY -- Public (defmacro with-temporary-directory ((dirname &key directory (prefix "cmucl-temp-dir-")) &parse-body (forms decls)) @@ -717,4 +733,4 @@ ;; If a temp directory was created, remove it and all its ;; contents. Is there a better way? (when ,dirname - (recursive-delete-directory ,dirname)))))) + (delete-directory ,dirname :recursive t)))))) ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -6014,6 +6014,14 @@ msgid "" " or TYPE components in DIR are ignored." msgstr "" +#: src/code/extensions.lisp +msgid "" +"Delete the directory Dirname. If the Recursive is non-NIL,\n" +" recursively delete the directory Dirname including all files and\n" +" subdirectories. Dirname must be a pathname to a directory. Any NAME\n" +" or TYPE components in Dirname are ignored." +msgstr "" + #: src/code/extensions.lisp msgid "" "Return a namestring to a temporary directory. If Directory is not\n" ===================================== src/lisp/Darwin-os.c ===================================== @@ -588,6 +588,8 @@ os_temporary_directory(void) * macosx has a secure per-user temporary directory. * Don't cache the result as this is only called once. */ + int len; + char *result; char path[PATH_MAX]; int path_size = confstr(_CS_DARWIN_USER_TEMP_DIR, path, PATH_MAX); @@ -595,5 +597,18 @@ os_temporary_directory(void) strlcpy(path, "/tmp", sizeof(path)); } - return strdup(path); + /* Append a slash if needed */ + len = strlen(path); + result = malloc(len + 1); + + /* If malloc fails, just return NULL. */ + if (result) { + strcpy(result, path); + + if (path[len] != '/') { + strcat(result, "/"); + } + } + + return result; } ===================================== src/lisp/Linux-os.c ===================================== @@ -645,10 +645,25 @@ os_temporary_directory(void) * Otherwise, just assume "/tmp" will work. */ char *tmp_path = getenv("TMP"); + char *result; + int len; if (tmp_path == NULL) { tmp_path = "/tmp"; } - return strdup(tmp_path); + /* Append a slash if needed */ + len = strlen(tmp_path); + result = malloc(len + 1); + + /* If malloc fails, just return NULL. */ + if (result) { + strcpy(result, tmp_path); + + if (tmp_path[len] != '/') { + strcat(result, "/"); + } + } + + return result; } View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/71b5e7952e6502723aa37cb9... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/71b5e7952e6502723aa37cb9... You're receiving this email because of your account on gitlab.common-lisp.net.