Raymond Toy pushed to branch issue-157-directory-no-magic-wildcarding at cmucl / cmucl
Commits:
d5b02338 by Raymond Toy at 2023-03-08T08:43:59-08:00
Need to merge the directory pathname with defaults
If we don't then logical pathnames don't work, among other things. In
particular the following ansi-tests were failling:
DIRECTORY.8, OPEN.OUTPUT.28, OPEN.OUTPUT.35, OPEN.IO.28, OPEN.IO.35,
OPEN.PROBE.12, OPEN.PROBE.13, OPEN.PROBE.14, OPEN.PROBE.15,
OPEN.PROBE.16, OPEN.PROBE.17, OPEN.PROBE.18, OPEN.PROBE.19,
OPEN.PROBE.20, OPEN.ERROR.4, OPEN.ERROR.5, OPEN.ERROR.6, OPEN.ERROR.7,
OPEN.ERROR.8, OPEN.ERROR.9, OPEN.ERROR.10, OPEN.ERROR.11,
OPEN.ERROR.12, OPEN.ERROR.13, OPEN.ERROR.14.
With this change, the ansi-tests suite passes.
- - - - -
1 changed file:
- src/code/filesys.lisp
Changes:
=====================================
src/code/filesys.lisp
=====================================
@@ -1120,7 +1120,9 @@ optionally keeping some of the most recent old versions."
(setf prev elem))
(nreverse results))))
(let ((results nil))
- (enumerate-search-list (pathname pathname)
+ (enumerate-search-list
+ (pathname (merge-pathnames pathname
+ *default-pathname-defaults*))
(enumerate-matches (name pathname nil :follow-links follow-links)
(when (or all
(let ((slash (position #\/ name :from-end t)))
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/d5b023387b05012738abd70…
--
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/d5b023387b05012738abd70…
You're receiving this email because of your account on gitlab.common-lisp.net.
Raymond Toy pushed to branch issue-156-take-2-nan-comparison at cmucl / cmucl
Commits:
bd505bab by Raymond Toy at 2023-03-08T07:56:11-08:00
Use existing function to compute >= and <=
The code assumed if a0 >= b0 and a1 >= b1 implied a >= b for a
bigfloat. But I forgot that 1.99999...w0 is represented as 2d0 and a
tiny negative number. So `(<= 2w0 1.99999...w0)` would return false
because, while a0 <= b0, a1 <= b1 is false.
So for simplicity just use the obvious replacement that a <= b is the
same as a < b or a = b, which we already have.
[skip ci]
- - - - -
1 changed file:
- src/compiler/float-tran-dd.lisp
Changes:
=====================================
src/compiler/float-tran-dd.lisp
=====================================
@@ -670,13 +670,13 @@
(declaim (inline dd<=))
(defun dd<= (a0 a1 b0 b1)
- (and (<= a0 b0)
- (<= a1 b1)))
+ (or (dd> a0 a1 b0 b1)
+ (dd= a0 a1 b0 b1)))
(declaim (inline dd>=))
(defun dd>= (a0 a1 b0 b1)
- (and (>= a0 b0)
- (>= a1 b1)))
+ (or (dd> a0 a1 b0 b1)
+ (dd= a0 a1 b0 b1)))
(deftransform = ((a b) (vm::double-double-float vm::double-double-float) *)
`(dd= (kernel:double-double-hi a)
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/bd505bab9b50e50016cea7c…
--
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/bd505bab9b50e50016cea7c…
You're receiving this email because of your account on gitlab.common-lisp.net.
Raymond Toy pushed to branch master at cmucl / cmucl
Commits:
b2f6ab4c by Raymond Toy at 2023-03-06T17:07:46+00:00
Fix #173: Add pprinter for define-assembly-routine
- - - - -
7a15c464 by Raymond Toy at 2023-03-06T17:07:49+00:00
Merge branch 'issue-173-pprint-def-assem-routine' into 'master'
Fix #173: Add pprinter for define-assembly-routine
Closes #173
See merge request cmucl/cmucl!126
- - - - -
1 changed file:
- src/code/pprint.lisp
Changes:
=====================================
src/code/pprint.lisp
=====================================
@@ -1920,6 +1920,42 @@ When annotations are present, invoke them at the right positions."
(pprint-newline :mandatory stream)))
(pprint-exit-if-list-exhausted)
(pprint-newline :mandatory stream))))
+
+(defun pprint-define-assembly (stream list &rest noise)
+ (declare (ignore noise))
+ (pprint-logical-block (stream list :prefix "(" :suffix ")")
+ ;; Output "define-assembly-routine"
+ (output-object (pprint-pop) stream)
+ (pprint-exit-if-list-exhausted)
+ (write-char #\space stream)
+ ;; Output routine name and options.
+ (pprint-logical-block (stream (pprint-pop) :prefix "(" :suffix ")")
+ ;; Output the routine name
+ (output-object (pprint-pop) stream)
+ (pprint-exit-if-list-exhausted)
+ (pprint-newline :mandatory stream)
+ (pprint-indent :block 0 stream)
+ ;; Output options, one per line, neatly lined up and indented
+ ;; below the routine name.
+ (loop
+ (output-object (pprint-pop) stream)
+ (pprint-exit-if-list-exhausted)
+ (pprint-newline :mandatory stream)))
+ ;; Now output the args, results, and temps used by the assembly
+ ;; routine. Instead of lining up with the routine name, let's
+ ;; just indent it 4 spaces from the "define-assembly-routine" so
+ ;; it doesn't look so top-heavy.
+ (pprint-indent :block 4 stream)
+ (pprint-newline :mandatory stream)
+ (pprint-logical-block (stream (pprint-pop) :prefix "(" :suffix ")")
+ (loop
+ (output-object (pprint-pop) stream)
+ (pprint-exit-if-list-exhausted)
+ (pprint-newline :mandatory stream)))
+ ;; Now print out the assembly code as if it were a tagbody. Then
+ ;; labels are outdented by one to make them easy to see.
+ (pprint-newline :mandatory stream)
+ (pprint-tagbody-guts stream)))
;;;; Interface seen by regular (ugly) printer and initialization routines.
@@ -2037,7 +2073,8 @@ When annotations are present, invoke them at the right positions."
(stream::with-stream-class pprint-with-like)
(lisp::with-array-data pprint-with-like)
(c:define-vop pprint-define-vop)
- (c:sc-case pprint-sc-case)))
+ (c:sc-case pprint-sc-case)
+ (c:define-assembly-routine pprint-define-assembly)))
(defun pprint-init ()
(setf *initial-pprint-dispatch* (make-pprint-dispatch-table))
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/9d32d69a918d3542444ab3…
--
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/9d32d69a918d3542444ab3…
You're receiving this email because of your account on gitlab.common-lisp.net.
Raymond Toy pushed to branch issue-157-directory-returns-all-files at cmucl / cmucl
Commits:
5969e65a by Raymond Toy at 2023-03-04T11:54:32-08:00
Fix typo in version-components-match
Too much cut'n'paste so we got the wrong variable names.
- - - - -
1 changed file:
- src/code/pathname.lisp
Changes:
=====================================
src/code/pathname.lisp
=====================================
@@ -1234,10 +1234,10 @@ a host-structure or string."
(eq wild :wild)
;; A version component of :newest or :unspecific
;; is equivalent to nil.
- (and (null this) (or (eq that :newest)
- (eq that :unspecific)))
- (and (null that) (or (eq this :newest)
- (eq this :unspecific))))))
+ (and (null thing) (or (eq wild :newest)
+ (eq wild :unspecific)))
+ (and (null wild) (or (eq thing :newest)
+ (eq thing :unspecific))))))
(and (or (null (%pathname-host wildname))
(eq (%pathname-host wildname) (%pathname-host pathname)))
(frob %pathname-device device-components-match)
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/5969e65a5bba43a0a37161c…
--
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/5969e65a5bba43a0a37161c…
You're receiving this email because of your account on gitlab.common-lisp.net.
Raymond Toy pushed to branch issue-157-directory-returns-all-files at cmucl / cmucl
Commits:
30abe6eb by Raymond Toy at 2023-03-04T10:33:48-08:00
Fix up test issues for pathnames.
With the updated pathname-match-p function, some of the existing
pathname tests were not correct.
For example "/tmp/foo.lisp" should NOT match "foo:*" because only the
name is `:WILD`. The type is `NIL`, so "foo.lisp" doesn't match. We
change the test to assert it fails and added a version where it should
pass.
There was also in trying to match different search-lists where we
forgot to call `pathname-match-p`. Oops.
- - - - -
1 changed file:
- tests/pathname.lisp
Changes:
=====================================
tests/pathname.lisp
=====================================
@@ -19,28 +19,33 @@
(:tag :search-list)
;; Basic tests where the wild path is search-list
- (assert-true (pathname-match-p "/tmp/foo.lisp" "foo:*"))
- (assert-true (pathname-match-p "/tmp/zot/foo.lisp" "foo:**/*"))
+ (assert-false (pathname-match-p "/tmp/foo.lisp" "foo:*"))
+ (assert-true (pathname-match-p "/tmp/foo.lisp" "foo:*.*"))
+ (assert-false (pathname-match-p "/tmp/zot/foo.lisp" "foo:**/*"))
+ (assert-true (pathname-match-p "/tmp/zot/foo.lisp" "foo:**/*.*"))
(assert-true (pathname-match-p "/tmp/zot/foo.lisp" "foo:**/*.lisp"))
;; These match because the second entry of the "foo:" search list is
;; "/usr/".
- (assert-true (pathname-match-p "/usr/foo.lisp" "foo:*"))
+ (assert-false (pathname-match-p "/usr/foo.lisp" "foo:*"))
+ (assert-true (pathname-match-p "/usr/foo.lisp" "foo:*.*"))
(assert-true (pathname-match-p "/usr/bin/foo" "foo:**/*"))
(assert-true (pathname-match-p "/usr/bin/foo.lisp" "foo:**/*.lisp"))
;; This fails because "/bin/" doesn't match any path of the search
;; list.
- (assert-false (pathname-match-p "/bin/foo.lisp" "foo:*"))
+ (assert-false (pathname-match-p "/bin/foo.lisp" "foo:*.*"))
;; Basic test where the pathname is a search-list and the wild path is not.
- (assert-true (pathname-match-p "foo:foo.lisp" "/tmp/*"))
+ (assert-false (pathname-match-p "foo:foo.lisp" "/tmp/*"))
+ (assert-true (pathname-match-p "foo:foo.lisp" "/tmp/*.*"))
(assert-true (pathname-match-p "foo:foo" "/usr/*"))
+ (assert-true (pathname-match-p "foo:foo" "/usr/*.*"))
(assert-true (pathname-match-p "foo:zot/foo.lisp" "/usr/**/*.lisp"))
(assert-false (pathname-match-p "foo:foo" "/bin/*"))
;; Tests where both args are search-lists.
- (assert-true "foo:foo.lisp" "bar:*"))
+ (assert-true (pathname-match-p "foo:foo.lisp" "bar:*.*")))
;; Verify PATHNAME-MATCH-P works with logical pathnames. (Issue 27)
;; This test modeled after a test from asdf
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/30abe6ebd71ba3bcee4438f…
--
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/commit/30abe6ebd71ba3bcee4438f…
You're receiving this email because of your account on gitlab.common-lisp.net.