[Git][cmucl/cmucl][issue-142-random-0-wrong-error] 5 commits: Fix #132: Ansi test RENAME-FILE.1 fails

Raymond Toy (@rtoy) gitlab at common-lisp.net
Sat Oct 15 23:29:14 UTC 2022



Raymond Toy pushed to branch issue-142-random-0-wrong-error at cmucl / cmucl


Commits:
cdd7d328 by Raymond Toy at 2022-10-15T14:39:32+00:00
Fix #132: Ansi test RENAME-FILE.1 fails

- - - - -
e0e9f62d by Raymond Toy at 2022-10-15T14:39:35+00:00
Merge branch 'issue-132-ansi-test-rename-files' into 'master'

Fix #132: Ansi test RENAME-FILE.1 fails

Closes #132

See merge request cmucl/cmucl!90
- - - - -
a05277c7 by Raymond Toy at 2022-10-15T20:53:20+00:00
Fix #134: Handle the case of (expt complex complex-rational)

- - - - -
4dacd5ac by Raymond Toy at 2022-10-15T20:53:20+00:00
Merge branch 'issue-134-expt-bug' into 'master'

Fix #134: Handle the case of (expt complex complex-rational)

Closes #134

See merge request cmucl/cmucl!91
- - - - -
c587c70f by Raymond Toy at 2022-10-15T16:28:18-07:00
Merge branch 'master' into issue-142-random-0-wrong-error

- - - - -


3 changed files:

- src/code/filesys.lisp
- src/code/irrat.lisp
- tests/issues.lisp


Changes:

=====================================
src/code/filesys.lisp
=====================================
@@ -950,7 +950,11 @@
   File after it was renamed."
   (let* ((original (truename file))
 	 (original-namestring (unix-namestring original t))
-	 (new-name (merge-pathnames new-name file))
+	 ;; First, merge NEW-FILE-NAME with *DEFAULT-PATHNAME-DEFAULTS* to
+	 ;; fill in the missing components and then merge again with
+	 ;; the FILE to get any missing components from FILE.
+	 (new-name (merge-pathnames (merge-pathnames new-name)
+				    file))
 	 (new-namestring (unix-namestring new-name nil)))
     (unless new-namestring
       (error 'simple-file-error


=====================================
src/code/irrat.lisp
=====================================
@@ -510,12 +510,12 @@
 	     (* base power)
 	     (exp (* power (* (log2 base 1w0) (log 2w0))))))
 	(((foreach fixnum (or bignum ratio) single-float)
-	  (foreach (complex single-float)))
+	  (foreach (complex rational) (complex single-float)))
 	 (if (and (zerop base) (plusp (realpart power)))
 	     (* base power)
 	     (exp (* power (log base)))))
 	(((foreach (complex rational) (complex single-float))
-	  (foreach single-float (complex single-float)))
+	  (foreach single-float (complex rational) (complex single-float)))
 	 (if (and (zerop base) (plusp (realpart power)))
 	     (* base power)
 	     (or (expt-xfrm (coerce base '(complex single-float)) power)
@@ -537,7 +537,7 @@
 		 (exp (* power (log (coerce base '(complex double-double-float))))))))
 	(((foreach (complex double-float))
 	  (foreach single-float double-float
-		   (complex single-float) (complex double-float)))
+		   (complex rational) (complex single-float) (complex double-float)))
 	 (if (and (zerop base) (plusp (realpart power)))
 	     (* base power)
 	     (or (expt-xfrm base power)
@@ -552,7 +552,7 @@
 		 (exp (* power (log (coerce base '(complex double-double-float))))))))
 	#+double-double
 	(((foreach (complex double-double-float))
-	  (foreach float (complex float)))
+	  (foreach float (complex float) (complex rational)))
 	 (if (and (zerop base) (plusp (realpart power)))
 	     (* base power)
 	     (or (expt-xfrm base power)


=====================================
tests/issues.lisp
=====================================
@@ -579,3 +579,94 @@
 	with user-info = (unix:unix-getpwuid uid)
 	while user-info
 	finally (assert-false user-info)))
+
+(define-test issue.132.1
+    (:tag :issues)
+  ;; From a message on cmucl-imp 2008/06/01.  If "d1" is a directory,
+  ;; (rename "d1" "d2") should rename the directory "d1" to "d2".
+  ;; Previously that produced an error trying to rename "d1" to
+  ;; "d1/d2".
+  ;;
+  ;; Create the test directory (that is a subdirectory of "dir").
+  (assert-true (ensure-directories-exist "dir/orig-dir/"))
+  (let ((*default-pathname-defaults* (merge-pathnames "dir/" (ext:default-directory))))
+    (multiple-value-bind (defaulted-new-name old-truename new-truename)
+	;; Rename "dir/orig-dir" to "orig/new-dir".
+	(rename-file "orig-dir/" "new-dir")
+      (let ((orig (merge-pathnames
+		   (make-pathname :directory '(:relative "orig-dir"))))
+	    (new (merge-pathnames
+		  (make-pathname :directory '(:relative "new-dir")))))
+	;; Ensure that the rename worked and that the returned values
+	;; have the expected values.
+	(assert-true defaulted-new-name)
+	(assert-equalp old-truename orig)
+	(assert-equalp new-truename new)))))
+
+(define-test issue.132.2
+    (:tag :issues)
+  (assert-true (ensure-directories-exist "dir/orig.dir/"))
+  (let ((*default-pathname-defaults* (merge-pathnames "dir/" (ext:default-directory))))
+    (multiple-value-bind (defaulted-new-name old-truename new-truename)
+	;; Rename "dir/orig.dir" to "orig/new-dir".  Since the
+	;; original name has a pathname-name of "orig" and a
+	;; pathname-type of "dir", the new file name is merged to
+	;; produce a pathname-name of "new" with a pathname-type of
+	;; "dir".
+	(rename-file "orig.dir" "new")
+      (let ((orig (merge-pathnames
+		   (make-pathname :directory '(:relative "orig.dir"))))
+	    (new (merge-pathnames
+		  (make-pathname :directory '(:relative "new.dir")))))
+	;; Ensure that the rename worked and that the returned values
+	;; have the expected values.
+	(assert-true defaulted-new-name)
+	(assert-equalp old-truename orig)
+	(assert-equalp new-truename new)))))
+
+(define-test issue.132.3
+    (:tag :issues)
+  (assert-true (ensure-directories-exist "dir/orig.dir/"))
+  (let ((*default-pathname-defaults* (merge-pathnames "dir/" (ext:default-directory))))
+    (multiple-value-bind (defaulted-new-name old-truename new-truename)
+	;; Rename "dir/orig.dir/" to "orig/new".  Note that the
+	;; original name is "orig.dir/" which marks a directory so
+	;; that when we merge the new name with the old to fill in
+	;; missing components, there are none because the old name is
+	;; a directory with no pathname-name or pathname-type, so the
+	;; new name stays the same.
+	(rename-file "orig.dir/" "new")
+      (let ((orig (merge-pathnames
+		   (make-pathname :directory '(:relative "orig.dir"))))
+	    (new (merge-pathnames
+		  (make-pathname :directory '(:relative "new")))))
+	;; Ensure that the rename worked and that the returned values
+	;; have the expected values.
+	(assert-true defaulted-new-name)
+	(assert-equalp old-truename orig)
+	(assert-equalp new-truename new)))))
+
+(define-test issue.134
+    (:tag :issues)
+  ;; Verify that we can compute (3+4*%i)^%i (in Maxima format).  This
+  ;; can be written analytically as
+  ;; %i*%e^-atan(4/3)*sin(log(5))+%e^-atan(4/3)*cos(log(5)), so use
+  ;; %this as the reference value.
+  (let ((answer (complex (* (cos (log 5w0))
+			    (exp (- (atan (float (/ 4 3) 0w0)))))
+			 (* (sin (log 5w0))
+			    (exp (- (atan (float (/ 4 3) 0w0))))))))
+    (flet ((relerr (actual true)
+	     ;; Return the relative error between ACTUAL and TRUE
+	     (/ (abs (- actual true))
+		(abs true))))
+      (dolist (test '((#c(3 4) 3.5918w-8)
+		      (#c(3.0 4) 3.5918w-8)
+		      (#c(3d0 4) 9.2977w-17)
+		      (#c(3w0 4) 0w0)))
+	(destructuring-bind (base eps)
+	    test
+	  (let* ((value (expt base #c(0 1)))
+		 (err (relerr value answer)))
+	    (assert-true (<= err eps) base err eps)))))))
+



View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/84848eaffb97b66b359b93b8e47433730d6d761e...c587c70fc3f5bcc62e1b6d471176878c27142ae6

-- 
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/84848eaffb97b66b359b93b8e47433730d6d761e...c587c70fc3f5bcc62e1b6d471176878c27142ae6
You're receiving this email because of your account on gitlab.common-lisp.net.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20221015/93dc132c/attachment-0001.html>


More information about the cmucl-cvs mailing list