diff --git a/src/code/pathname.lisp b/src/code/pathname.lisp index 44ac9019c301bdf7b906b0bc510ea5059d39c89c..12f627f51fbdb32f4183048b660392c12c5f7468 100644 --- a/src/code/pathname.lisp +++ b/src/code/pathname.lisp @@ -1219,7 +1219,22 @@ a host-structure or string." (:version (frob (%pathname-version pathname))))))) +(defun %%pathname-match-p (pathname wildname) + (macrolet ((frob (field &optional (op 'components-match )) + `(or (null (,field wildname)) + (,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)))) + ;; Like PATHNAME-MATCH-P but the pathnames should not be search-lists. +;; Primarily intended for TRANSLATE-LOGICAL-PATHNAME and friends, +;; because PATHNAME-MATCH-P calls TRANSLATE-LOGICAL-PATHNAME, causing +;; infinite recursion. (defun %pathname-match-p (in-pathname in-wildname) "Pathname matches the wildname template?" (declare (type path-designator in-pathname) @@ -1228,16 +1243,7 @@ a host-structure or string." (type (or string pathname) in-wildname)) (with-pathname (pathname in-pathname) (with-pathname (wildname in-wildname) - (macrolet ((frob (field &optional (op 'components-match )) - `(or (null (,field wildname)) - (,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)))))) + (%%pathname-match-p pathname wildname)))) ;;; PATHNAME-MATCH-P -- Interface ;;; @@ -1251,17 +1257,8 @@ a host-structure or string." (enumerate-search-list (pathname in-path) (with-pathname (in-wild in-wildname) (enumerate-search-list (wildname in-wild) - (macrolet ((frob (field &optional (op 'components-match )) - `(or (null (,field wildname)) - (,op (,field pathname) (,field wildname))))) - (when (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)) - (return-from pathname-match-p pathname)))))))) + (when (%%pathname-match-p pathname wildname) + (return-from pathname-match-p pathname))))))) ;;; SUBSTITUTE-INTO -- Internal