Fixes #243: MAKE-PATHNAME with a DEVICE string.

We allow DEVICE lists to contain a string value as constructed by
MAKE-PATHNAME, but the result can never actually be resolvable by
TRUENAME.

Instead of trying to figure out the proper use of Java labels, just
use the private static Pathname.doTruenameExit() as the common point
for all exits from the TRUENAME implementation.
parent 7611bdce
......@@ -654,11 +654,15 @@ public class Pathname extends LispObject {
StringBuilder prefix = new StringBuilder();
for (int i = 0; i < jars.length; i++) {
prefix.append("jar:");
if (!((Pathname)jars[i]).isURL() && i == 0) {
LispObject component = jars[i];
if (!(component instanceof Pathname)) {
return null; // If DEVICE is a CONS, it should only contain Pathname
}
if (! ((Pathname)component).isURL() && i == 0) {
sb.append("file:");
uriEncoded = true;
}
Pathname jar = (Pathname) jars[i];
Pathname jar = (Pathname) component;
String encodedNamestring;
if (uriEncoded) {
encodedNamestring = uriEncode(jar.getNamestring());
......@@ -2152,14 +2156,8 @@ public class Pathname extends LispObject {
public static final LispObject truename(Pathname pathname,
boolean errorIfDoesNotExist)
{
if (pathname == null || pathname.equals(NIL)) { // XXX duplicates code at the end of this longish function: figure out proper nesting of labels.
if (errorIfDoesNotExist) {
StringBuilder sb = new StringBuilder("The file ");
sb.append(pathname.princToString());
sb.append(" does not exist.");
return error(new FileError(sb.toString(), pathname));
}
return NIL;
if (pathname == null || pathname.equals(NIL)) {
return doTruenameExit(pathname, errorIfDoesNotExist);
}
if (pathname instanceof LogicalPathname) {
pathname = LogicalPathname.translateLogicalPathname((LogicalPathname) pathname);
......@@ -2209,6 +2207,9 @@ public class Pathname extends LispObject {
// Possibly canonicalize jar file directory
Cons jars = (Cons) pathname.device;
LispObject o = jars.car();
if (!(o instanceof Pathname)) {
return doTruenameExit(pathname, errorIfDoesNotExist);
}
if (o instanceof Pathname
&& !(((Pathname)o).isURL())
// XXX Silently fail to call truename() if the default
......@@ -2286,6 +2287,10 @@ public class Pathname extends LispObject {
}
}
error:
return doTruenameExit(pathname, errorIfDoesNotExist);
}
static private LispObject doTruenameExit(Pathname pathname, boolean errorIfDoesNotExist) {
if (errorIfDoesNotExist) {
StringBuilder sb = new StringBuilder("The file ");
sb.append(pathname.princToString());
......
......@@ -111,3 +111,14 @@ Subject: [armedbear-devel] Bug in translate-logical-pathname.
2)
3)
;;; http://trac.common-lisp.net/armedbear/ticket/243
(deftest bugs.pathname.make-pathname.1
(signals-error
(make-pathname :device (list "foo"))
'error)
t)
(deftest bugs.pathname.make-pathname.2
(probe-file (make-pathname :device (list "foo")))
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