From cd468d51cfbe54941ba6d5792c858f37ea749b91 Mon Sep 17 00:00:00 2001
From: Gary King <gwking@franz.com>
Date: Tue, 11 Aug 2009 22:39:54 -0400
Subject: [PATCH] test-op depends on load-op (thanks to rpgoldman@sift.info)

* Improve error message for bad dependencies
* New default is for test-op to depend on load-op
* tweak run-program for SBCL so that ACL isn't #+no #+no bothered
* tweak write-test-web-page and write-license
* tweak some tests
---
 asdf.lisp                                  | 16 ++++++++++------
 bin/make-helper.lisp                       | 19 ++++++++++++-------
 test/test-nested-components-1.asd          |  5 +++--
 test/test-retry-loading-component-1.script |  2 +-
 4 files changed, 26 insertions(+), 16 deletions(-)

diff --git a/asdf.lisp b/asdf.lisp
index ea96382e..c82c6e8c 100644
--- a/asdf.lisp
+++ b/asdf.lisp
@@ -900,7 +900,7 @@ the head of the tree"))
 				       forced
 				       (do-one-dep op (second d) (third d))))
 				     (t
-				      (error "Dependencies must be (:version <version>), (:feature <feature>), or a name"))))
+				      (error "Bad dependency ~a.  Dependencies must be (:version <version>), (:feature <feature>), or a name" d))))
                               (t
                                (appendf forced (do-one-dep op d nil)))))))))
       (aif (component-visited-p operation c)
@@ -1129,6 +1129,10 @@ the head of the tree"))
   "Testing a system is _never_ done."
   nil)
 
+(defmethod component-depends-on :around ((o test-op) (c system))
+  (cons `(load-op ,(component-name c)) (call-next-method)))
+
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; invoking operations
 
@@ -1457,11 +1461,11 @@ output to `*verbose-out*`.  Returns the shell's exit code."
     (asdf-message "; $ ~A~%" command)
     #+sbcl
     (sb-ext:process-exit-code
-     (sb-ext:run-program
-      #+win32 "sh" #-win32 "/bin/sh"
-      (list  "-c" command)
-      #+win32 #+win32 :search t
-      :input nil :output *verbose-out*))
+     (apply #'sb-ext:run-program
+	    #+win32 "sh" #-win32 "/bin/sh"
+	    (list  "-c" command)
+	    :input nil :output *verbose-out*
+	    #+win32 '(:search t) #-win32 nil))
 
     #+(or cmu scl)
     (ext:process-exit-code
diff --git a/bin/make-helper.lisp b/bin/make-helper.lisp
index 2070916a..ea4c1dcf 100644
--- a/bin/make-helper.lisp
+++ b/bin/make-helper.lisp
@@ -1,8 +1,11 @@
 (in-package #:common-lisp-user)
-  
+
 #+(or)
 (build-web-page "/repository/git/asdf/test/results/" "/tmp/x.html" :if-exists :supersede)
 
+(defvar *make-helper-home* *load-truename*)  
+
+
 ;;; metatilities-base 
 ;;; because sometimes copy and paste is just too easy
 
@@ -259,22 +262,24 @@ None of %c, %F, %p, %x, %X, %Z, %z are implemented."
 
 (defun rewrite-license ()
   (let* ((*default-pathname-defaults* 
-	  (make-pathname :name nil :type nil :defaults *load-truename*))
-	 (output (merge-pathnames (make-pathname :name "LICENSE"))))
+	  (make-pathname :name nil :type nil :defaults *make-helper-home*))
+	 (output (merge-pathnames (make-pathname :name "LICENSE"
+	  :directory '(:relative :up)))))
     (when (probe-file output)
       (delete-file output))
     (extract-license 
-     (merge-pathnames (make-pathname :name "asdf" :type "lisp"))
+     (merge-pathnames (make-pathname :name "asdf" :type "lisp"
+      :directory '(:relative :up)))
      output)))
 
 (defun write-test-web-pages ()
   (let* ((*default-pathname-defaults* 
-	  (make-pathname :name nil :type nil :defaults *load-truename*))
+	  (make-pathname :name nil :type nil :defaults *make-helper-home*))
 	 (source (merge-pathnames
 		  (make-pathname
-		   :directory '(:relative "results"))))
+		   :directory '(:relative :up "test" "results"))))
 	 (output (merge-pathnames (make-pathname 
-				   :directory '(:relative "website" "output")
+				   :directory '(:relative :up "website" "output")
 				   :name "test-results"
 				   :type "html"))))
     (print (list source output))
diff --git a/test/test-nested-components-1.asd b/test/test-nested-components-1.asd
index 2008124f..e296fa73 100644
--- a/test/test-nested-components-1.asd
+++ b/test/test-nested-components-1.asd
@@ -48,7 +48,8 @@
   :components 
   ((:file "preflight")))
 
-
+#|
 newer traverse always fails
 older traverse fails when db-agraph-preflight is evaluated, ok 
-  when loaded or compiled 
\ No newline at end of file
+  when loaded or compiled 
+|#
\ No newline at end of file
diff --git a/test/test-retry-loading-component-1.script b/test/test-retry-loading-component-1.script
index 771d4e9e..a445cf01 100644
--- a/test/test-retry-loading-component-1.script
+++ b/test/test-retry-loading-component-1.script
@@ -8,11 +8,11 @@
 ;(trace asdf:run-shell-command asdf:oos asdf:perform asdf:operate)
 ;#+allegro
 ;(trace excl.osi:command-output)
+(defvar *caught-error* nil)
 (exit-on-error 
  (when (probe-file "try-reloading-dependency.asd")
    (asdf:run-shell-command "rm -f ~A"
 			   (namestring "try-reloading-dependency.asd")))
- (defvar *caught-error* nil)
  (setf asdf:*central-registry* '(*default-pathname-defaults*))
  (setf asdf::*defined-systems* (asdf::make-defined-systems-table))
  (handler-bind ((error (lambda (c) 
-- 
GitLab