Changeset 15369

Timestamp:

08/21/20 15:38:51 (3 years ago)

Author:

Mark Evenson

Message:

Change CL:DIRECTORY to use CL:PATHNAME-MATCH-P

CL:DIRECTORY was only matching on the name and type portions of a file
which was just wrong.

Fix the internally used SYS::COMPONENT-MATCH-WILD-P to work on
wildcards constisting of only #\* characters.

<https://abcl.org/trac/ticket/472>

Location:

trunk/abcl/src/org/armedbear/lisp

Files:

• directory.lisp (modified) (2 diffs)
• pathnames.lisp (modified) (1 diff)

trunk/abcl/src/org/armedbear/lisp/directory.lisp

@@ -97 +97 @@
                      entries)))))
 
+;;; The extension to ANSI via :RESOLVE-SYMLINKS was added as
+;;; <https://abcl.org/trac/ticket/340>, in which it was argued that
+;;; symlinks should be considered contents of a directory, and that in
+;;; any event, performing a DIRECTORY on a dangling symlink should not
+;;; signal an error.
+;;;
+;;; See <https://abcl.org/trac/changeset/14624> for additional
+;;; information on implementation decision.
 (defun directory (pathspec &key (resolve-symlinks nil))
   "Determines which, if any, files that are present in the file system have names matching PATHSPEC, and returns a fresh list of pathnames corresponding to the potential truenames of those files.  
@@ -133 +141 @@
                 (let ((entries (list-directories-with-wildcards 
                                 namestring nil resolve-symlinks))
-                      (matching-entries ()))
+                      matching-entries)
                   (dolist (entry entries)
-                    (when 
-                        (or 
-                         (and 
-                          (file-directory-p entry :wild-error-p nil)
-                          (pathname-match-p (file-namestring (pathname-as-file entry)) 
-                                            (file-namestring pathname)))
-                         (pathname-match-p (or (file-namestring entry) "") 
-                                           (file-namestring pathname)))
+                    (when (pathname-match-p entry pathname)
                       (push 
                        (if resolve-symlinks

trunk/abcl/src/org/armedbear/lisp/pathnames.lisp

@@ -56 +56 @@
     (labels ((split-string (delim str)
          (flet ((finder (char) (find char delim)))
-     (loop  for x = (position-if-not #'finder str) then
-          (position-if-not #'finder str :start (or y (length str)))
-        for y = (position-if #'finder str :start x) then
-          (position-if #'finder str :start (or x (length str))) while x 
-        collect (subseq str x y))))
+     (loop
+                   :for x = (position-if-not #'finder str)
+                     :then (position-if-not #'finder str :start (or y (length str)))
+       :for y = (position-if #'finder str :start (or x (length str)))
+                     :then (position-if #'finder str :start (or x (length str)))
+                   :while x 
+        :collect (subseq str x y))))
        (positions-larger (thing substrings previous-pos)
          (let ((new-pos (search (car substrings)