From 3ec3a4991c7b333d89110fc504868e847bf0c531 Mon Sep 17 00:00:00 2001 From: Daniel Barlow <> Date: Thu, 14 Feb 2002 12:38:54 +0000 Subject: [PATCH] component class - (pathname :initarg :pathname))) + (relative-pathname :initarg :pathname))) component-pathname, component-relative-pathname changed to actually work (defmethod print-object ((c component) stream) is suffering strangely, but that might just be me. try re-enabling this and see if itworks for you (defmethod perform ((o load-op) (c cl-source-file)) - (mapc nil #'load (output-files co c)))) + (map nil #'load (output-files co c)))) oops load-op and compile-and-load-op are actually the same thing (at least for CL files). need to choose a name ... --- asdf.lisp | 31 ++++++++++++++++--------------- 1 file changed, 16 insertions(+), 15 deletions(-) diff --git a/asdf.lisp b/asdf.lisp index 579c9ba2..2f046e70 100644 --- a/asdf.lisp +++ b/asdf.lisp @@ -89,9 +89,7 @@ (in-order-to :initform nil :initarg :in-order-to) ;; no direct accessor for pathname, we do this as a method to allow ;; it to default in funky ways if not supplied - ;; (:pathname is actually a really bad choice of name for this slot, - ;; because quite often that's not what we actually use it for) - (pathname :initarg :pathname))) + (relative-pathname :initarg :pathname))) #+ew (defun string-unix-common-casify (string &key (start 0) end) @@ -112,7 +110,7 @@ (defmethod component-pathname ((component component)) (let ((*default-pathname-defaults* *component-parent-pathname*)) - (if (slot-boundp component 'pathname) + (if (and nil (slot-boundp component 'pathname)) (let ((p (slot-value component 'pathname))) (cond ((pathnamep p) (merge-pathnames p)) @@ -126,10 +124,10 @@ (merge-pathnames (component-relative-pathname component))))) -(defmethod print-object ((c component) stream) +(defmethod print-object ((c component) (stream stream)) (print-unreadable-object (c stream :type t :identity t) - (ignore-errors - (prin1 (component-name c) stream)))) + (ignore-errors + (prin1 (component-name c) stream)))) (defclass module (component) ((components :accessor module-components :initarg :components) @@ -137,8 +135,9 @@ :initform 'cl-source-file :initarg :default-component-class))) (defmethod component-relative-pathname ((component module)) - (make-pathname :directory `(:relative ,(component-name component)) - :host (pathname-host *component-parent-pathname*))) + (let ((*default-pathname-defaults* *component-parent-pathname*)) + (or (slot-value component 'relative-pathname) + (make-pathname :directory `(:relative ,(component-name component)))))) (defgeneric find-component (module name) (:documentation "Finds the component with name NAME present in the @@ -166,10 +165,11 @@ system.")) ("java" . java-source-file))) (defmethod component-relative-pathname ((component source-file)) - (make-pathname :name (string-unix-common-casify (component-name component)) - :type (string-unix-common-casify (car (rassoc (class-name (class-of component)) - *known-extensions*))) - :case :common)) + (let ((*default-pathname-defaults* *component-parent-pathname*)) + (or (slot-value component 'relative-pathname) + (make-pathname :name (component-name component) + :type (car (rassoc (class-name (class-of component)) + *known-extensions*)))))) (defclass c-source-file (source-file) ()) (defclass java-source-file (source-file) ()) @@ -324,15 +324,16 @@ system.")) (defmethod perform ((o load-op) (c cl-source-file)) (let ((co (make-instance 'compile-op))) - (mapc nil #'load (output-files co c)))) + (map nil #'load (output-files co c)))) (defmethod output-files ((operation load-op) (c component)) nil) + ;;; compile-and-load-op (defclass compile-and-load-op (load-op) ()) -(defmethod component-depends-on ((operation compile-and-load-op) (c source-file)) +(defmethod component-depends-on ((operation load-op) (c source-file)) (cons (list 'compile-op (component-name c)) (call-next-method))) -- GitLab