Commit 93998ef5 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Introduce *wild-file-for-directory*

When using DIRECTORY, the proper pattern to use to get all files
is #p"*" and not #p"*.*" on CLISP and GCL.
This is the opposite of other CL implementations, that
match everything with #p"*.*" and only files without extension with #p"*",
which seems more in line with the CLHS, though counter-intuitive wrt to POSIX.

Now the proper pattern to match all files with TRANSLATE-PATHNAME and
with logical pathnames is still #p"*.*" or #p"*.*.*".

Therefore, we introduce a new parameter *wild-file-for-directory*,
as distinguished from *wild-file*, for notable use with DIRECTORY-FILES.
parent d88e4273
......@@ -17,7 +17,7 @@ use a wild pathname instead." module)))
(sysdef-error "Wild-module ~A specified with non-wild pathname ~A."
self pathname))
(setf (slot-value self 'components)
(let* ((files (directory pathname))
(let* ((files (directory* pathname))
(class (wild-module-component-class self))
(options (wild-module-component-options self)))
(mapcar (lambda (file)
......@@ -48,12 +48,15 @@
,(subpathname root (make-pathname :directory '(:relative "asdf-bin" :wild-inferiors)
:name :wild :type bin-type
:defaults root)))
,(subpathname root (make-pathname :directory '(:relative "asdf-src" :wild-inferiors)
:name :wild :type :wild :version :wild)))
,(subpathname root (make-pathname :directory '(:relative "asdf-src" :wild-inferiors)
:name :wild :type :wild :version nil)))
,(subpathname root (make-pathname :directory '(:relative "asdf-src" :wild-inferiors)
:name :wild :type :wild))))))
:name :wild :type nil :version nil))))))
(defclass test-status ()
((system-count :initform 0)
......@@ -454,7 +457,7 @@
(assert-pathname-equal (resolve-location '("/foo" "bar" "baz") :ensure-directory t) #p"/foo/bar/baz/")
(assert-pathname-equal (resolve-location '("/foo" "bar" "baz") :ensure-directory t :wilden t) (wilden #p"/foo/bar/baz/"))
(assert-pathname-equal (resolve-location '("/foo" "bar" "baz") :ensure-directory nil :wilden t) (wilden #p"/foo/bar/"))
(assert-pathname-equal (resolve-location '("/foo" "bar" :**/ "baz" #p"*.*") :ensure-directory nil :wilden t) #p"/foo/bar/**/baz/*.*"))
(assert-pathname-equal (resolve-location '("/foo" "bar" :**/ "baz" :*.*.*) :ensure-directory nil :wilden t) (merge-pathnames* *wild-file* #p"/foo/bar/**/baz/")))
(assert (directory-pathname-p (system-source-directory (find-system :test-asdf/test-source-directory-1))))
(assert (directory-pathname-p (system-source-directory (find-system :test-asdf/test-source-directory-2))))
......@@ -196,7 +196,7 @@ when using logical-pathnames."
:test 'pathname-equal)
(defun directory-files (directory &optional (pattern *wild-file*))
(defun directory-files (directory &optional (pattern *wild-file-for-directory*))
"Return a list of the files in a directory according to the PATTERN.
Subdirectories should NOT be returned.
PATTERN defaults to a pattern carefully chosen based on the implementation;
......@@ -214,20 +214,7 @@ but the behavior in presence of symlinks is not portable. Use IOlib to handle su
(error "Invalid file pattern ~S for logical directory ~S" pattern directory))
(setf pattern (make-pathname-logical pattern (pathname-host dir))))
(let* ((pat (merge-pathnames* pattern dir))
;; the following complex block is
;; needed because clisp handles "*" pathnames differently from
;; "*.*" -- the former is more more general than the latter.
;; GCL does something odd, too, but I don't know what this is.
;; Looks like it treats "*" and "*.*" as disjoint.
;; [2016/06/23:rpg]
(entries (append #-clisp (ignore-errors (directory* pat))
(if (equal :wild (pathname-type pattern))
(ignore-errors (directory* (make-pathname :type nil :defaults pat)))
(ignore-errors (directory* pat)))
(when (equal :wild (pathname-type pattern))
(ignore-errors (directory* (make-pathname :type nil :defaults pat)))))))
(entries (ignore-errors (directory* pat))))
(remove-if 'directory-pathname-p
directory entries
......@@ -31,7 +31,8 @@
;; Checking constraints
#:ensure-pathname ;; implemented in filesystem.lisp to accommodate for existence constraints
;; Wildcard pathnames
#:*wild* #:*wild-file* #:*wild-directory* #:*wild-inferiors* #:*wild-path* #:wilden
#:*wild* #:*wild-file* #:*wild-file-for-directory* #:*wild-directory*
#:*wild-inferiors* #:*wild-path* #:wilden
;; Translate a pathname
#:relativize-directory-component #:relativize-pathname-directory
#:directory-separator-for-host #:directorize-pathname-host-device
......@@ -608,7 +609,11 @@ given DEFAULTS-PATHNAME as a base pathname."
(defparameter *wild-file*
(make-pathname :directory nil :name *wild* :type *wild*
:version (or #-(or allegro abcl xcl) *wild*))
"A pathname object with wildcards for matching any file in a given directory")
"A pathname object with wildcards for matching any file with TRANSLATE-PATHNAME")
(defparameter *wild-file-for-directory*
(make-pathname :directory nil :name *wild* :type (or #-(or clisp gcl) *wild*)
:version (or #-(or allegro abcl clisp gcl xcl) *wild*))
"A pathname object with wildcards for matching any file with DIRECTORY")
(defparameter *wild-directory*
(make-pathname :directory `(:relative ,*wild-directory-component*)
:name nil :type nil :version nil)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment