GitLab

at 2025-12-13T14:24:22-08:00

Fix #458:  Fix spurious overflow in double-double multiply

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
Add fixed issue #458 to release notes

Forgot to do that.

[skip-ci]

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

Minor cleanups

Fix typo in exports.lisp so DELETE-DIRECTORY is actually exported.

Update docstring for DELETE-DIRECTORY and the pot file.

For tests/pathname.lisp, use WITH-TEMPORARY-DIRECTORY to create a temp
directory which we'll populate with some subdirectories to test how
DELETE-DIRECTORY works.

 	     "INVALID-FASL"

 	     "WITH-TEMPORARY-DIRECTORY"

 	     "WITH-TEMPORARY-FILE"

-	     "DELETE-DIRETORY")

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

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

 	   (optimize (speed 3)))

   ;; If the numbers are too big, scale them done so SPLIT doesn't overflow.

   (multiple-value-bind (aa bb)

-      (values (if (> a +two970+)

+      (values (if (> (abs a) +two970+)

 		  (* a +two-53+)

 		  a)

-	      (if (> b +two970+)

+	      (if (> (abs b) +two970+)

 		  (* b +two-53+)

 		  b))

     (let ((p (* aa bb)))

 		(declare (optimize (inhibit-warnings 3)))

 	      ;; If the numbers was scaled down, we need to scale the

 	      ;; result back up.

-	      (when (> a +two970+)

+	      (when (> (abs a) +two970+)

 		(setf p (* p +two53+)

 		      e (* e +two53+)))

-	      (when (> b +two970+)

+	      (when (> (abs b) +two970+)

 		(setf p (* p +two53+)

 		      e (* e +two53+)))

 	      (values p e))))))))

     * #446: Use C compiler to get errno values to update UNIX

             defpackage with errno symbols

     * #453: Use correct flags for analyzer and always save logs.

+    * #458: Spurious overflow in double-double-float multiply

   * Other changes:

   * Improvements to the PCL implementation of CLOS:

   * Changes to building procedure:

 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

 			     (x86::x87-floating-point-modes)))))

     (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 -2w300

+		(* -2w300 1w0)))
       (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..

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

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

-    ;; Now recursively delete the directory.

-    (assert-true (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-457-delete-directory-signals-errors at cmucl / cmucl

Commits:

7 changed files:

Changes: