From 3bc52526024b81149cea1e3dc11fe965a2efecde Mon Sep 17 00:00:00 2001
From: Christophe Rhodes <csr21@cantab.net>
Date: Mon, 21 Aug 2006 10:52:32 +0000
Subject: [PATCH] Be a little bit more defensive about looking up classes for
 component types.

It seems regrettably common for system authors, despite the
documentation, to place their system in CL-USER, where the user can
quite legitimately add symbols.  Adjust the lookup code in
CLASS-FOR-TYPE to ignore symbols not naming subclasses of
ASDF:COMPONENT, and also to try the symbol itself first if it's not
a keyword.  Also adjust the documentation slightly to make this slightly
clearer.

Add test files, and make the clisp test-harness work for me.
---
 README                   | 13 ++++++++-----
 asdf.lisp                | 19 ++++++++++++-------
 test/run-tests.sh        |  2 +-
 test/test-package.asd    | 10 ++++++++++
 test/test-package.script | 10 ++++++++++
 5 files changed, 41 insertions(+), 13 deletions(-)
 create mode 100644 test/test-package.asd
 create mode 100644 test/test-package.script

diff --git a/README b/README
index a89d8695..c6d289d5 100644
--- a/README
+++ b/README
@@ -1,4 +1,4 @@
-$Id: README,v 1.38 2004/07/19 21:18:07 crhodes Exp $         -*- Text -*-
+$Id: README,v 1.39 2006/08/21 10:52:32 crhodes Exp $         -*- Text -*-
 
 The canonical documentation for asdf is in the file asdf.texinfo.  
 The significant overlap between this file and that will one day be
@@ -117,9 +117,10 @@ the grunt work.
 
 asdf is extensible to new operations and to new component types.  This
 allows the addition of behaviours: for example, a new component could
-be added for Java JAR archives, and methods specialised on
-compile-op added for it that would accomplish the relevant
-actions.
+be added for Java JAR archives, and methods specialised on compile-op
+added for it that would accomplish the relevant actions.  Users
+defining their own operations and component types should inherit from
+the asdf base classes asdf:operation and asdf:component respectively.
 
 * Inspiration
 
@@ -478,7 +479,9 @@ package is created for them to load into, so that different systems do
 not overwrite each others operations.  The user may also wish to (and
 is recommended to) include defpackage and in-package forms in his
 system definition files, however, so that they can be loaded manually
-if need be.
+if need be.  It is not recommended to use the CL-USER package for this
+purpose, as definitions made in this package will affect the parsing
+of asdf systems.
 
 For convenience in the normal case, and for backward compatibility
 with the spirit of mk-defsystem, the default contents of
diff --git a/asdf.lisp b/asdf.lisp
index f865f511..cfe37301 100644
--- a/asdf.lisp
+++ b/asdf.lisp
@@ -1,4 +1,4 @@
-;;; This is asdf: Another System Definition Facility.  $Revision: 1.100 $
+;;; This is asdf: Another System Definition Facility.  $Revision: 1.101 $
 ;;;
 ;;; Feedback, bug reports, and patches are all welcome: please mail to
 ;;; <cclan-list@lists.sf.net>.  But note first that the canonical
@@ -112,7 +112,7 @@
 
 (in-package #:asdf)
 
-(defvar *asdf-revision* (let* ((v "$Revision: 1.100 $")
+(defvar *asdf-revision* (let* ((v "$Revision: 1.101 $")
 			       (colon (or (position #\: v) -1))
 			       (dot (position #\. v)))
 			  (and v colon dot 
@@ -946,11 +946,16 @@ system."))
   
 
 (defun class-for-type (parent type)
-  (let ((class 
-	 (find-class
-	  (or (find-symbol (symbol-name type) *package*)
-	      (find-symbol (symbol-name type) #.(package-name *package*)))
-	  nil)))
+  (let* ((extra-symbols (list (find-symbol (symbol-name type) *package*)
+                              (find-symbol (symbol-name type) 
+                                           #.(package-name *package*))))
+         (class (dolist (symbol (if (keywordp type)
+                                    extra-symbols
+                                    (cons type extra-symbols)))
+                  (when (and symbol 
+                             (find-class symbol nil)
+                             (subtypep symbol 'component))
+                    (return (find-class symbol))))))
     (or class
 	(and (eq type :file)
 	     (or (module-default-component-class parent)
diff --git a/test/run-tests.sh b/test/run-tests.sh
index 0c4f87e1..caa3bfa8 100644
--- a/test/run-tests.sh
+++ b/test/run-tests.sh
@@ -35,5 +35,5 @@ fi
 
 if [ -x /usr/bin/clisp ]
 then 
-  do_tests "/usr/bin/clisp -norc -ansi -I " fas
+  do_tests "/usr/bin/clisp -norc -ansi -I - " fas
 fi
diff --git a/test/test-package.asd b/test/test-package.asd
new file mode 100644
index 00000000..627ea79a
--- /dev/null
+++ b/test/test-package.asd
@@ -0,0 +1,10 @@
+;;; NB: This way of managing packages is explicitly NOT recommended.
+;;; However, it is found in the wild, and debugging it is a pain, so
+;;; we should probably not break.  The thing that this is testing is
+;;; that unrelated definitions of symbols naming ASDF keywords should
+;;; not affect the parsing of a system.
+
+(in-package :cl-user) ; BAD BAD BAD
+
+(asdf:defsystem test-package
+  :components ((:module "foo" :components ((:file "bar") (:file "baz")))))
\ No newline at end of file
diff --git a/test/test-package.script b/test/test-package.script
new file mode 100644
index 00000000..f541d8a3
--- /dev/null
+++ b/test/test-package.script
@@ -0,0 +1,10 @@
+(in-package :cl-user)
+(load "../asdf")
+
+(defun module () 1)
+
+(load "test-package.asd")
+
+(defclass module () ())
+
+(load "test-package.asd")
-- 
GitLab