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