Changeset 15376

Timestamp:

09/09/20 17:09:45 (3 years ago)

Author:

Mark Evenson

Message:

Fix regression in CL:DIRECTORY for wild pathnames

We re-enable listing sub-directories of directories for wild pathnames
that have NAME and TYPE of :wild. This behavior was inadvertently
disabled with
<​https://github.com/armedbear/abcl/commit/889a50534dde062f037b01f4b8e2b6c108561709>.

This regression broke Quicklisp's indexing of local projects directory
which has implementation specific code which depends on

(directory "~/quicklisp/*.*")

returning both immediate sub-directories as well as files under
<file:~/quicklisp/>.

According to
<​http://www.lispworks.com/documentation/HyperSpec/Body/f_pn_mat.htm>
CL:PATHNAME-MATCH-P is supposed to be consistent with CL:DIRECTORY, but
this doesn't seem to be the case for SBCL, CCL, LWpro, but *is* true
for ECL.

;;; This should return (t t t …) for every wildcard that one can pass
;;; to DIRECTORY

(let ((wildcard #p"/Users/evenson/quicklisp/local-projects/*.*"))

(mapcar

(lambda (e) (pathname-match-p e wildcard))
(directory wildcard)))

At this time, we choose to be compatible with the previous behavior of
ABCL and the current behavior of SBCL/CCL rather than strict
conformance here.

This should fix <​https://github.com/qitab/cl-protobufs/issues/199>.

File:

• trunk/abcl/src/org/armedbear/lisp/directory.lisp (modified) (3 diffs)

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

@@ -33 +33 @@
 (in-package "SYSTEM")
 
-(defun pathname-as-file (pathname)
+;;; utility function for LIST-DIRECTORIES-WITH-WILDCARDS
+(defun directory-as-file (pathname)
+  "Convert a PATHNAME referencing a directory to a file"
   (let ((directory (pathname-directory pathname)))
     (make-pathname :host nil
@@ -42 +44 @@
                    :version nil)))
 
+;;; utility function for LIST-DIRECTORIES-WITH-WILDCARDS
 (defun wild-inferiors-p (component)
   (eq component :wild-inferiors))
@@ -143 +146 @@
                       matching-entries)
                   (dolist (entry entries)
-                    (when (pathname-match-p entry pathname)
+                    (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