Fix (remaining?) bugs for DIRECTORY.

Fixes Quicklisp, aka the "DIRECTORY no longer works with
:WILD-INFERIORS" problem, q.v. <http://abcl.org/trac/ticket/344>.

DIRECTORY under non-Windows now fills nil DEVICE components with
:UNSPECIFIC, otherwise forms like

    (equal (truename "~/.emacs")
           (first (directory "~/.emacs")) )

fail (c.f. ANSI test DIRECTORY.[67]).
parent e1c80013
...@@ -99,16 +99,33 @@ for non-Windows systems. ...@@ -99,16 +99,33 @@ for non-Windows systems.
TRUENAME sets DEVICE to :UNSPECIFIC running on non-Windows when TRUENAME sets DEVICE to :UNSPECIFIC running on non-Windows when
resolving a path to a plain file. resolving a path to a plain file.
### DIRECTORY sets DEVICE to :UNSPECIFIC
When the default for the :RESOLVE-SYMLINKS argument to DIRECTORY was
changed to nil, DIRECTORY was changed not to always resolve its
results via TRUENAME. As a result
(equal (truename "~/.emacs")
(first (directory "~/.emacs")) )
forms would return nil. This is a bit counter to expectations set by
CLHS that DIRECTORY "returns a list of pathnames corresponding to the
truenames". In particular, this breaks the ANSI CL DIRECTORY.[67]
tests. Thus, under non-Windows we now explicitly normalize DEVICE
components which are nil to :UNSPECIFIC for the results of DIRECTORY
calls.
### Use an implicit type for merging ### Use an implicit type for merging
In the case for which a merge occurs when DEFAULT-PATHNAME In the case for which a merge occurs when DEFAULT-PATHNAME
is a JAR-PATHNAME and the following conditions hold: is a JAR-PATHNAME and the following conditions hold:
1. HOST and DEVICE of the PATHNAME are NIL 1. HOST and DEVICE of the PATHNAME are NIL
2. The DIRECTORY of the PATHNAME represents an absolute path. 2. The DIRECTORY of the PATHNAME represents an absolute path.
3. We are not on Windows. 3. We are not running under Windows.
we set the DEVICE to be :UNSPECIFIC. we set the DEVICE to be :UNSPECIFIC.
...@@ -116,5 +133,5 @@ we set the DEVICE to be :UNSPECIFIC. ...@@ -116,5 +133,5 @@ we set the DEVICE to be :UNSPECIFIC.
Mark <evenson@panix.com> Mark <evenson@panix.com>
Created: 01-SEP-2012 Created: 01-SEP-2012
Revised: 09-OCT-2012 Revised: 06-FEB-2014
...@@ -217,6 +217,10 @@ public class Pathname extends LispObject { ...@@ -217,6 +217,10 @@ public class Pathname extends LispObject {
// characters. // characters.
init(url.toString()); init(url.toString());
} }
public Pathname(URI uri) {
init(uri.toString());
}
static final Symbol SCHEME = internKeyword("SCHEME"); static final Symbol SCHEME = internKeyword("SCHEME");
static final Symbol AUTHORITY = internKeyword("AUTHORITY"); static final Symbol AUTHORITY = internKeyword("AUTHORITY");
...@@ -368,22 +372,28 @@ public class Pathname extends LispObject { ...@@ -368,22 +372,28 @@ public class Pathname extends LispObject {
if (scheme.equals("file")) { if (scheme.equals("file")) {
URI uri = null; URI uri = null;
try { try {
uri = url.toURI(); uri = new URI(s);
} catch (URISyntaxException ex) { } catch (URISyntaxException ex) {
error(new SimpleError("Improper URI syntax for " error(new SimpleError("Improper URI syntax for "
+ "'" + url.toString() + "'" + "'" + url.toString() + "'"
+ ": " + ex.toString())); + ": " + ex.toString()));
} }
String uriPath = uri.getPath(); String uriPath = uri.getPath();
if (null == uriPath) { if (null == uriPath) {
// We make an exception for forms like "file:z:/foo/path" // Under Windows, deal with pathnames containing
uriPath = uri.getSchemeSpecificPart(); // devices expressed as "file:z:/foo/path"
if (uriPath == null || uriPath.equals("")) { uriPath = uri.getSchemeSpecificPart();
error(new LispError("The URI has no path: " + uri)); if (uriPath == null || uriPath.equals("")) {
} error(new LispError("The URI has no path: " + uri));
}
} }
final File file = new File(uriPath); final File file = new File(uriPath);
final Pathname p = new Pathname(file.getPath()); String path = file.getPath();
if (uri.toString().endsWith("/") && !path.endsWith("/")) {
path += "/";
}
final Pathname p = new Pathname(path);
this.host = p.host; this.host = p.host;
this.device = p.device; this.device = p.device;
this.directory = p.directory; this.directory = p.directory;
...@@ -403,32 +413,31 @@ public class Pathname extends LispObject { ...@@ -403,32 +413,31 @@ public class Pathname extends LispObject {
} }
String authority = uri.getAuthority(); String authority = uri.getAuthority();
if (authority == null) { if (authority == null) {
authority = url.getAuthority(); authority = url.getAuthority();
if (authority == null) { if (authority == null) {
Debug.trace(MessageFormat.format("{0} has a null authority.", Debug.trace(MessageFormat.format("{0} has a null authority.", url));
url)); }
}
} }
host = NIL; host = NIL;
host = host.push(SCHEME); host = host.push(SCHEME);
host = host.push(new SimpleString(scheme)); host = host.push(new SimpleString(scheme));
if (authority != null) { if (authority != null) {
host = host.push(AUTHORITY); host = host.push(AUTHORITY);
host = host.push(new SimpleString(authority)); host = host.push(new SimpleString(authority));
} }
device = NIL; device = NIL;
// URI encode necessary characters // URI encode necessary characters
String path = uri.getRawPath(); String path = uri.getRawPath();
if (path == null) { if (path == null) {
path = ""; path = "";
} }
String query = uri.getRawQuery(); String query = uri.getRawQuery();
if (query != null) { if (query != null) {
host = host.push(QUERY); host = host.push(QUERY);
host = host.push(new SimpleString(query)); host = host.push(new SimpleString(query));
} }
String fragment = uri.getRawFragment(); String fragment = uri.getRawFragment();
...@@ -1648,11 +1657,12 @@ public class Pathname extends LispObject { ...@@ -1648,11 +1657,12 @@ public class Pathname extends LispObject {
path = file.getCanonicalPath(); path = file.getCanonicalPath();
} }
URI pathURI = (new File(path)).toURI(); URI pathURI = (new File(path)).toURI();
p = new Pathname(pathURI.toString()); p = new Pathname(pathURI);
result = new Cons(p, result); result = new Cons(p, result);
} }
} catch (IOException e) { } catch (IOException e) {
return error(new FileError("Unable to list directory " + pathname.princToString() + ".", return error(new FileError("Unable to list directory "
+ pathname.princToString() + ".",
pathname)); pathname));
} catch (SecurityException e) { } catch (SecurityException e) {
Debug.trace(e); Debug.trace(e);
......
...@@ -61,49 +61,43 @@ ...@@ -61,49 +61,43 @@
(newpath (make-pathname :directory non-wild (newpath (make-pathname :directory non-wild
:name nil :type nil :defaults pathname)) :name nil :type nil :defaults pathname))
(entries (list-directory newpath resolve-symlinks))) (entries (list-directory newpath resolve-symlinks)))
(if (not (or wild wild-inferiors-found)) (when (not (or wild wild-inferiors-found)) ;; no further recursion necessary
entries (return-from list-directories-with-wildcards entries))
(let ((inferior-entries (when (or wild-inferiors-found first-wild-inferior) entries))) (let ((inferior-entries (when (or wild-inferiors-found first-wild-inferior) entries)))
(nconc (nconc
(mapcan (lambda (entry) (mapcan (lambda (entry)
(when (pathname-match-p (pathname entry) pathname) (when (pathname-match-p (pathname entry) pathname)
(list entry))) (list entry)))
inferior-entries) inferior-entries)
(mapcan (lambda (entry) (mapcan (lambda (entry)
(let* ((pathname (pathname entry)) (let* ((pathname (pathname entry))
(directory (pathname-directory pathname)) (directory (pathname-directory pathname))
(rest-wild (cdr wild))) (rest-wild (cdr wild)))
(unless (pathname-name pathname) (unless (pathname-name pathname)
(when (pathname-match-p (first (last directory)) (when (pathname-match-p (first (last directory))
(cond ((eql (car wild) :wild) (cond ((eql (car wild) :wild)
"*") "*")
((eql (car wild) :wild-inferiors) ((eql (car wild) :wild-inferiors)
"*") "*")
(wild (wild
(car wild)) (car wild))
(t ""))) (t "")))
(when (and (when (and
(not (or first-wild-inferior (not (or first-wild-inferior
wild-inferiors-found)) wild-inferiors-found))
rest-wild) rest-wild)
(setf directory (nconc directory rest-wild))) (setf directory (nconc directory rest-wild)))
(let ((recurse (make-pathname :directory directory (let ((recurse (make-pathname :directory directory
:defaults newpath))) :defaults newpath)))
(when (not (equal recurse newpath)) (when (not (equal recurse newpath))
(list-directories-with-wildcards (list-directories-with-wildcards
recurse recurse
(or first-wild-inferior wild-inferiors-found) (or first-wild-inferior wild-inferiors-found)
resolve-symlinks))))))) resolve-symlinks)))))))
entries)))))) entries)))))
;;; XXX Kludge for compatibilty: hope no one uses.
(defun directory-old (pathspec &key (resolve-symlinks t))
(warn "Deprecated: Please use CL:DIRECTORY which has a NIL default for :RESOLVE-SYMLINKS.")
(directory pathspec :resolve-symlinks resolve-symlinks))
(defun directory (pathspec &key (resolve-symlinks nil)) (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 "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.
a fresh list of pathnames corresponding to the potential truenames of those files.
With :RESOLVE-SYMLINKS set to nil, not all pathnames returned may With :RESOLVE-SYMLINKS set to nil, not all pathnames returned may
correspond to an existing file. Symbolic links are considered to be correspond to an existing file. Symbolic links are considered to be
...@@ -140,11 +134,17 @@ error to its caller." ...@@ -140,11 +134,17 @@ error to its caller."
(file-directory-p entry) (file-directory-p entry)
(pathname-match-p (file-namestring (pathname-as-file entry)) (pathname-match-p (file-namestring (pathname-as-file entry))
(file-namestring pathname))) (file-namestring pathname)))
(pathname-match-p (or (file-namestring entry) "") (file-namestring pathname))) (pathname-match-p (or (file-namestring entry) "")
(file-namestring pathname)))
(push (push
(if resolve-symlinks (if resolve-symlinks
(truename entry) (truename entry)
entry) ;; Normalize nil DEVICE to :UNSPECIFIC under non-Windows
;; fixes ANSI DIRECTORY.[67]
(if (and (not (find :windows *features*))
(not (pathname-device entry)))
(make-pathname :defaults entry :device :unspecific)
entry))
matching-entries))) matching-entries)))
matching-entries)))) matching-entries))))
;; Not wild. ;; Not wild.
......
...@@ -101,4 +101,17 @@ public class PathnameTest ...@@ -101,4 +101,17 @@ public class PathnameTest
String s = r.getNamestring(); String s = r.getNamestring();
assertTrue(s.equals("jar:file:/a/b/c/foo.jar!/bar.abcl")); assertTrue(s.equals("jar:file:/a/b/c/foo.jar!/bar.abcl"));
} }
@Test
public void constructorFileDirectory() {
Pathname p = new Pathname("file://tmp/");
assertTrue(p.getNamestring().endsWith("/"));
}
@Test
public void constructorFileWindowsDevice() {
Pathname p = new Pathname("file:c://tmp/");
LispObject device = p.getDevice();
if (Utilities.isPlatformWindows) {
assert(device != Lisp.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