[asdf-devel] patch for component-relative-pathname
james anderson
james.anderson at setf.de
Fri Feb 19 10:59:44 UTC 2010
good morning;
if a system definition root pathname contains a logical host,
component-relative-pathname fails to produce pathnames which are
relative in the sense that the combination with their parent's
component pathname produces the intended location. this patch
corrects that failing for sbcl and ccl.
(defmethod component-relative-pathname ((component source-file))
(let ((*default-pathname-defaults*
(component-pathname (component-parent component))))
(merge-component-relative-pathname
(slot-value component 'relative-pathname)
(component-name component)
(source-file-type component (component-system component)))))
attached below are descriptions of the respective data which
illustrate the problem.
in sbcl, when the result "relative" pathname is merged with that of
the parent, the physical pathname host shadows the logical host.
in ccl, the defaulting logic for make-pathname asserts an absolute
root directory path in the "relative" pathname.
sbcl:
-------
0] (rest (asdf::system-registered-p :de.setf.amqp))
#<ASDF:SYSTEM "de.setf.amqp" {11D56469}>
0] (describe *)
#<ASDF:SYSTEM "de.setf.amqp" {11D56469}>
[standard-object]
Slots with :INSTANCE allocation:
NAME = "de.setf.amqp"
VERSION = "20100214-0.3"
IN-ORDER-TO = ((ASDF:LOAD-OP..
DO-FIRST = ((ASDF:COMPILE-OP..
INLINE-METHODS = NIL
PARENT = NIL
RELATIVE-PATHNAME = #P"AMQP:"
OPERATION-TIMES = #<HASH-TABLE :TEST EQL :COUNT 0
{11D9C791}>
PROPERTIES = ((ASDF:SYSTEM-NICKNAMES :SETF.AMQP)..
COMPONENTS = (#<ASDF:CL-SOURCE-FILE
"package" {11DC6E11}>..
IF-COMPONENT-DEP-FAILS = :FAIL
DEFAULT-COMPONENT-CLASS = NIL
DESCRIPTION = "An AMQP client library"
LONG-DESCRIPTION = "`de.setf.amqp` implements a native
Common Lisp client library for the..
AUTHOR = #<unbound slot>
MAINTAINER = #<unbound slot>
LICENCE = #<unbound slot>
SOURCE-FILE = #P"/Development/Source/dev/Library/de/
setf/amqp/amqp.asd"
0] (rest (asdf::system-registered-p :de.setf.utility))
#<ASDF:SYSTEM "de.setf.utility" {11D9C2B9}>
0] (describe *)
#<ASDF:SYSTEM "de.setf.utility" {11D9C2B9}>
[standard-object]
Slots with :INSTANCE allocation:
NAME = "de.setf.utility"
VERSION = "20100214-1.0"
IN-ORDER-TO = NIL
DO-FIRST = ((ASDF:COMPILE-OP (ASDF:LOAD-OP)))
INLINE-METHODS = NIL
PARENT = NIL
RELATIVE-PATHNAME = #P"LIBRARY:DE;SETF;UTILITY;"
OPERATION-TIMES = #<HASH-TABLE :TEST EQL :COUNT 0
{11DEACB9}>
PROPERTIES = ((ASDF:SYSTEM-NICKNAMES
"de.setf.utility"))
COMPONENTS = (#<ASDF:CL-SOURCE-FILE
"package" {11D9C8D9}>..
IF-COMPONENT-DEP-FAILS = :FAIL
DEFAULT-COMPONENT-CLASS = NIL
DESCRIPTION = #<unbound slot>
LONG-DESCRIPTION = #<unbound slot>
AUTHOR = #<unbound slot>
MAINTAINER = #<unbound slot>
LICENCE = #<unbound slot>
SOURCE-FILE = #P"/Development/Source/dev/Library/de/
setf/utility/utility.asd"
0] (first (asdf::module-components (rest (asdf::system-registered-
p :de.setf.utility))))
#<ASDF:CL-SOURCE-FILE "package" {11D9C8D9}>
0] (describe *)
#<ASDF:CL-SOURCE-FILE "package" {11D9C8D9}>
[standard-object]
Slots with :INSTANCE allocation:
NAME = "package"
VERSION = #<unbound slot>
IN-ORDER-TO = NIL
DO-FIRST = ((ASDF:COMPILE-OP (ASDF:LOAD-OP)))
INLINE-METHODS = NIL
PARENT = #<ASDF:SYSTEM "de.setf.utility" {11D9C2B9}>
RELATIVE-PATHNAME = NIL
OPERATION-TIMES = #<HASH-TABLE :TEST EQL :COUNT 0 {11DEC591}>
PROPERTIES = NIL
0] (describe (asdf::component-relative-pathname (first (asdf::module-
components (rest (asdf::system-registered-p :de.setf.utility))))))
#P"package.lisp"
[structure-object]
Slots with :INSTANCE allocation:
HOST = #<SB-IMPL::UNIX-HOST {102CE661}>
DEVICE = NIL
DIRECTORY = (:RELATIVE)
NAME = "package"
TYPE = "lisp"
VERSION = :NEWEST
0] (type-of (asdf::component-relative-pathname (first (asdf::module-
components (rest (asdf::system-registered-p :de.setf.utility))))))
PATHNAME
0] ;
-------
ccl:
------
> Error: File #P"LIBRARY:package.lisp.newest" not found
> While executing: CCL::FCOMP-FIND-FILE, in process listener(1).
> Type :GO to continue, :POP to abort, :R for a list of available
restarts.
> If continued: Skip evaluation of (asdf:operate 'asdf:load-
op :de.setf.amqp.amqp-1-1-0-8-0)
> Type :? for other options.
1 > (describe (rest (asdf::system-registered-p :de.setf.utility)))
#<SYSTEM "de.setf.utility" #x878732E>
Class: #<STANDARD-CLASS ASDF:SYSTEM>
Wrapper: #<CCL::CLASS-WRAPPER ASDF:SYSTEM #x86085FE>
Instance slots
ASDF::NAME: "de.setf.utility"
ASDF:VERSION: "20100214-1.0"
ASDF::IN-ORDER-TO: NIL
ASDF::DO-FIRST: ((ASDF:COMPILE-OP (ASDF:LOAD-OP)))
ASDF::INLINE-METHODS: NIL
ASDF::PARENT: NIL
ASDF::RELATIVE-PATHNAME: #P"LIBRARY:de;setf;utility;"
ASDF::OPERATION-TIMES: #<HASH-TABLE :TEST EQL size 0/60 #x878702E>
ASDF::PROPERTIES: ((ASDF:SYSTEM-NICKNAMES "de.setf.utility"))
ASDF::COMPONENTS: (#<CL-SOURCE-FILE "package" #x8786E86>
#<CL-SOURCE-FILE "pathnames" #x8786B1E>
#<CL-SOURCE-FILE "modpackage" #x878675E>
#<MODULE "documentation" #x878637E>
#<CL-SOURCE-FILE "string" #x87857FE>
#<CL-SOURCE-FILE "conditions" #x87853F6>
#<MODULE "clos" #x8784FCE> #<MODULE "test"
#x87847EE>
#<CL-SOURCE-FILE "date" #x8783C56>
#<CL-SOURCE-FILE "list" #x87837EE>)
ASDF::IF-COMPONENT-DEP-FAILS: :FAIL
ASDF::DEFAULT-COMPONENT-CLASS: NIL
ASDF::DESCRIPTION: #<Unbound>
ASDF::LONG-DESCRIPTION: #<Unbound>
ASDF::AUTHOR: #<Unbound>
ASDF::MAINTAINER: #<Unbound>
ASDF::LICENCE: #<Unbound>
ASDF:SOURCE-FILE: #P"/Development/Source/dev/Library/de/setf/utility/
utility.asd"
1 > (describe (first (asdf::module-components (rest (asdf::system-
registered-p :de.setf.utility)))))
#<CL-SOURCE-FILE "package" #x8786E86>
Class: #<STANDARD-CLASS ASDF:CL-SOURCE-FILE>
Wrapper: #<CCL::CLASS-WRAPPER ASDF:CL-SOURCE-FILE #x8643A8E>
Instance slots
ASDF::NAME: "package"
ASDF:VERSION: #<Unbound>
ASDF::IN-ORDER-TO: NIL
ASDF::DO-FIRST: ((ASDF:COMPILE-OP (ASDF:LOAD-OP)))
ASDF::INLINE-METHODS: NIL
ASDF::PARENT: #<SYSTEM "de.setf.utility" #x878732E>
ASDF::RELATIVE-PATHNAME: NIL
ASDF::OPERATION-TIMES: #<HASH-TABLE :TEST EQL size 0/60 #x8786B86>
ASDF::PROPERTIES: NIL
1 > (describe (asdf::component-relative-pathname (first (asdf::module-
components (rest (asdf::system-registered-p :de.setf.utility))))))
#P"LIBRARY:package.lisp.newest"
Type: LOGICAL-PATHNAME
Class: #<BUILT-IN-CLASS LOGICAL-PATHNAME>
TYPE: (LOGICAL-PATHNAME . #<CCL::CLASS-WRAPPER LOGICAL-PATHNAME
#x809E75E>)
1: (:ABSOLUTE)
2: "package"
3: "lisp"
%LOGICAL-PATHNAME-HOST: "LIBRARY"
%LOGICAL-PATHNAME-VERSION: :NEWEST
1 > (in-package :asdf)
#<Package "ASDF">
1 > (defmethod component-relative-pathname ((component source-file))
(let ((*default-pathname-defaults*
(make-pathname :name nil :type nil :directory nil :host nil
:defaults (component-pathname (component-
parent component)))))
(merge-component-relative-pathname
(slot-value component 'relative-pathname)
(component-name component)
(source-file-type component (component-system component)))))
#<STANDARD-METHOD COMPONENT-RELATIVE-PATHNAME (SOURCE-FILE)>
1 > (describe (asdf::component-relative-pathname (first (asdf::module-
components (rest (asdf::system-registered-p :de.setf.utility))))))
#P"package.lisp"
Type: PATHNAME
Class: #<BUILT-IN-CLASS PATHNAME>
TYPE: (PATHNAME . #<CCL::CLASS-WRAPPER PATHNAME #x80A0F16>)
%PATHNAME-DIRECTORY: (:RELATIVE)
%PATHNAME-NAME: "package"
%PATHNAME-TYPE: "lisp"
%PHYSICAL-PATHNAME-VERSION: :NEWEST
%PHYSICAL-PATHNAME-DEVICE: NIL
1 >
More information about the asdf-devel
mailing list