[Git][cmucl/cmucl][issue-157-directory-returns-all-files] 6 commits: Need to handle pathname versions specially

[Raymond Toy (@rtoy)]

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/068710573805f004b0d0bc148aa0ddb9f8dfa20b...c14e6ee8e1620f8c007436dcc5ef060ef805f7d4

-- 
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/-/compare/068710573805f004b0d0bc148aa0ddb9f8dfa20b...c14e6ee8e1620f8c007436dcc5ef060ef805f7d4
You're receiving this email because of your account on gitlab.common-lisp.net.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20230304/5b0449a8/attachment-0001.html>