Raymond Toy pushed to branch issue-157-directory-returns-all-files at cmucl / cmucl
Commits: 172b5853 by Raymond Toy at 2023-03-03T16:16:06-08:00 Need to handle pathname versions specially
Using `components-match` doesn't do the right thing for `pathname-version`. We need to treat `NIL` to mean the same as `:NEWEST`. Fortunately, there's already `compare-version-component` does what we need, so use it.
- - - - - 2f544f3d by Raymond Toy at 2023-03-03T16:18:20-08:00 Instead of calling %pathname-match-p call %%pathname-match-p
Here in `%enumerate-files`, we don't need the full capability of `%pathname-match-p`. The file we get is a string from reading from the directory. We can just use `parse-nametring` to get a pathname object out of that. Then it can be merged with the directory pathname. Thus, everything is a physical pathname suitable for `%%pathname-match-p`.
- - - - - 2e0efffd by Raymond Toy at 2023-03-03T16:41:29-08:00 Need to have special function to match version components.
Using `components-match` work and neither does `compare-version-component`. We need a separate method of this. Basically a version matches a wild version if they're `eq, or if the wild version is `:wild`. Also `NIL` and `:NEWEST` are treated as being equal. (Via `compare-version-component`).
- - - - - 90e1f949 by Raymond Toy at 2023-03-03T17:07:44-08:00 Handle device component specially for matching.
Logical pathnames have a pathname-device of :unspecific. We need to handle that specially when matching logical pathnames. We treat :unspecific as matching nil.
- - - - - 3cfc7ef3 by Raymond Toy at 2023-03-03T17:10:04-08:00 Comment out debugging prints
- - - - - c14e6ee8 by Raymond Toy at 2023-03-04T07:12:28-08:00 Add some comments.
- - - - -
2 changed files:
- src/code/filesys.lisp - src/code/pathname.lisp
Changes:
===================================== src/code/filesys.lisp ===================================== @@ -812,8 +812,11 @@ (progn (format t "file = ~A~%" file) (describe pathname)) - (when (%pathname-match-p (merge-pathnames file dir-path nil) - pathname) + ;; Use pathname-match-p so that we are + ;; guaranteed to have directory and + ;; pathname-match-p behave consistently. + (when (%%pathname-match-p (merge-pathnames file dir-path) + pathname) (funcall function (concatenate 'string directory
===================================== src/code/pathname.lisp ===================================== @@ -1221,15 +1221,32 @@ a host-structure or string."
(defun %%pathname-match-p (pathname wildname) (macrolet ((frob (field &optional (op 'components-match )) - `(or (eq (,field wildname) :wild) - (,op (,field pathname) (,field wildname))))) - (and (or (null (%pathname-host wildname)) - (eq (%pathname-host wildname) (%pathname-host pathname))) - (frob %pathname-device) - (frob %pathname-directory directory-components-match) - (frob %pathname-name) - (frob %pathname-type) - (frob %pathname-version)))) + `(,op (,field pathname) (,field wildname)))) + #+nil + (progn + (describe pathname) + (describe wildname)) + (and (or (null (%pathname-host wildname)) + (eq (%pathname-host wildname) (%pathname-host pathname))) + (flet ((device-components-match (thing wild) + (or (eq thing wild) + (eq wild :wild) + ;; A device component of :unspecific matches + ;; nil. + (or (and (null thing) (eq wild :unspecific)) + (and (eq thing :unspecific) (eq wild nil)))))) + (frob %pathname-device device-components-match)) + #+nil + (frob %pathname-device) + (frob %pathname-directory directory-components-match) + (frob %pathname-name) + (frob %pathname-type) + (flet ((version-components-match (thing wild) + (or (eq thing wild) + (eq wild :wild) + ;; A version component matches of :newest matches nil. + (compare-version-component thing wild)))) + (frob %pathname-version version-components-match)))))
;; Like PATHNAME-MATCH-P but the pathnames should not be search-lists. ;; Primarily intended for TRANSLATE-LOGICAL-PATHNAME and friends,
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/068710573805f004b0d0bc1...