[asdf-devel] Patch with ABCL specific changes

[Mark Evenson]

Attached please find a patch synchronizing the version of ASDF we intend 
to ship with abcl-1.1.0 with the canonical version.

These changes deal with bugs when using systems contained in jar 
archives via the ABCL implementation specific extension of CL:PATHNAME.

-------------- next part --------------
# ABCL specific changes
# Fixes:
#   *  ASDF definitions in jar archives for abcl-1.1.0-dev
#   *  ASDF-Binary-Locations in jar archives
diff -r 0c208158b9a0 asdf.lisp
--- a/asdf.lisp	Tue Nov 27 23:39:59 2012 -0500
+++ b/asdf.lisp	Wed Nov 28 12:15:26 2012 +0100
@@ -3961,19 +3961,38 @@
          (setf output-truename nil failure-p t)))
       (values output-truename warnings-p failure-p))))
 
-#+abcl
+#+abcl 
 (defun* translate-jar-pathname (source wildcard)
   (declare (ignore wildcard))
-  (let* ((p (pathname (first (pathname-device source))))
-         (root (format nil "/___jar___file___root___/~@[~A/~]"
-                       (and (find :windows *features*)
-                            (pathname-device p)))))
-    (apply-output-translations
-     (merge-pathnames*
-      (relativize-pathname-directory source)
-      (merge-pathnames*
-       (relativize-pathname-directory (ensure-directory-pathname p))
-       root)))))
+  (let* ((jar 
+          (pathname (first (pathname-device source))))
+         (target-root-directory-namestring
+          (format nil "/___jar___file___root___/~@[~A/~]"
+                  (and (find :windows *features*)
+                       (pathname-device jar))))
+         (relative-source 
+          (relativize-pathname-directory source))
+         (relative-jar 
+          (relativize-pathname-directory (ensure-directory-pathname jar)))
+         (target-root-directory
+          (if (find :windows *features*)
+              (make-pathname :name nil
+                             :type nil
+                             :version nil
+                             :defaults (parse-namestring target-root-directory-namestring))
+              (make-pathname :device :unspecific 
+                             :name nil
+                             :type nil
+                             :version nil
+                             :defaults (parse-namestring target-root-directory-namestring))))
+         (target-root 
+          (merge-pathnames* relative-jar target-root-directory))
+         (target 
+          (merge-pathnames* relative-source target-root)))
+    (if (find :windows *features*)
+        (apply-output-translations target)
+        (make-pathname :defaults (apply-output-translations target)
+                       :device :unspecific))))
 
 ;;;; -----------------------------------------------------------------
 ;;;; Compatibility mode for ASDF-Binary-Locations
@@ -4014,6 +4033,8 @@
     (initialize-output-translations
      `(:output-translations
        , at source-to-target-mappings
+       #+abcl (#p"jar:file:/**/*.jar!/**/*.*" (:function translate-jar-pathname))
+       #+abcl (#p"/___jar___file___root___/**/*.*" (, at destination-directory))
        ((:root ,*wild-inferiors* ,mapped-files)
         (, at destination-directory ,mapped-files))
        (t t)