0.9.10.42:

[sbcl.git] / contrib / asdf-stub.lisp

diff --git a/contrib/asdf-stub.lisp b/contrib/asdf-stub.lisp
index d084d72..1baef5f 100644 (file)
--- a/contrib/asdf-stub.lisp
+++ b/contrib/asdf-stub.lisp
@@ -1,26 +1,18 @@
-(load "../asdf/asdf")
+(load "SYS:CONTRIB;ASDF;ASDF.FASL")
 
-(setf asdf::*central-registry*
-      '((merge-pathnames "systems/" (truename (sb-ext:posix-getenv "SBCL_HOME")))))
-(push :sb-building-contrib *features*)
-(asdf:operate 'asdf:load-op *system*)
-
-(defvar *system-stub* (make-pathname :name *system* :type "lisp"))
-
-(when (probe-file (compile-file-pathname *system-stub*))
-  (error "fasl file exists"))
-
-(with-open-file (s *system-stub* :direction :output :if-exists :error)
-  (print '(unless (member "ASDF" *modules* :test #'string=)
-           (load (merge-pathnames "asdf/asdf.fasl" (truename (sb-ext:posix-getenv "SBCL_HOME")))))
-         s)
-  ;; This addition to *central-registry* allows us to find contribs
-  ;; even if the user has frobbed the original contents.
-  (print `(let ((asdf:*central-registry* (cons (merge-pathnames "systems/"
-                                                                (truename (sb-ext:posix-getenv "SBCL_HOME")))
-                                               asdf:*central-registry*)))
-           (asdf::module-provide-asdf ,*system*))
-         s))
-
-(compile-file *system-stub*)
-(delete-file *system-stub*)
+(let ((asdf:*central-registry* nil))
+  (push :sb-building-contrib *features*)
+  (asdf:operate 'asdf:load-op *system*)
+  (let ((stub (make-pathname :name *system* :type "lisp")))
+    (when (probe-file (compile-file-pathname stub))
+      (error "fasl file exists"))
+    (with-open-file (s stub :direction :output :if-exists :error)
+      (print '(unless (member "ASDF" *modules* :test #'string=)
+               (require :asdf))
+             s)
+      ;; we find our contribs without reference to *central-registry*.
+      (print `(let ((asdf:*central-registry* nil))
+               (asdf::module-provide-asdf ,*system*))
+             s))
+    (compile-file stub)
+    (delete-file stub)))