Starting November 9th, common-lisp.net's Gitlab instance has implemented a more open account policy, allowing anyone with a GitHub or Google account to create an account on our instance.

At the same time, the login policy has started to require 2-factor authentication (2FA).

See https://mailman.common-lisp.net/pipermail/clo-devel/2018-October/001232.html for discussion.

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.
TRUENAME sets DEVICE to :UNSPECIFIC running on non-Windows when
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
In the case for which a merge occurs when DEFAULT-PATHNAME
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.
......@@ -116,5 +133,5 @@ we set the DEVICE to be :UNSPECIFIC.
Mark <evenson@panix.com>
Created: 01-SEP-2012
Revised: 09-OCT-2012
Revised: 06-FEB-2014
......@@ -217,6 +217,10 @@ public class Pathname extends LispObject {
// characters.
init(url.toString());
}
public Pathname(URI uri) {
init(uri.toString());
}
static final Symbol SCHEME = internKeyword("SCHEME");
static final Symbol AUTHORITY = internKeyword("AUTHORITY");
......@@ -368,22 +372,28 @@ public class Pathname extends LispObject {
if (scheme.equals("file")) {
URI uri = null;
try {
uri = url.toURI();
uri = new URI(s);
} catch (URISyntaxException ex) {
error(new SimpleError("Improper URI syntax for "
+ "'" + url.toString() + "'"
+ ": " + ex.toString()));
}
String uriPath = uri.getPath();
if (null == uriPath) {
// We make an exception for forms like "file:z:/foo/path"
uriPath = uri.getSchemeSpecificPart();
if (uriPath == null || uriPath.equals("")) {
error(new LispError("The URI has no path: " + uri));
}
// Under Windows, deal with pathnames containing
// devices expressed as "file:z:/foo/path"
uriPath = uri.getSchemeSpecificPart();
if (uriPath == null || uriPath.equals("")) {
error(new LispError("The URI has no path: " + uri));
}
}
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.device = p.device;
this.directory = p.directory;
......@@ -403,32 +413,31 @@ public class Pathname extends LispObject {
}
String authority = uri.getAuthority();
if (authority == null) {
authority = url.getAuthority();
if (authority == null) {
Debug.trace(MessageFormat.format("{0} has a null authority.",
url));
}
authority = url.getAuthority();
if (authority == null) {
Debug.trace(MessageFormat.format("{0} has a null authority.", url));
}
}
host = NIL;
host = host.push(SCHEME);
host = host.push(new SimpleString(scheme));
host = NIL;
host = host.push(SCHEME);
host = host.push(new SimpleString(scheme));
if (authority != null) {
host = host.push(AUTHORITY);
host = host.push(new SimpleString(authority));
host = host.push(AUTHORITY);
host = host.push(new SimpleString(authority));
}
device = NIL;
device = NIL;
// URI encode necessary characters
String path = uri.getRawPath();
if (path == null) {
path = "";
}
String query = uri.getRawQuery();
if (query != null) {
host = host.push(QUERY);
// URI encode necessary characters
String path = uri.getRawPath();
if (path == null) {
path = "";
}
String query = uri.getRawQuery();
if (query != null) {
host = host.push(QUERY);
host = host.push(new SimpleString(query));
}
String fragment = uri.getRawFragment();
......@@ -1648,11 +1657,12 @@ public class Pathname extends LispObject {
path = file.getCanonicalPath();
}
URI pathURI = (new File(path)).toURI();
p = new Pathname(pathURI.toString());
p = new Pathname(pathURI);
result = new Cons(p, result);
}
} catch (IOException e) {
return error(new FileError("Unable to list directory " + pathname.princToString() + ".",
return error(new FileError("Unable to list directory "
+ pathname.princToString() + ".",
pathname));
} catch (SecurityException e) {
Debug.trace(e);
......
......@@ -61,49 +61,43 @@
(newpath (make-pathname :directory non-wild
:name nil :type nil :defaults pathname))
(entries (list-directory newpath resolve-symlinks)))
(if (not (or wild wild-inferiors-found))
entries
(let ((inferior-entries (when (or wild-inferiors-found first-wild-inferior) entries)))
(nconc
(mapcan (lambda (entry)
(when (pathname-match-p (pathname entry) pathname)
(list entry)))
inferior-entries)
(mapcan (lambda (entry)
(let* ((pathname (pathname entry))
(directory (pathname-directory pathname))
(rest-wild (cdr wild)))
(unless (pathname-name pathname)
(when (pathname-match-p (first (last directory))
(cond ((eql (car wild) :wild)
"*")
((eql (car wild) :wild-inferiors)
"*")
(wild
(car wild))
(t "")))
(when (and
(not (or first-wild-inferior
wild-inferiors-found))
rest-wild)
(setf directory (nconc directory rest-wild)))
(let ((recurse (make-pathname :directory directory
:defaults newpath)))
(when (not (equal recurse newpath))
(list-directories-with-wildcards
recurse
(or first-wild-inferior wild-inferiors-found)
resolve-symlinks)))))))
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))
(when (not (or wild wild-inferiors-found)) ;; no further recursion necessary
(return-from list-directories-with-wildcards entries))
(let ((inferior-entries (when (or wild-inferiors-found first-wild-inferior) entries)))
(nconc
(mapcan (lambda (entry)
(when (pathname-match-p (pathname entry) pathname)
(list entry)))
inferior-entries)
(mapcan (lambda (entry)
(let* ((pathname (pathname entry))
(directory (pathname-directory pathname))
(rest-wild (cdr wild)))
(unless (pathname-name pathname)
(when (pathname-match-p (first (last directory))
(cond ((eql (car wild) :wild)
"*")
((eql (car wild) :wild-inferiors)
"*")
(wild
(car wild))
(t "")))
(when (and
(not (or first-wild-inferior
wild-inferiors-found))
rest-wild)
(setf directory (nconc directory rest-wild)))
(let ((recurse (make-pathname :directory directory
:defaults newpath)))
(when (not (equal recurse newpath))
(list-directories-with-wildcards
recurse
(or first-wild-inferior wild-inferiors-found)
resolve-symlinks)))))))
entries)))))
(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.
"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.
With :RESOLVE-SYMLINKS set to nil, not all pathnames returned may
correspond to an existing file. Symbolic links are considered to be
......@@ -140,11 +134,17 @@ error to its caller."
(file-directory-p entry)
(pathname-match-p (file-namestring (pathname-as-file entry))
(file-namestring pathname)))
(pathname-match-p (or (file-namestring entry) "") (file-namestring pathname)))
(pathname-match-p (or (file-namestring entry) "")
(file-namestring pathname)))
(push
(if resolve-symlinks
(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))))
;; Not wild.
......
......@@ -101,4 +101,17 @@ public class PathnameTest
String s = r.getNamestring();
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