Raymond Toy pushed to branch issue-140-stream-element-type-two-way-stream at cmucl / cmucl
Commits:
7d17444a by Raymond Toy at 2022-10-17T09:49:42-07:00
Forgot to update release notes for this fix.
- - - - -
1 changed file:
- src/general-info/release-21e.md
Changes:
=====================================
src/general-info/release-21e.md
=====================================
@@ -56,7 +56,7 @@ public domain.
* ~~#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`.
+ * ~~#140~~ External format of `two-way-stream`
* ~~#142~~ `(random 0)` signals incorrect error
* Other changes:
* Improvements to the PCL implementation of CLOS:
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/7d17444a4249f6430737792…
--
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/7d17444a4249f6430737792…
You're receiving this email because of your account on gitlab.common-lisp.net.
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.
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.
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.
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.
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.
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.
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.
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.
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.