GitLab

at 2025-12-17T07:04:10-08:00

Fix #457:  delete-directory signals errors

Merge branch 'issue-457-delete-directory-signals-errors' into 'master'

Fix #457:  delete-directory signals errors

Closes #457

See merge request cmucl/cmucl!336

 	     "INVALID-FASL"

 	     "WITH-TEMPORARY-DIRECTORY"

-	     "WITH-TEMPORARY-FILE")

+	     "WITH-TEMPORARY-FILE"

+	     "DELETE-DIRECTORY")

   ;; gencgc features

   #+gencgc

   (:export "GET-GC-ASSERTIONS"

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

+  subdirectories. Dirname must name a directory.  Any NAME or TYPE

+  components in Dirname are ignored.  A FILE-ERROR is signaled if any

+  directory cannot be deleted."

   (when recursive

     ;; Find all the files or directories in DIRNAME.

     (dolist (path (directory (merge-pathnames "*.*" dirname)))

 	  (delete-directory path :recursive t)

 	  (delete-file path))))

   ;; Finally delete the directory.

-  (unix:unix-rmdir (namestring dirname))

-  (values))

+  (multiple-value-bind (ok errno)

+      (unix:unix-rmdir (namestring dirname))

+    (unless ok

+      (error 'kernel:simple-file-error

+	     :pathname dirname

+	     :format-control (intl:gettext "Could not remove directory \"~A\": ~A.")

+	     :format-arguments (list dirname

+				     (unix:get-unix-error-msg errno))))

+    ok))

 ;;; WITH-TEMPORARY-DIRECTORY  -- Public

 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."

+"  subdirectories. Dirname must name a directory.  Any NAME or TYPE\n"

+"  components in Dirname are ignored.  A FILE-ERROR is signaled if any\n"

+"  directory cannot be deleted."

+msgstr ""

+

+#: src/code/extensions.lisp

+msgid "Could not remove directory \"~A\": ~A."

 msgstr ""

 #: src/code/extensions.lisp

       (assert-equal dir-tilde dir-home))))

 (define-test delete-directory

-  (let ((dir (ensure-directories-exist "tmp/a/b/c/")))

-    ;; Verify that the directories were created.

-    (assert-equal "tmp/a/b/c/"

-		  dir)

-    ;; Try to delete the directory.  It should fail, which we verify

-    ;; by noting the directory listing is not empty.

-    (ext::delete-directory (pathname "tmp/"))

-    (assert-true (directory "tmp/"))

-    ;; Now recursively delete the directory.

-    (ext::delete-directory (pathname "tmp/") :recursive t)

-    (assert-false (directory "tmp/"))))
+  (:tag :issues)

+  (ext:with-temporary-directory (path)

+    (let ((dir (ensure-directories-exist (merge-pathnames "tmp/a/b/c/" path))))

+      ;; Try to delete the directory.  It should fail..

+      (assert-error 'kernel:simple-file-error

+		    (ext:delete-directory (merge-pathnames "tmp/" path)))

+      ;; Now recursively delete the directory.

+      (assert-true (ext:delete-directory (merge-pathnames "tmp/" path)

+					 :recursive t))

+      (assert-false (directory "tmp/")))))

Raymond Toy pushed to branch master at cmucl / cmucl

Commits:

4 changed files:

Changes: