Commit 445eba4e authored by Mark Evenson's avatar Mark Evenson 💬 Committed by Robert Goldman
Browse files

abcl: fix loading asdf definition from jar files

parent 11a691c0
...@@ -259,13 +259,19 @@ typically but not necessarily representing the files in a subdirectory of the bu ...@@ -259,13 +259,19 @@ typically but not necessarily representing the files in a subdirectory of the bu
;; We ought to be able to extract this from the component alone with FILE-TYPE. ;; We ought to be able to extract this from the component alone with FILE-TYPE.
;; TODO: track who uses it in Quicklisp, and have them not use it anymore; ;; TODO: track who uses it in Quicklisp, and have them not use it anymore;
;; maybe issue a WARNING (then eventually CERROR) if the two methods diverge? ;; maybe issue a WARNING (then eventually CERROR) if the two methods diverge?
(parse-unix-namestring (let (#+abcl
(or (and (slot-boundp component 'relative-pathname) (parent
(slot-value component 'relative-pathname)) (component-parent-pathname component)))
(component-name component)) (parse-unix-namestring
:want-relative t (or (and (slot-boundp component 'relative-pathname)
:type (source-file-type component (component-system component)) (slot-value component 'relative-pathname))
:defaults (component-parent-pathname component))) (component-name component))
:want-relative
#-abcl t
;; JAR-PATHNAMES always have absolute directories
#+abcl (not (ext:pathname-jar-p parent))
:type (source-file-type component (component-system component))
:defaults (component-parent-pathname component))))
(defmethod source-file-type ((component parent-component) (system parent-component)) (defmethod source-file-type ((component parent-component) (system parent-component))
:directory) :directory)
......
...@@ -473,12 +473,27 @@ to throw an error if the pathname is absolute" ...@@ -473,12 +473,27 @@ to throw an error if the pathname is absolute"
(values filename type)) (values filename type))
(t (t
(split-name-type filename))) (split-name-type filename)))
(apply 'ensure-pathname (let* ((directory
(make-pathname (unless file-only (cons relative path)))
:directory (unless file-only (cons relative path)) (pathname
:name name :type type #-abcl
:defaults (or #-mcl defaults *nil-pathname*)) (make-pathname
(remove-plist-keys '(:type :dot-dot :defaults) keys)))))) :directory directory
:name name :type type
:defaults (or #-mcl defaults *nil-pathname*))
#+abcl
(if (and defaults
(ext:pathname-jar-p defaults)
(null directory))
;; When DEFAULTS is a jar, it will have the directory we want
(make-pathname :name name :type type
:defaults (or defaults *nil-pathname*))
(make-pathname :name name :type type
:defaults (or defaults *nil-pathname*)
:directory directory))))
(apply 'ensure-pathname
pathname
(remove-plist-keys '(:type :dot-dot :defaults) keys)))))))
(defun unix-namestring (pathname) (defun unix-namestring (pathname)
"Given a non-wild PATHNAME, return a Unix-style namestring for it. "Given a non-wild PATHNAME, return a Unix-style namestring for it.
......
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