diff --git a/asdf.lisp b/asdf.lisp index ea96382e3a95de4fc832b44294b61a3947afa73a..c82c6e8cf8e6dc64f7d69aed3b10ee57249d903e 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 2070916ae2f6c0fc9679bee5cc879dabcd0e5df3..ea4c1dcf91e8e0ccd93aa1dd6aa4623f20c689c1 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 2008124ffe8e62c46b7c3868ac480573c6141d64..e296fa735805b16ad6a753df26162b1fce3b0168 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 771d4e9ef4a75722f29186c670e3f4d88134b58e..a445cf0156be0407e4d50fd9d08d69b0c6c4fb7e 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)