GitLab

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.

       (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)))))

 	 (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

   (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))

 	 ;; 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))))))
 "  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"

      * 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);

 	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;

 }
      * 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;

 }

Raymond Toy pushed to branch issue-373-handle-temp-files at cmucl / cmucl

Commits:

4 changed files:

Changes: