Changeset 13704

Timestamp:

12/18/11 21:08:13 (11 years ago)

Author:

Mark Evenson

Message:

Fix #181: TRUENAME doesn't always canonicalize the outer DEVICE component of JAR-PATHNAME.

If *DEFAULT-PATHNAME-DEFAULTS* is a JAR-PATHNAME, then TRUENAME will
not attempt to canonicalize the outer DEVICE component of a JAR-PATHNAME.

Remove corresponding kludge from ASDF.

Location:

trunk/abcl

Files:

• src/org/armedbear/lisp/Pathname.java (modified) (1 diff)
• src/org/armedbear/lisp/asdf.lisp (modified) (1 diff)
• test/lisp/abcl/jar-pathname.lisp (modified) (1 diff)

trunk/abcl/src/org/armedbear/lisp/Pathname.java

@@ -2180 +2180 @@
             Cons jars = (Cons) pathname.device;
             LispObject o = jars.car();
-            if (o instanceof Pathname && ! (((Pathname)o).isURL())) {
+            if (o instanceof Pathname 
+                && !(((Pathname)o).isURL())
+                // XXX Silently fail to call truename() if the default
+                // pathname defaults exist within a jar, as that will
+                // (probably) not succeed.  The better solution would
+                // probably be to parametize the value of
+                // *DEFAULT-PATHNAME-DEFAULTS* on invocations of
+                // truename().
+                && !coerceToPathname(Symbol.DEFAULT_PATHNAME_DEFAULTS.symbolValue()).isJar()) 
+                {
                 LispObject truename = Pathname.truename((Pathname)o, errorIfDoesNotExist);
-                if (truename != null
+                if (truename != null && truename != NIL
                     && truename instanceof Pathname) {
                     Pathname truePathname = (Pathname)truename;

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

@@ -1651 +1651 @@
                    (*default-pathname-defaults*
                     (pathname-directory-pathname pathname)))
-               ;;; XXX Kludge for ABCL ticket #181 
-               #+abcl
-               (when (ext:pathname-jar-p pathname) 
-                 (setf *default-pathname-defaults* 
-                       (make-pathname :device nil :defaults *default-pathname-defaults*)))
                (asdf-message (compatfmt "~&~@<; ~@;Loading system definition from ~A into ~A~@:>~%")
                              pathname package)

trunk/abcl/test/lisp/abcl/jar-pathname.lisp

@@ -485 +485 @@
 ;;; TODO Make reasons for failure more clear
 (deftest jar-pathname.truename.1
-    (let* ((abcl (slot-value (asdf:find-system 'abcl) 'asdf::absolute-pathname))
-           (jar (pathname (format nil "jar:file:~A/dist/abcl-contrib.jar!/jss/jss.asd" (namestring abcl))))
-           (jar-dir (make-pathname :defaults jar :name nil :type nil))
-           (defaults *default-pathname-defaults*))
-      (let ((*default-pathname-defaults* jar-dir))
-        (not (probe-file (merge-pathnames jar)))))
+    (let* ((abcl 
+            (slot-value (asdf:find-system 'abcl) 'asdf::absolute-pathname))
+           (jar-entry 
+            (pathname (format nil "jar:file:~A/dist/abcl-contrib.jar!/jss/jss.asd" (namestring abcl))))
+           (jar-entry-dir 
+            (make-pathname :defaults jar-entry :name nil :type nil))
+           (defaults 
+            *default-pathname-defaults*))
+      (let ((*default-pathname-defaults* jar-entry-dir))
+        (not (probe-file (merge-pathnames jar-entry)))))
   nil)