Re: default-component-class slot normally gets clobbered

Richard M Kreuter <[email protected]> writes:

> The following is a patch that both emits the warning and supplies the
> initform for systems (and therefore emits the warning for every
> system).

Except for the part where I sent the wrong diff.

diff -u /home/kreuter/lsp/pkg/cclan/asdf/asdf.lisp /home/kreuter/lsp/pkg/cclan/asdf/asdf.lisp.dcc1
--- /home/kreuter/lsp/pkg/cclan/asdf/asdf.lisp	2006-06-15 22:30:13.000000000 -0400
+++ /home/kreuter/lsp/pkg/cclan/asdf/asdf.lisp.dcc1	2006-06-16 19:22:38.000000000 -0400
@@ -242,7 +242,7 @@
 			   :accessor module-if-component-dep-fails
 			   :initarg :if-component-dep-fails)
    (default-component-class :accessor module-default-component-class
-     :initform 'cl-source-file :initarg :default-component-class)))
+     :initarg :default-component-class)))
 
 (defgeneric component-pathname (component)
   (:documentation "Extracts the pathname applicable for a particular component."))
@@ -285,7 +285,8 @@
     :accessor system-long-description :initarg :long-description)
    (author :accessor system-author :initarg :author)
    (maintainer :accessor system-maintainer :initarg :maintainer)
-   (licence :accessor system-licence :initarg :licence)))
+   (licence :accessor system-licence :initarg :licence)
+   (default-component-class :initform 'cl-source-file)))
 
 ;;; version-satisfies
 
@@ -994,10 +995,18 @@
 	     :parent parent
 	     other-args)
       (when (typep ret 'module)
-	(setf (module-default-component-class ret)
-	      (or default-component-class
-		  (and (typep parent 'module)
-		       (module-default-component-class parent))))
+	(if (and (slot-boundp ret 'default-component-class)
+		 (not default-component-class))
+	    ;; This test and warning should go away eventually.
+	    (when  (module-default-component-class ret)
+	      (warn "Honoring default-component-class ~A of ~A.~%~
+ASDF versions prior to 1.98 always overwrote this slot during
+system initialization."
+		    (module-default-component-class ret) ret))
+	    (setf (module-default-component-class ret)
+		(or default-component-class
+		    (and (typep parent 'module)
+			 (module-default-component-class parent)))))
 	(let ((*serial-depends-on* nil))
 	  (setf (module-components ret)
 		(loop for c-form in components

Diff finished.  Fri Jun 16 19:29:44 2006