Changeset 14179


Ignore:
Timestamp:
10/11/12 11:33:26 (8 years ago)
Author:
Mark Evenson
Message:

Fix ASDF loading recursively from JAR-PATHNAME.

With this patch, JNA should (finally) load again.

The problem manifested itself when recursive loads of ASDF systems are
triggered for which the systems are stored in a jar archive but it
could also be triggered by setting *DEFAULT-PATHNAME-DEFAULTS* to a
JAR-PATHNAME.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/src/org/armedbear/lisp/asdf.lisp

    r14166 r14179  
    39623962      (values output-truename warnings-p failure-p))))
    39633963
    3964 #+abcl
     3964#+abcl 
    39653965(defun* translate-jar-pathname (source wildcard)
    39663966  (declare (ignore wildcard))
    3967   (let* ((p (pathname (first (pathname-device source))))
    3968          (root (format nil "/___jar___file___root___/~@[~A/~]"
    3969                        (and (find :windows *features*)
    3970                             (pathname-device p)))))
    3971     (apply-output-translations
    3972      (merge-pathnames*
    3973       (relativize-pathname-directory source)
    3974       (merge-pathnames*
    3975        (relativize-pathname-directory (ensure-directory-pathname p))
    3976        root)))))
     3967  (let* ((jar
     3968          (pathname (first (pathname-device source))))
     3969         (target-root-directory-namestring
     3970          (format nil "/___jar___file___root___/~@[~A/~]"
     3971                  (and (find :windows *features*)
     3972                       (pathname-device jar))))
     3973         (relative-source
     3974          (relativize-pathname-directory source))
     3975         (relative-jar
     3976          (relativize-pathname-directory (ensure-directory-pathname jar)))
     3977         (target-root-directory
     3978          (if (find :windows *features*)
     3979              (make-pathname :name nil
     3980                             :type nil
     3981                             :version nil
     3982                             :defaults (parse-namestring target-root-directory-namestring))
     3983              (make-pathname :device :unspecific
     3984                             :name nil
     3985                             :type nil
     3986                             :version nil
     3987                             :defaults (parse-namestring target-root-directory-namestring))))
     3988         (target-root
     3989          (merge-pathnames* relative-jar target-root-directory))
     3990         (target
     3991          (merge-pathnames* relative-source target-root)))
     3992    (if (find :windows *features*)
     3993        (apply-output-translations target)
     3994        (make-pathname :defaults (apply-output-translations target)
     3995                       :device :unspecific))))
    39773996
    39783997;;;; -----------------------------------------------------------------
Note: See TracChangeset for help on using the changeset viewer.