Open alanruttenberg opened 2 years ago
It's because of pathname-match-p again. Directory calls it
(PATHNAME-MATCH-P #P"/Users/alanr/repos/lsw2/lib/abcl-aio.jar" #P"/Users/alanr/repos/lsw2/bin/../lib/*.jar")
->
NIL
A fix, perhaps not to your liking, though:
diff --git a/src/org/armedbear/lisp/directory.lisp b/src/org/armedbear/lisp/directory.lisp
index 80630437..a4cc3895 100644
--- a/src/org/armedbear/lisp/directory.lisp
+++ b/src/org/armedbear/lisp/directory.lisp
@@ -123,6 +123,8 @@ have truenames which do not exist, this routine will signal a file
error to its caller."
(let ((pathname (merge-pathnames pathspec)))
+ (when (equalp (pathname-host pathname) '(:scheme "file"))
+ (setq pathname (subseq (namestring pathname) #.(length "file://"))))
(when (logical-pathname-p pathname)
(setq pathname (translate-logical-pathname pathname)))
(if (or (position #\* (namestring pathname))
@@ -143,26 +145,38 @@ error to its caller."
(concatenate 'string device ":" namestring))))))
(let ((entries (list-directories-with-wildcards
namestring nil resolve-symlinks))
- matching-entries)
- (dolist (entry entries)
- (when
- (or
- (and
- (file-directory-p entry :wild-error-p nil)
- (pathname-match-p
- (directory-as-file entry) pathname))
- (pathname-match-p entry pathname))
- (push
- (if resolve-symlinks
- (truename entry)
- ;; Normalize nil DEVICE to :UNSPECIFIC under non-Windows
- ;; fixes ANSI DIRECTORY.[67]
- (if (and (not (find :windows *features*))
- (not (pathname-device entry)))
- (make-pathname :defaults entry :device :unspecific)
- entry))
- matching-entries)))
- matching-entries))))
+ (matching-entries nil))
+ (flet ((no-dots (path)
+ (merge-pathnames
+ (make-pathname :directory
+ (let ((reversed nil))
+ (dolist (el (pathname-directory path))
+ (if (eq el :up)
+ (pop reversed)
+ (unless (equal el ".")
+ (push el reversed))))
+ (reverse reversed)))
+ path)))
+ (let ((pathname (no-dots pathname)))
+ (dolist (entry entries)
+ (when
+ (or
+ (and
+ (file-directory-p entry :wild-error-p nil)
+ (pathname-match-p
+ (directory-as-file entry) pathname))
+ (pathname-match-p entry pathname))
+ (push
+ (if resolve-symlinks
+ (truename entry)
+ ;; Normalize nil DEVICE to :UNSPECIFIC under non-Windows
+ ;; fixes ANSI DIRECTORY.[67]
+ (if (and (not (find :windows *features*))
+ (not (pathname-device entry)))
+ (make-pathname :defaults entry :device :unspecific)
+ entry))
+ matching-entries)))))
+ matching-entries))))
;; Not wild.
(let ((truename (probe-file pathname)))
(if truename
@alanruttenberg It would be cool to have these in pull requests, but keep 'em coming!
When one changes the pathname code, one really needs to check the ABCL-TEST and ANSI-TEST suites as things break in unexpected ways. In general, though, I will take more correct behavior over no fixes anyday.
perhaps because...
perhaps because...