Raymond Toy pushed to branch issue-456-more-accurate-complex-div at cmucl / cmucl Commits: e65f9f5c by Raymond Toy at 2025-12-17T07:04:10-08:00 Fix #457: delete-directory signals errors - - - - - 6034f935 by Raymond Toy at 2025-12-17T07:04:10-08:00 Merge branch 'issue-457-delete-directory-signals-errors' into 'master' Fix #457: delete-directory signals errors Closes #457 See merge request cmucl/cmucl!336 - - - - - 10efd37c by Raymond Toy at 2025-12-17T07:12:47-08:00 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] - - - - - c6c3c48f by Raymond Toy at 2025-12-17T07:25:38-08:00 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`. - - - - - c09d2252 by Raymond Toy at 2025-12-17T07:27:33-08:00 Merge branch 'master' into issue-456-more-accurate-complex-div - - - - - 6 changed files: - src/code/exports.lisp - src/code/extensions.lisp - src/code/numbers.lisp - src/i18n/locale/cmucl.pot - tests/float.lisp - tests/pathname.lisp Changes: ===================================== src/code/exports.lisp ===================================== @@ -1213,7 +1213,8 @@ "INVALID-FASL" "WITH-TEMPORARY-DIRECTORY" - "WITH-TEMPORARY-FILE") + "WITH-TEMPORARY-FILE" + "DELETE-DIRECTORY") ;; gencgc features #+gencgc (:export "GET-GC-ASSERTIONS" ===================================== src/code/extensions.lisp ===================================== @@ -673,9 +673,9 @@ (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))) @@ -685,8 +685,15 @@ (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 ===================================== src/code/numbers.lisp ===================================== @@ -602,16 +602,17 @@ ;; 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))) @@ -619,7 +620,7 @@ ((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). ;; @@ -713,7 +714,8 @@ (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 @@ -850,7 +852,7 @@ (((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)) ===================================== src/i18n/locale/cmucl.pot ===================================== @@ -6011,8 +6011,13 @@ msgstr "" 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 ===================================== tests/float.lisp ===================================== @@ -343,8 +343,6 @@ (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) ===================================== tests/pathname.lisp ===================================== @@ -144,14 +144,13 @@ (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/"))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/11f3df65cc2a115fbd82571... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/11f3df65cc2a115fbd82571... You're receiving this email because of your account on gitlab.common-lisp.net.