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
Remove extra blank lines

Addresses comment from !337:
https://gitlab.common-lisp.net/cmucl/cmucl/-/merge_requests/337#note_18529

Don't need to run CI for this.

[skip-ci]

Fix up some typos and reorder constants a bit

Some of the comments were wrong for the new division algorithm.  Also
slightly reorder constants for cdiv-double-float and add comment on
why `+eps+` has the value it does instead of `double-float-epsilon`.

Merge branch 'master' into issue-456-more-accurate-complex-div

 	     "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

 ;; In particular iteration 1 and 3 are added.  Iteration 2 and 4 were

 ;; not added.  The test examples from iteration 2 and 4 didn't change

 ;; with or without changes added.

-(let* ((+eps+ (scale-float 1d0 -52))

-       (+rmin+ least-positive-normalized-double-float)

+(let* ((+rmin+ least-positive-normalized-double-float)

        (+rbig+ (/ most-positive-double-float 2))

        (+rmin2+ (scale-float 1d0 -53))

        (+rminscal+ (scale-float 1d0 51))

        (+rmax2+ (* +rbig+ +rmin2+))

+       ;; The value of %eps in Scilab

+       (+eps+ (scale-float 1d0 -52))

        (+be+ (/ 2 (* +eps+ +eps+)))

        (+2/eps+ (/ 2 +eps+)))

-  (declare (double-float +eps+ +rmin+ +rbig+ +rmin2+

-			 +rminscal+ +rmax2+ +be+ +2/eps+))

+  (declare (double-float +rmin+ +rbig+ +rmin2+ +rminscal+ +rmax2+

+			 +eps+ +be+ +2/eps+))

   (defun cdiv-double-float (x y)

     (declare (type (complex double-float) x y)

 	     (optimize (speed 3) (safety 0)))

 	((internal-compreal (a b c d r tt)

 	   (declare (double-float a b c d r tt))

 	   ;; Compute the real part of the complex division

-	   ;; (a+ib)/(c+id), assuming |c| <= |d|.  r = d/c and tt = 1/(c+d*r).

+	   ;; (a+ib)/(c+id), assuming |d| <= |c|.  r = d/c and tt = 1/(c+d*r).

 	   ;;

 	   ;; The realpart is (a*c+b*d)/(c^2+d^2).

 	   ;;

 		 (t

 		  ;; |d| > |c|.  So, instead compute

 		  ;;

-		  ;;   (b + i*a)/(d + i*c) = ((b*d+a*c) + (a*d-b*c)*i)/(d^2+c^2)

+		  ;;   (b + i*a)/(d + i*c)

+		  ;;     = ((b*d+a*c) + (a*d-b*c)*i)/(d^2+c^2)

 		  ;;

 		  ;; Compare this to (a+i*b)/(c+i*d) and we see that

 		  ;; realpart of the former is the same, but the

     (((complex rational)

       (complex rational))

      ;; We probably don't need to do Smith's algorithm for rationals.

-     ;; A naive implementation of coplex division has no issues.

+     ;; A naive implementation of complex division has no issues.

      (let ((a (realpart x))

 	   (b (imagpart x))

 	   (c (realpart y))

 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-true (typep new-mode 'x86::float-modes))

     (assert-equal new-mode (setf (x86::x87-floating-point-modes) new-mode))))

-

-

 ;; Issue #458

 (define-test dd-mult-overflow

   (:tag :issues)

       (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 issue-456-more-accurate-complex-div at cmucl / cmucl

Commits:

6 changed files:

Changes: