Raymond Toy pushed to branch issue-459-more-accurate-dd-complex-div at cmucl / cmucl Commits: fd2e83a1 by Raymond Toy at 2025-12-12T15:38:35-08:00 Fix two important typos in unix-get-username and delete-directory In `unix-get-username`, we were freeing `name` instead of `result`. In `delete-directory`, we misspelled `recursive` as `recusive`. Fix these typos. - - - - - b9494595 by Raymond Toy at 2025-12-12T15:54:05-08:00 Add some tests for unix-get-username and delete-directory Add a simple test that unix-get-username returns something useful. Add a test for delete-directory that tests it deletes directories as specified, include recursively. - - - - - e2b4641a by Raymond Toy at 2025-12-13T14:24:22-08:00 Fix #458: Fix spurious overflow in double-double multiply - - - - - 16097f45 by Raymond Toy at 2025-12-13T14:24:22-08:00 Merge branch 'issue-458-double-double-mult-overflow' into 'master' Fix #458: Fix spurious overflow in double-double multiply Closes #458 See merge request cmucl/cmucl!337 - - - - - 7d9f2c5e by Raymond Toy at 2025-12-13T14:27:29-08:00 Add comments. - - - - - 9f881b52 by Raymond Toy at 2025-12-13T14:28:58-08:00 Merge branch 'master' into issue-459-more-accurate-dd-complex-div - - - - - 6 changed files: - src/code/extensions.lisp - src/code/unix.lisp - src/compiler/float-tran-dd.lisp - tests/float.lisp - tests/pathname.lisp - tests/unix.lisp Changes: ===================================== src/code/extensions.lisp ===================================== @@ -676,7 +676,7 @@ subdirectories. Dirname must be a pathname to a directory. Any NAME or TYPE components in Dirname are ignored." (declare (type pathname dirname)) - (when recusive + (when recursive ;; Find all the files or directories in DIRNAME. (dolist (path (directory (merge-pathnames "*.*" dirname))) ;; If the path is a directory, recursively delete the directory. ===================================== src/code/unix.lisp ===================================== @@ -2564,5 +2564,5 @@ (cast result c-call:c-string) nil) status)) - (free-alien name))))) + (free-alien result))))) ===================================== src/compiler/float-tran-dd.lisp ===================================== @@ -701,6 +701,10 @@ ;; 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. +;; +;; This is a pretty straightforward change of +;; kernel::cdiv-double-float for double-double-float. The constants +;; may need some tweaking. (let* ((+dd-eps+ (scale-float 1w0 -104)) (+dd-rmin+ least-positive-normalized-double-double-float) (+dd-rbig+ (/ most-positive-double-double-float 2)) ===================================== tests/float.lisp ===================================== @@ -548,3 +548,10 @@ (coerce y '(complex single-float))) x y))) + + +;; Issue #458 +(define-test dd-mult-overflow + (:tag :issues) + (assert-equal -2w300 + (* -2w300 1w0))) ===================================== tests/pathname.lisp ===================================== @@ -142,3 +142,16 @@ "/*.*") :truenamep nil :follow-links nil))) (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/")))) ===================================== tests/unix.lisp ===================================== @@ -88,4 +88,7 @@ (assert-false result) (assert-true (and (integerp errno) (plusp errno))))) - +(define-test unix-get-username + (let ((uid (unix:unix-getuid))) + (assert-true uid) + (assert-true (unix::unix-get-username uid)))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/8d0c23e1afb107921adbe5b... -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/8d0c23e1afb107921adbe5b... You're receiving this email because of your account on gitlab.common-lisp.net.