cmucl-cvs

cmucl-cvs@common-lisp.net

2904 discussions

[Git][cmucl/cmucl][issue-140-stream-element-type-two-way-stream] Throw error if the stream is not a file stream.
by Raymond Toy (＠rtoy) 17 Oct '22

17 Oct '22

Raymond Toy pushed to branch issue-140-stream-element-type-two-way-stream at cmucl / cmucl Commits: 08f76fc3 by Raymond Toy at 2022-10-17T09:46:45-07:00 Throw error if the stream is not a file stream. Update test to verify that a type error is thrown. - - - - - 2 changed files: - src/code/stream.lisp - tests/issues.lisp Changes: ===================================== src/code/stream.lisp ===================================== @@ -291,23 +291,12 @@ ;; simple-stream (stream::%stream-external-format stream) ;; lisp-stream - (typecase stream + ;; The stream is a file stream; signal an error if it's not. + (etypecase stream #+unicode (fd-stream (fd-stream-external-format stream)) (synonym-stream (stream-external-format - (symbol-value (synonym-stream-symbol stream)))) - (two-way-stream - (let ((input-format - (stream-external-format (two-way-stream-input-stream stream))) - (output-format - (stream-external-format (two-way-stream-output-stream stream)))) - ;; If the input and output streams have the same format, we - ;; can return the format. If they differ, it's not clear - ;; what to do, so just return :default. - (if (eql input-format output-format) - input-format - :default))) - (t :default)) + (symbol-value (synonym-stream-symbol stream))))) ;; fundamental-stream :default)) ===================================== tests/issues.lisp ===================================== @@ -672,12 +672,7 @@ (define-test issue.140 (:tag :issues) - ;; Make sure *standard-input* is a two-way-stream - (assert-true (typep *standard-input* 'two-way-stream)) - (let ((input-format (stream-external-format - (two-way-stream-input-stream *standard-input*))) - (output-format (stream-external-format - (two-way-stream-output-stream *standard-input*)))) - ;; By default, the input and output formats should be the same. - (assert-eql input-format output-format) - (assert-eql input-format (stream-external-format *standard-input*)))) + (with-output-to-string (out) + (with-input-from-string (in "abc") + (let ((two-way-stream (make-two-way-stream in out))) + (assert-error 'type-error (stream-external-format two-way-stream)))))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/08f76fc37691ab430bb4561… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/08f76fc37691ab430bb4561… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-140-stream-element-type-two-way-stream] 8 commits: Fix #142: (random 0) signals incorrect error
by Raymond Toy (＠rtoy) 17 Oct '22

17 Oct '22

Raymond Toy pushed to branch issue-140-stream-element-type-two-way-stream at cmucl / cmucl Commits: cde14045 by Raymond Toy at 2022-10-16T14:26:39+00:00 Fix #142: (random 0) signals incorrect error - - - - - 4c9cbf43 by Raymond Toy at 2022-10-16T14:26:41+00:00 Merge branch 'issue-142-random-0-wrong-error' into 'master' Fix #142: (random 0) signals incorrect error Closes #142 See merge request cmucl/cmucl!99 - - - - - b59185fc by Raymond Toy at 2022-10-16T14:27:39+00:00 Fix #136: ensure-directories-exist should return the given pathspec - - - - - 49ecc858 by Raymond Toy at 2022-10-16T14:27:39+00:00 Merge branch 'issue-136-ansi-test-ensure-directories-exist.8' into 'master' Fix #136: ensure-directories-exist should return the given pathspec Closes #136 See merge request cmucl/cmucl!92 - - - - - 08e5370a by Raymond Toy at 2022-10-16T07:33:23-07:00 Update release notes based on recent merges Forgot to update the release notes with recent merges that fixed a few issues. Hence update the notes now. Also testing see if we need to add a strikeout for closed issues, so didn't add strikeout for these. - - - - - 556b1a5b by Raymond Toy at 2022-10-16T07:35:57-07:00 Add strikeout for closed issues Nope, gitlab doesn't mark closed issues in anyway, unlike Trac that would automatically strikeout references to closed issues. We have to do it ourselves. - - - - - 95b4fc5c by Raymond Toy at 2022-10-16T13:05:09-07:00 Fix #146: CI passes incorrectly We forgot to update the script for macos to use separate `grep` commands like we did for linux. - - - - - cb749b6d by Raymond Toy at 2022-10-17T08:52:54-07:00 Merge branch 'master' into issue-140-stream-element-type-two-way-stream - - - - - 5 changed files: - .gitlab-ci.yml - src/code/filesys.lisp - src/code/rand-xoroshiro.lisp - src/general-info/release-21e.md - tests/filesys.lisp Changes: ===================================== .gitlab-ci.yml ===================================== @@ -167,7 +167,8 @@ osx:ansi-test: script: - cd ansi-test - make LISP="../dist/bin/lisp -batch -noinit -nositeinit" - - grep 'No unexpected \(successes\|failures\)' test.out + # There should be no unexpected successes or failures; check these separately. + - grep -a 'No unexpected successes' test.out && grep -a 'No unexpected failures' test.out osx:benchmark: stage: benchmark ===================================== src/code/filesys.lisp ===================================== @@ -1478,4 +1478,4 @@ optionally keeping some of the most recent old versions." (retry () :report "Try to create the directory again" (go retry)))))) ;; Only the first path in a search-list is considered. - (return (values pathname created-p)))))) + (return (values pathspec created-p)))))) ===================================== src/code/rand-xoroshiro.lisp ===================================== @@ -491,8 +491,8 @@ (t (error 'simple-type-error :expected-type '(or (integer 1) (float (0.0))) :datum arg - :format-control _"Argument is not a positive integer or a positive float: ~S") - :format-arguments (list arg)))) + :format-control _"Argument is not a positive integer or a positive float: ~S" + :format-arguments (list arg))))) ;; Jump function for the generator. See the jump function in ;; http://xoroshiro.di.unimi.it/xoroshiro128plus.c ===================================== src/general-info/release-21e.md ===================================== @@ -50,9 +50,14 @@ public domain. * ~~#113~~ REQUIRE on contribs can pull in the wrong things via ASDF. * ~~#121~~ Wrong column index in FILL-POINTER-OUTPUT-STREAM * ~~#122~~ gcc 11 can't build cmucl + * ~~#125~~ Linux `unix-stat` returning incorrect values * ~~#127~~ Linux unix-getpwuid segfaults when given non-existent uid. * ~~#128~~ `QUIT` accepts an exit code + * ~~#132~~ Ansi test `RENAME-FILE.1` no fails + * ~~#134~~ Handle the case of `(expt complex complex-rational)` + * ~~#136~~ `ensure-directories-exist` should return the given pathspec * ~~#140~~ External format of `two-way-stream` returns the common format of the input and output streams if possible; otherwise, return `:default`. + * ~~#142~~ `(random 0)` signals incorrect error * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: ===================================== tests/filesys.lisp ===================================== @@ -10,7 +10,7 @@ (define-test unix-namestring.1.exists ;; Make sure the desired directories exist. - (assert-equal #P"/tmp/foo/bar/hello.txt" + (assert-equal "/tmp/foo/bar/hello.txt" (ensure-directories-exist "/tmp/foo/bar/hello.txt")) (dolist (path '("/tmp/hello.txt" "/tmp/foo/" @@ -27,7 +27,7 @@ (define-test unix-namestring.1.non-existent ;; Make sure the desired directories exist. - (assert-equal #P"/tmp/foo/bar/hello.txt" + (assert-equal "/tmp/foo/bar/hello.txt" (ensure-directories-exist "/tmp/foo/bar/hello.txt")) ;; These paths contain directories that don't exist. (dolist (path '("/tmp/oops/" @@ -42,7 +42,7 @@ (define-test unix-namestring.2 ;; Make sure the desired directories exist. - (assert-equal #P"/tmp/foo/bar/hello.txt" + (assert-equal "/tmp/foo/bar/hello.txt" (ensure-directories-exist "/tmp/foo/bar/hello.txt")) (unwind-protect (progn View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/480f9c604bb6a4c4e18895… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/480f9c604bb6a4c4e18895… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] Fix #146: CI passes incorrectly
by Raymond Toy (＠rtoy) 16 Oct '22

16 Oct '22

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 95b4fc5c by Raymond Toy at 2022-10-16T13:05:09-07:00 Fix #146: CI passes incorrectly We forgot to update the script for macos to use separate `grep` commands like we did for linux. - - - - - 1 changed file: - .gitlab-ci.yml Changes: ===================================== .gitlab-ci.yml ===================================== @@ -167,7 +167,8 @@ osx:ansi-test: script: - cd ansi-test - make LISP="../dist/bin/lisp -batch -noinit -nositeinit" - - grep 'No unexpected \(successes\|failures\)' test.out + # There should be no unexpected successes or failures; check these separately. + - grep -a 'No unexpected successes' test.out && grep -a 'No unexpected failures' test.out osx:benchmark: stage: benchmark View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/95b4fc5c7629530925acfa8… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/95b4fc5c7629530925acfa8… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-141-locale] 7 commits: Fix #132: Ansi test RENAME-FILE.1 fails
by Raymond Toy (＠rtoy) 16 Oct '22

16 Oct '22

Raymond Toy pushed to branch issue-141-locale at cmucl / cmucl Commits: a5767df5 by Raymond Toy at 2022-10-16T11:12:14-07:00 Fix #132: Ansi test RENAME-FILE.1 fails - - - - - 6a9c3afb by Raymond Toy at 2022-10-16T11:12:14-07:00 Fix #134: Handle the case of (expt complex complex-rational) - - - - - 119ec29f by Raymond Toy at 2022-10-16T11:12:14-07:00 Fix #146: CI passes incorrectly - - - - - 34badd6a by Raymond Toy at 2022-10-16T11:12:14-07:00 Fix #142: (random 0) signals incorrect error - - - - - cab4212d by Raymond Toy at 2022-10-16T11:12:14-07:00 Fix #136: ensure-directories-exist should return the given pathspec - - - - - 237d001c by Raymond Toy at 2022-10-16T11:12:14-07:00 Update release notes based on recent merges Forgot to update the release notes with recent merges that fixed a few issues. Hence update the notes now. Also testing see if we need to add a strikeout for closed issues, so didn't add strikeout for these. - - - - - 82ac3a68 by Raymond Toy at 2022-10-16T11:12:14-07:00 Add strikeout for closed issues Nope, gitlab doesn't mark closed issues in anyway, unlike Trac that would automatically strikeout references to closed issues. We have to do it ourselves. - - - - - 7 changed files: - .gitlab-ci.yml - src/code/filesys.lisp - src/code/irrat.lisp - src/code/rand-xoroshiro.lisp - src/general-info/release-21e.md - tests/filesys.lisp - tests/issues.lisp Changes: ===================================== .gitlab-ci.yml ===================================== @@ -80,7 +80,8 @@ linux:ansi-test: script: - cd ansi-test - make LISP="../dist/bin/lisp -batch -noinit -nositeinit" - - grep 'No unexpected \(successes\|failures\)' test.out + # There should be no unexpected successes or failures; check these separately. + - grep -a 'No unexpected successes' test.out && grep -a 'No unexpected failures' test.out linux:benchmark: stage: benchmark ===================================== 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 @@ -1474,4 +1478,4 @@ optionally keeping some of the most recent old versions." (retry () :report "Try to create the directory again" (go retry)))))) ;; Only the first path in a search-list is considered. - (return (values pathname created-p)))))) + (return (values pathspec created-p)))))) ===================================== 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) ===================================== src/code/rand-xoroshiro.lisp ===================================== @@ -491,8 +491,8 @@ (t (error 'simple-type-error :expected-type '(or (integer 1) (float (0.0))) :datum arg - :format-control _"Argument is not a positive integer or a positive float: ~S") - :format-arguments (list arg)))) + :format-control _"Argument is not a positive integer or a positive float: ~S" + :format-arguments (list arg))))) ;; Jump function for the generator. See the jump function in ;; http://xoroshiro.di.unimi.it/xoroshiro128plus.c ===================================== src/general-info/release-21e.md ===================================== @@ -50,8 +50,13 @@ public domain. * ~~#113~~ REQUIRE on contribs can pull in the wrong things via ASDF. * ~~#121~~ Wrong column index in FILL-POINTER-OUTPUT-STREAM * ~~#122~~ gcc 11 can't build cmucl + * ~~#125~~ Linux `unix-stat` returning incorrect values * ~~#127~~ Linux unix-getpwuid segfaults when given non-existent uid. * ~~#128~~ `QUIT` accepts an exit code + * ~~#132~~ Ansi test `RENAME-FILE.1` no fails + * ~~#134~~ Handle the case of `(expt complex complex-rational)` + * ~~#136~~ `ensure-directories-exist` should return the given pathspec + * ~~#142~~ `(random 0)` signals incorrect error * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: ===================================== tests/filesys.lisp ===================================== @@ -10,7 +10,7 @@ (define-test unix-namestring.1.exists ;; Make sure the desired directories exist. - (assert-equal #P"/tmp/foo/bar/hello.txt" + (assert-equal "/tmp/foo/bar/hello.txt" (ensure-directories-exist "/tmp/foo/bar/hello.txt")) (dolist (path '("/tmp/hello.txt" "/tmp/foo/" @@ -27,7 +27,7 @@ (define-test unix-namestring.1.non-existent ;; Make sure the desired directories exist. - (assert-equal #P"/tmp/foo/bar/hello.txt" + (assert-equal "/tmp/foo/bar/hello.txt" (ensure-directories-exist "/tmp/foo/bar/hello.txt")) ;; These paths contain directories that don't exist. (dolist (path '("/tmp/oops/" @@ -42,7 +42,7 @@ (define-test unix-namestring.2 ;; Make sure the desired directories exist. - (assert-equal #P"/tmp/foo/bar/hello.txt" + (assert-equal "/tmp/foo/bar/hello.txt" (ensure-directories-exist "/tmp/foo/bar/hello.txt")) (unwind-protect (progn ===================================== 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/abf0b3dcc9b44454e6bbcb… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/abf0b3dcc9b44454e6bbcb… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-135-unix-namestring-dot] 13 commits: Fix #132: Ansi test RENAME-FILE.1 fails
by Raymond Toy (＠rtoy) 16 Oct '22

16 Oct '22

Raymond Toy pushed to branch issue-135-unix-namestring-dot 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 - - - - - 8719b21c by Raymond Toy at 2022-10-15T23:27:33+00:00 Fix #146: CI passes incorrectly - - - - - 9c0f63ff by Raymond Toy at 2022-10-15T23:27:34+00:00 Merge branch 'issue-146-ci-passes-incorrectly' into 'master' Fix #146: CI passes incorrectly Closes #146 See merge request cmucl/cmucl!100 - - - - - cde14045 by Raymond Toy at 2022-10-16T14:26:39+00:00 Fix #142: (random 0) signals incorrect error - - - - - 4c9cbf43 by Raymond Toy at 2022-10-16T14:26:41+00:00 Merge branch 'issue-142-random-0-wrong-error' into 'master' Fix #142: (random 0) signals incorrect error Closes #142 See merge request cmucl/cmucl!99 - - - - - b59185fc by Raymond Toy at 2022-10-16T14:27:39+00:00 Fix #136: ensure-directories-exist should return the given pathspec - - - - - 49ecc858 by Raymond Toy at 2022-10-16T14:27:39+00:00 Merge branch 'issue-136-ansi-test-ensure-directories-exist.8' into 'master' Fix #136: ensure-directories-exist should return the given pathspec Closes #136 See merge request cmucl/cmucl!92 - - - - - 08e5370a by Raymond Toy at 2022-10-16T07:33:23-07:00 Update release notes based on recent merges Forgot to update the release notes with recent merges that fixed a few issues. Hence update the notes now. Also testing see if we need to add a strikeout for closed issues, so didn't add strikeout for these. - - - - - 556b1a5b by Raymond Toy at 2022-10-16T07:35:57-07:00 Add strikeout for closed issues Nope, gitlab doesn't mark closed issues in anyway, unlike Trac that would automatically strikeout references to closed issues. We have to do it ourselves. - - - - - 24cc68e5 by Raymond Toy at 2022-10-16T07:39:27-07:00 Merge branch 'master' into issue-135-unix-namestring-dot - - - - - 7 changed files: - .gitlab-ci.yml - src/code/filesys.lisp - src/code/irrat.lisp - src/code/rand-xoroshiro.lisp - src/general-info/release-21e.md - tests/filesys.lisp - tests/issues.lisp Changes: ===================================== .gitlab-ci.yml ===================================== @@ -80,7 +80,8 @@ linux:ansi-test: script: - cd ansi-test - make LISP="../dist/bin/lisp -batch -noinit -nositeinit" - - grep 'No unexpected \(successes\|failures\)' test.out + # There should be no unexpected successes or failures; check these separately. + - grep -a 'No unexpected successes' test.out && grep -a 'No unexpected failures' test.out linux:benchmark: stage: benchmark ===================================== src/code/filesys.lisp ===================================== @@ -952,7 +952,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 @@ -1476,4 +1480,4 @@ optionally keeping some of the most recent old versions." (retry () :report "Try to create the directory again" (go retry)))))) ;; Only the first path in a search-list is considered. - (return (values pathname created-p)))))) + (return (values pathspec created-p)))))) ===================================== 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) ===================================== src/code/rand-xoroshiro.lisp ===================================== @@ -491,8 +491,8 @@ (t (error 'simple-type-error :expected-type '(or (integer 1) (float (0.0))) :datum arg - :format-control _"Argument is not a positive integer or a positive float: ~S") - :format-arguments (list arg)))) + :format-control _"Argument is not a positive integer or a positive float: ~S" + :format-arguments (list arg))))) ;; Jump function for the generator. See the jump function in ;; http://xoroshiro.di.unimi.it/xoroshiro128plus.c ===================================== src/general-info/release-21e.md ===================================== @@ -50,8 +50,13 @@ public domain. * ~~#113~~ REQUIRE on contribs can pull in the wrong things via ASDF. * ~~#121~~ Wrong column index in FILL-POINTER-OUTPUT-STREAM * ~~#122~~ gcc 11 can't build cmucl + * ~~#125~~ Linux `unix-stat` returning incorrect values * ~~#127~~ Linux unix-getpwuid segfaults when given non-existent uid. * ~~#128~~ `QUIT` accepts an exit code + * ~~#132~~ Ansi test `RENAME-FILE.1` no fails + * ~~#134~~ Handle the case of `(expt complex complex-rational)` + * ~~#136~~ `ensure-directories-exist` should return the given pathspec + * ~~#142~~ `(random 0)` signals incorrect error * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: ===================================== tests/filesys.lisp ===================================== @@ -10,7 +10,7 @@ (define-test unix-namestring.1.exists ;; Make sure the desired directories exist. - (assert-equal #P"/tmp/foo/bar/hello.txt" + (assert-equal "/tmp/foo/bar/hello.txt" (ensure-directories-exist "/tmp/foo/bar/hello.txt")) (dolist (path '("/tmp/hello.txt" "/tmp/foo/" @@ -27,7 +27,7 @@ (define-test unix-namestring.1.non-existent ;; Make sure the desired directories exist. - (assert-equal #P"/tmp/foo/bar/hello.txt" + (assert-equal "/tmp/foo/bar/hello.txt" (ensure-directories-exist "/tmp/foo/bar/hello.txt")) ;; These paths contain directories that don't exist. (dolist (path '("/tmp/oops/" @@ -42,7 +42,7 @@ (define-test unix-namestring.2 ;; Make sure the desired directories exist. - (assert-equal #P"/tmp/foo/bar/hello.txt" + (assert-equal "/tmp/foo/bar/hello.txt" (ensure-directories-exist "/tmp/foo/bar/hello.txt")) (unwind-protect (progn ===================================== tests/issues.lisp ===================================== @@ -580,6 +580,96 @@ 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))))))) + (define-test issue.135 (:tag :issues) (assert-equalp "." (ext:unix-namestring ".")) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/777ccaebb94ed0ccbf5e8f… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/777ccaebb94ed0ccbf5e8f… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] Add strikeout for closed issues
by Raymond Toy (＠rtoy) 16 Oct '22

16 Oct '22

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 556b1a5b by Raymond Toy at 2022-10-16T07:35:57-07:00 Add strikeout for closed issues Nope, gitlab doesn't mark closed issues in anyway, unlike Trac that would automatically strikeout references to closed issues. We have to do it ourselves. - - - - - 1 changed file: - src/general-info/release-21e.md Changes: ===================================== src/general-info/release-21e.md ===================================== @@ -50,13 +50,13 @@ public domain. * ~~#113~~ REQUIRE on contribs can pull in the wrong things via ASDF. * ~~#121~~ Wrong column index in FILL-POINTER-OUTPUT-STREAM * ~~#122~~ gcc 11 can't build cmucl - * #125 Linux `unix-stat` returning incorrect values + * ~~#125~~ Linux `unix-stat` returning incorrect values * ~~#127~~ Linux unix-getpwuid segfaults when given non-existent uid. * ~~#128~~ `QUIT` accepts an exit code - * #132 Ansi test `RENAME-FILE.1` no fails - * #134 Handle the case of `(expt complex complex-rational)` - * #136 `ensure-directories-exist` should return the given pathspec - * #142 `(random 0)` signals incorrect error + * ~~#132~~ Ansi test `RENAME-FILE.1` no fails + * ~~#134~~ Handle the case of `(expt complex complex-rational)` + * ~~#136~~ `ensure-directories-exist` should return the given pathspec + * ~~#142~~ `(random 0)` signals incorrect error * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/556b1a5b94c4575c770aca9… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/556b1a5b94c4575c770aca9… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] Update release notes based on recent merges
by Raymond Toy (＠rtoy) 16 Oct '22

16 Oct '22

Raymond Toy pushed to branch master at cmucl / cmucl Commits: 08e5370a by Raymond Toy at 2022-10-16T07:33:23-07:00 Update release notes based on recent merges Forgot to update the release notes with recent merges that fixed a few issues. Hence update the notes now. Also testing see if we need to add a strikeout for closed issues, so didn't add strikeout for these. - - - - - 1 changed file: - src/general-info/release-21e.md Changes: ===================================== src/general-info/release-21e.md ===================================== @@ -50,8 +50,13 @@ public domain. * ~~#113~~ REQUIRE on contribs can pull in the wrong things via ASDF. * ~~#121~~ Wrong column index in FILL-POINTER-OUTPUT-STREAM * ~~#122~~ gcc 11 can't build cmucl + * #125 Linux `unix-stat` returning incorrect values * ~~#127~~ Linux unix-getpwuid segfaults when given non-existent uid. * ~~#128~~ `QUIT` accepts an exit code + * #132 Ansi test `RENAME-FILE.1` no fails + * #134 Handle the case of `(expt complex complex-rational)` + * #136 `ensure-directories-exist` should return the given pathspec + * #142 `(random 0)` signals incorrect error * Other changes: * Improvements to the PCL implementation of CLOS: * Changes to building procedure: View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/08e5370a77740d4986f16c5… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/08e5370a77740d4986f16c5… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #136: ensure-directories-exist should return the given pathspec
by Raymond Toy (＠rtoy) 16 Oct '22

16 Oct '22

Raymond Toy pushed to branch master at cmucl / cmucl Commits: b59185fc by Raymond Toy at 2022-10-16T14:27:39+00:00 Fix #136: ensure-directories-exist should return the given pathspec - - - - - 49ecc858 by Raymond Toy at 2022-10-16T14:27:39+00:00 Merge branch 'issue-136-ansi-test-ensure-directories-exist.8' into 'master' Fix #136: ensure-directories-exist should return the given pathspec Closes #136 See merge request cmucl/cmucl!92 - - - - - 2 changed files: - src/code/filesys.lisp - tests/filesys.lisp Changes: ===================================== src/code/filesys.lisp ===================================== @@ -1478,4 +1478,4 @@ optionally keeping some of the most recent old versions." (retry () :report "Try to create the directory again" (go retry)))))) ;; Only the first path in a search-list is considered. - (return (values pathname created-p)))))) + (return (values pathspec created-p)))))) ===================================== tests/filesys.lisp ===================================== @@ -10,7 +10,7 @@ (define-test unix-namestring.1.exists ;; Make sure the desired directories exist. - (assert-equal #P"/tmp/foo/bar/hello.txt" + (assert-equal "/tmp/foo/bar/hello.txt" (ensure-directories-exist "/tmp/foo/bar/hello.txt")) (dolist (path '("/tmp/hello.txt" "/tmp/foo/" @@ -27,7 +27,7 @@ (define-test unix-namestring.1.non-existent ;; Make sure the desired directories exist. - (assert-equal #P"/tmp/foo/bar/hello.txt" + (assert-equal "/tmp/foo/bar/hello.txt" (ensure-directories-exist "/tmp/foo/bar/hello.txt")) ;; These paths contain directories that don't exist. (dolist (path '("/tmp/oops/" @@ -42,7 +42,7 @@ (define-test unix-namestring.2 ;; Make sure the desired directories exist. - (assert-equal #P"/tmp/foo/bar/hello.txt" + (assert-equal "/tmp/foo/bar/hello.txt" (ensure-directories-exist "/tmp/foo/bar/hello.txt")) (unwind-protect (progn View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/4c9cbf436e6cab06cb3ed7… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/4c9cbf436e6cab06cb3ed7… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][master] 2 commits: Fix #142: (random 0) signals incorrect error
by Raymond Toy (＠rtoy) 16 Oct '22

16 Oct '22

Raymond Toy pushed to branch master at cmucl / cmucl Commits: cde14045 by Raymond Toy at 2022-10-16T14:26:39+00:00 Fix #142: (random 0) signals incorrect error - - - - - 4c9cbf43 by Raymond Toy at 2022-10-16T14:26:41+00:00 Merge branch 'issue-142-random-0-wrong-error' into 'master' Fix #142: (random 0) signals incorrect error Closes #142 See merge request cmucl/cmucl!99 - - - - - 1 changed file: - src/code/rand-xoroshiro.lisp Changes: ===================================== src/code/rand-xoroshiro.lisp ===================================== @@ -491,8 +491,8 @@ (t (error 'simple-type-error :expected-type '(or (integer 1) (float (0.0))) :datum arg - :format-control _"Argument is not a positive integer or a positive float: ~S") - :format-arguments (list arg)))) + :format-control _"Argument is not a positive integer or a positive float: ~S" + :format-arguments (list arg))))) ;; Jump function for the generator. See the jump function in ;; http://xoroshiro.di.unimi.it/xoroshiro128plus.c View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/9c0f63ffa1e459aedc9ca9… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/9c0f63ffa1e459aedc9ca9… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][issue-130-file-author-in-c] 7 commits: Fix #132: Ansi test RENAME-FILE.1 fails
by Raymond Toy (＠rtoy) 16 Oct '22

16 Oct '22

Raymond Toy pushed to branch issue-130-file-author-in-c 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 - - - - - 8719b21c by Raymond Toy at 2022-10-15T23:27:33+00:00 Fix #146: CI passes incorrectly - - - - - 9c0f63ff by Raymond Toy at 2022-10-15T23:27:34+00:00 Merge branch 'issue-146-ci-passes-incorrectly' into 'master' Fix #146: CI passes incorrectly Closes #146 See merge request cmucl/cmucl!100 - - - - - 3d81bc22 by Raymond Toy at 2022-10-16T07:26:17-07:00 Merge branch 'master' into issue-130-file-author-in-c - - - - - 4 changed files: - .gitlab-ci.yml - src/code/filesys.lisp - src/code/irrat.lisp - tests/issues.lisp Changes: ===================================== .gitlab-ci.yml ===================================== @@ -80,7 +80,8 @@ linux:ansi-test: script: - cd ansi-test - make LISP="../dist/bin/lisp -batch -noinit -nositeinit" - - grep 'No unexpected \(successes\|failures\)' test.out + # There should be no unexpected successes or failures; check these separately. + - grep -a 'No unexpected successes' test.out && grep -a 'No unexpected failures' test.out linux:benchmark: stage: benchmark ===================================== 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 ===================================== @@ -580,6 +580,96 @@ 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))))))) + (define-test issue.130 (:tag :issues) ;; Just verify that file-author works. In particular "." should View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/818a0d5b5372b0846cc192… -- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/818a0d5b5372b0846cc192… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

cmucl-cvs