Changeset 13718

Timestamp:

01/04/12 21:51:15 (12 years ago)

Author:

Mark Evenson

Message:

backport r13704: Fix problems loading ABCL-CONTRIB.

Location:

branches/1.0.x/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)

branches/1.0.x/abcl/src/org/armedbear/lisp/Pathname.java

@@ -2170 +2170 @@
             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;

branches/1.0.x/abcl/src/org/armedbear/lisp/asdf.lisp

@@ -1654 +1654 @@
                    (*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)

branches/1.0.x/abcl/test/lisp/abcl/jar-pathname.lisp

@@ -482 +482 @@
   #p"/foo/d/e/f.lisp")
 
-      
-
-        
-
-  
+;;; ticket #181
+;;; TODO Make reasons for failure more clear
+(deftest jar-pathname.truename.1
+    (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)