script-support.lisp 20.8 KB
Newer Older
1 2 3 4 5 6 7 8
;;;;; Minimal life-support for testing ASDF from a blank Lisp image.
#|
Some constraints:
* We cannot rely on any test library that could be loaded by ASDF.
 And we cannot even rely on ASDF being present until we load it.
 But we *can* rely on ASDF being present *after* we load it.
* evaluating this file MUST NOT print anything,
 because we use it in the forward-ref test to check that nothing is printed.
9 10
* We make sure that none of our symbols clash with asdf/driver or asdf,
 so we may use-package them during testing.
11 12
|#

13 14 15
(defpackage :asdf-test
  (:use :common-lisp)
  (:export
16
   #:asym #:acall #:asymval
17
   #:*test-directory* #:*asdf-directory*
18 19
   #:load-asdf #:maybe-compile-asdf
   #:load-asdf-lisp #:compile-asdf #:load-asdf-fasl
20
   #:compile-load-asdf #:load-asdf-system #:clean-load-asdf-system
21 22 23
   #:register-directory #:load-test-system
   #:with-test #:test-asdf #:debug-asdf
   #:assert-compare
24
   #:assert-equal
25
   #:leave-test #:def-test-system
26
   #:action-name #:in-plan-p
27
   #:test-source #:test-fasl #:resolve-output #:output-location
28
   #:quietly))
29

30
(in-package :asdf-test)
31

32 33 34 35 36 37
(declaim (optimize (speed 2) (safety 3) #-(or allegro gcl) (debug 3)
		   #+(or cmu scl) (c::brevity 2)))
(proclaim '(optimize (speed 2) (safety 3) #-(or allegro gcl) (debug 3)
		     #+(or cmu scl) (c::brevity 2)))

(defvar *trace-symbols*
38
  `(;; If you want to trace some stuff while debugging ASDF,
39 40
    ;; here's a nice place to say what.
    ;; These string designators will be interned in ASDF after it is loaded.
41 42
    
    ;;#+ecl ,@'( :perform :input-files :output-files :compile-file* :compile-file-pathname* :load*)
43 44 45
    ))

(defvar *debug-asdf* nil)
46
(defvar *quit-when-done* t)
47

48 49 50
(defun verbose (&optional (verbose t) (print verbose))
  (setf *load-verbose* verbose *compile-verbose* verbose)
  (setf *load-print* print *compile-print* print))
51 52 53

(verbose nil)

54 55
;;; Minimal compatibility layer
(eval-when (:compile-toplevel :load-toplevel :execute)
56 57 58 59 60
  #+allegro
  (setf excl:*warn-on-nested-reader-conditionals* nil
        excl::*autoload-package-name-alist*
        (remove "asdf" excl::*autoload-package-name-alist*
                :test 'equalp :key 'car)) ; We need that BEFORE any mention of package ASDF.
61
  #+cmucl (setf ext:*gc-verbose* nil)
62
  #+gcl
63 64 65
  (when (and (= system::*gcl-major-version* 2)
             (= system::*gcl-minor-version* 6))
    (pushnew :gcl2.6 *features*)
66 67
    (shadowing-import 'system:*load-pathname* :asdf-test))
  #+lispworks
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
68
  (setf system:*stack-overflow-behaviour* :warn))
69 70 71 72 73

#+(or gcl genera)
(unless (fboundp 'ensure-directories-exist)
  (defun ensure-directories-exist (path)
    #+genera (fs:create-directories-recursively (pathname path))
74 75
    #+gcl (lisp:system (format nil "mkdir -p ~S"
                               (namestring (make-pathname :name nil :type nil :defaults path))))))
76 77

;;; Survival utilities
78 79 80 81 82 83 84
(defun asym (name &optional package (errorp t))
  (let* ((pname (or package :asdf))
         (package (find-package pname)))
    (if package
        (or (find-symbol (string name) package)
            (when errorp (error "Can't find symbol ~A in ~A" name pname)))
        (when errorp (error "Can't find package ~A" pname)))))
85
(defun acall (name &rest args)
86 87 88 89 90 91 92 93 94
  (apply (apply 'asym (if (consp name) name (list name))) args))
(defun asymval (name &optional package)
  (symbol-value (asym name package)))
(defsetf asymval (name &optional package) (new-value) ;; NB: defun setf won't work on GCL2.6
  (let ((sym (gensym "SYM")))
    `(let ((,sym (asym ,name ,package)))
       (if ,sym
           (setf (symbol-value ,sym) ,new-value)
           (error "NIHIL EX NIHILO")))))
95

96
(defun finish-outputs* ()
97 98 99
  (loop :for s :in (list *standard-output* *error-output* *trace-output* *debug-io*)
        :do (finish-output s)))
(defun redirect-outputs ()
100
  (finish-outputs*)
101 102
  (setf *error-output* *standard-output*
        *trace-output* *standard-output*))
103

104
(redirect-outputs) ;; Put everything on standard output, for the sake of scripts
105

106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148
;;; Helpful for debugging

(defun pathname-components (p)
  (when p
    (let ((p (pathname p)))
      (list :host (pathname-host p)
            :device (pathname-device p)
            :directory (pathname-directory p)
            :name (pathname-name p)
            :type (pathname-type p)
            :version (pathname-version p)))))

(defun assert-pathname-equal-helper (qx x qy y)
  (cond
    ((equal x y)
     (format t "~S and ~S both evaluate to same path:~%  ~S~%" qx qy x))
    ((acall :pathname-equal x y)
     (format t "These two expressions yield pathname-equal yet not equal path~%  ~S~%" x)
     (format t "the first expression ~S yields this:~%  ~S~%" qx (pathname-components x))
     (format t "the other expression ~S yields that:~%  ~S~%" qy (pathname-components y)))
    (t
     (format t "These two expressions yield paths that are not pathname-equal~%")
     (format t "the first expression ~S yields this:~%  ~S~%  ~S~%" qx x (pathname-components x))
     (format t "the other expression ~S yields that:~%  ~S~%  ~S~%" qy y (pathname-components y)))))
(defmacro assert-pathname-equal (x y)
  `(assert-pathname-equal-helper ',x ,x ',y ,y))
(defun assert-length-equal-helper (qx qy x y)
  (unless (= (length x) (length y))
    (format t "These two expressions yield sequences of unequal length~%")
    (format t "The first, ~S, has value ~S of length ~S~%" qx x (length x))
    (format t "The other, ~S, has value ~S of length ~S~%" qy y (length y))))
(defun assert-pathnames-equal-helper (qx x qy y)
  (assert-length-equal-helper qx x qy y)
  (loop :for n :from 0
        :for qpx = `(nth ,n ,qx)
        :for qpy = `(nth ,n ,qy)
        :for px :in x
        :for py :in y :do
        (assert-pathname-equal-helper qpx px qpy py)))
(defmacro assert-pathnames-equal (x y)
  `(assert-pathnames-equal-helper ',x ,x ',y ,y))

;; More pathname madness.
149 150 151
;; We can't use goodies from asdf/pathnames because ASDF isn't loaded yet.
;; We still want to work despite and host/device funkiness,
;; so we do it the hard way.
152
(defparameter *test-directory*
153
  (truename
154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174
   (make-pathname :name nil :type nil :version nil
                  :defaults (or *load-pathname* *compile-file-pathname*))))
(defun make-sub-pathname (&rest keys &key defaults &allow-other-keys)
  (merge-pathnames (apply 'make-pathname keys) defaults))
(defun relative-dir (&rest dir) #-gcl (cons ':relative dir) #+gcl dir)
(defun back-dir () #-gcl :back #+gcl :parent)
(defparameter *asdf-directory*
  (truename (make-sub-pathname :directory (relative-dir (back-dir)) :defaults *test-directory*)))
(defparameter *build-directory*
  (make-sub-pathname :directory (relative-dir "build") :defaults *asdf-directory*))
(defparameter *implementation*
  (or #+allegro
      (ecase excl:*current-case-mode*
        (:case-sensitive-lower :mlisp)
        (:case-insensitive-upper :alisp))
      #+armedbear :abcl
      #+clisp :clisp
      #+clozure :ccl
      #+cmu :cmucl
      #+corman :cormanlisp
      #+digitool :mcl
175
      #+ecl (or #+ecl-bytecmp :ecl_bytecodes :ecl)
176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192
      #+gcl :gcl
      #+lispworks :lispworks
      #+mkcl :mkcl
      #+sbcl :sbcl
      #+scl :scl
      #+xcl :xcl))
(defparameter *early-fasl-directory*
  (make-sub-pathname :directory (relative-dir "fasls" (string-downcase *implementation*))
                     :defaults *build-directory*))

(defun asdf-name (&optional tag)
  (format nil "asdf~@[-~A~]" tag))
(defun asdf-lisp (&optional tag)
  (make-pathname :name (asdf-name tag) :type "lisp" :defaults *build-directory*))
(defun debug-lisp ()
  (make-sub-pathname :directory (relative-dir "contrib") :name "debug" :type "lisp" :defaults *asdf-directory*))
(defun early-compile-file-pathname (file)
193
  (compile-file-pathname
194 195 196
   (make-pathname :name (pathname-name file) :type "lisp" :defaults *early-fasl-directory*)))
(defun asdf-fasl (&optional tag)
  (early-compile-file-pathname (asdf-lisp tag)))
197

198 199
;;; Test helper functions

200
(load (debug-lisp))
201
(verbose t nil)
202

203 204 205 206 207 208
(defmacro assert-compare (expr)
  (destructuring-bind (op x y) expr
    `(assert-compare-helper ',op ',x ',y ,x ,y)))

(defun assert-compare-helper (op qx qy x y)
  (unless (funcall op x y)
209
    (error "These two expressions fail comparison with ~S:~% ~
210 211 212 213 214
            ~S evaluates to ~S~% ~S evaluates to ~S~%"
            op qx x qy y)))

(defmacro assert-equal (x y)
  `(assert-compare (equal ,x ,y)))
215

216 217 218
(defun touch-file (file &key offset timestamp)
  (let* ((base (or timestamp (get-universal-time)))
         (stamp (if offset (+ base offset) base)))
219
    (if (asymval :*asdf-cache*)
220 221 222 223 224 225 226 227 228 229
        (acall :register-file-stamp file stamp)
        (multiple-value-bind (sec min hr day month year)
            (decode-universal-time stamp #+gcl2.6 -5) ;; -5 is for *my* localtime
          (error "Y U NO use stamp cache?")
          (acall :run-program
                 `("touch" "-t" ,(format nil "~4,'0D~2,'0D~2,'0D~2,'0D~2,'0D.~2,'0D"
                                         year month day hr min sec)
                           ,(acall :native-namestring file)))
          (assert-equal (file-write-date file) stamp)))))
(defun mark-file-deleted (file)
230
  (unless (asymval :*asdf-cache*) (error "Y U NO use asdf cache?"))
231
  (acall :register-file-stamp file nil))
232

233 234 235 236
(defun hash-table->alist (table)
  (loop :for key :being :the :hash-keys :of table :using (:hash-value value)
    :collect (cons key value)))

237
(defun exit-lisp (&optional (code 0)) ;; Simplified from asdf/image:quit
238
  (finish-outputs*)
239 240 241 242 243 244 245 246 247 248 249 250
  #+(or abcl xcl) (ext:quit :status code)
  #+allegro (excl:exit code :quiet t)
  #+clisp (ext:quit code)
  #+clozure (ccl:quit code)
  #+cormanlisp (win32:exitprocess code)
  #+(or cmu scl) (unix:unix-exit code)
  #+ecl (si:quit code)
  #+gcl (lisp:quit code)
  #+genera (error "You probably don't want to Halt the Machine. (code: ~S)" code)
  #+lispworks (lispworks:quit :status code :confirm nil :return nil :ignore-errors-p t)
  #+mcl (ccl:quit) ;; or should we use FFI to call libc's exit(3) ?
  #+mkcl (mk-ext:quit :exit-code code)
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
251
  #+sbcl #.(let ((exit (find-symbol "EXIT" :sb-ext))
252
		 (quit* (find-symbol "QUIT" :sb-ext)))
253 254
	     (cond
	       (exit `(,exit :code code :abort t))
255
	       (quit* `(,quit* :unix-status code :recklessly-p t))))
256 257
  #-(or abcl allegro clisp clozure cmu ecl gcl genera lispworks mcl mkcl sbcl scl xcl)
  (error "~S called with exit code ~S but there's no quitting on this implementation" 'quit code))
258 259


260
(defun leave-test (message return)
261
  (finish-outputs*)
Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
262 263 264
  (fresh-line *error-output*)
  (when message
    (format *error-output* message)
265
    (fresh-line *error-output*))
266
  (finish-outputs*)
267
  (throw :asdf-test-done return))
268

269
(defmacro with-test ((&optional) &body body)
270
  `(call-with-test (lambda () ,@body)))
271

272
(defun call-with-test (thunk)
273 274 275
  "Unless the environment variable DEBUG_ASDF_TEST
is bound, write a message and exit on an error.  If
*asdf-test-debug* is true, enter the debugger."
276
  (redirect-outputs)
277 278 279 280
  (let ((result
          (catch :asdf-test-done
            (handler-bind
                ((error (lambda (c)
281 282
                          (ignore-errors
                           (format *error-output* "~&TEST ABORTED: ~A~&" c))
283
                          (finish-outputs*)
284
                          (cond
285 286 287
                            (*debug-asdf*
                             (format t "~&It's your baby, fix it!~%")
                             (break))
288
                            (t
289 290 291
                             (ignore-errors
                              (acall :print-condition-backtrace
                                     c :count 69 :stream *error-output*))
292
                             (leave-test "Script failed" 1))))))
293
              (funcall (or (asym :call-with-asdf-cache :asdf nil) 'funcall) thunk)
294
              (leave-test "Script succeeded" 0)))))
295
    (when *quit-when-done*
296
      (exit-lisp result))))
297 298 299 300 301 302 303 304 305 306

;;; These are used by the upgrade tests

(defmacro quietly (&body body)
  `(call-quietly #'(lambda () ,@body)))

(defun call-quietly (thunk)
  (handler-bind (#+sbcl (sb-kernel:redefinition-warning #'muffle-warning))
    (funcall thunk)))

307
(defun load-asdf-lisp (&optional tag)
308
  (quietly (load (asdf-lisp tag) :verbose *load-verbose* :print *load-print*)))
309

310 311
(defun load-asdf-fasl (&optional tag)
  (quietly (load (asdf-fasl tag))))
312 313

(defun register-directory (dir)
314
  (pushnew dir (symbol-value (asym :*central-registry*))))
315

Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
316
(defun load-asdf-system (&rest keys)
317 318
  (quietly
   (register-directory *asdf-directory*)
319 320
   (apply (asym :oos) (asym :load-op) :asdf keys)))

321
(defun call-with-asdf-conditions (thunk &optional verbose)
322
  (declare (ignorable verbose))
323 324 325 326
  (handler-bind (#+sbcl
                 ((or sb-c::simple-compiler-note sb-kernel:redefinition-warning)
                   #'muffle-warning)
                 #+(and ecl (not ecl-bytecmp))
327 328
                 ((or c::compiler-note c::compiler-debug-note
                      c::compiler-warning) ;; ECL emits more serious warnings than it should.
329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345
                   #'muffle-warning)
                 #+mkcl
                 ((or compiler:compiler-note) #'muffle-warning)
                 #-(or cmu scl)
                 ;; style warnings shouldn't abort the compilation [2010/02/03:rpg]
                 (style-warning
                   #'(lambda (w)
                       ;; escalate style-warnings to warnings - we don't want them.
                       (when verbose
                         (warn "Can you please fix ASDF to not emit style-warnings? Got a ~S:~%~A"
                               (type-of w) w))
                       (muffle-warning w))))
    (funcall thunk)))

(defmacro with-asdf-conditions ((&optional verbose) &body body)
  `(call-with-asdf-conditions #'(lambda () ,@body) ,verbose))

346 347 348 349 350 351
(defun compile-asdf (&optional tag verbose)
  (let* ((alisp (asdf-lisp tag))
         (afasl (asdf-fasl tag))
         (tmp (make-pathname :name "asdf-tmp" :defaults afasl)))
    (ensure-directories-exist afasl)
    (multiple-value-bind (result warnings-p errors-p)
352
        (compile-file alisp :output-file tmp #-gcl :verbose #-gcl verbose :print verbose)
353 354 355 356 357 358 359 360 361 362 363 364 365 366
      (flet ((bad (key)
               (when result (ignore-errors (delete-file result)))
               key)
             (good (key)
               (when (probe-file afasl) (delete-file afasl))
               (rename-file tmp afasl)
               key))
        (cond
          (errors-p (bad :errors))
          (warnings-p
           (or
            ;; ECL 11.1.1 has spurious warnings, same with XCL 0.0.0.291.
            ;; SCL has no warning but still raises the warningp flag since 2.20.15 (?)
            #+(or cmu ecl scl xcl) (good :expected-warnings)
367
          (bad :unexpected-warnings)))
368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385
          (t (good :success)))))))

(defun maybe-compile-asdf (&optional tag)
  (let ((alisp (asdf-lisp tag))
        (afasl (asdf-fasl tag)))
    (cond
      ((not (probe-file alisp))
       :not-found)
      ((and (probe-file afasl)
            (> (file-write-date afasl) (file-write-date alisp))
            (ignore-errors (load-asdf-fasl tag)))
       :previously-compiled)
      (t
       (load-asdf-lisp tag)
       (compile-asdf tag)))))

(defun compile-asdf-script ()
  (with-test ()
386
    #-gcl2.6
387
    (ecase (with-asdf-conditions () (maybe-compile-asdf))
388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415
      (:not-found
       (leave-test "Testsuite failed: unable to find ASDF source" 3))
      (:previously-compiled
       (leave-test "Reusing previously-compiled ASDF" 0))
      (:errors
       (leave-test "Testsuite failed: ASDF compiled with ERRORS" 2))
      (:unexpected-warnings
       (leave-test "Testsuite failed: ASDF compiled with unexpected warnings" 1))
      (:expected-warnings
       (leave-test "ASDF compiled with warnings, ignored for your implementation" 0))
      (:success
       (leave-test "ASDF compiled cleanly" 0)))))

(defun compile-load-asdf (&optional tag)
  ;; emulate the way asdf upgrades itself: load source, compile, load fasl.
  (load-asdf-lisp tag)
  (ecase (compile-asdf tag)
    ((:errors :unexpected-warnings) (leave-test "failed to compile ASDF" 1))
    ((:expected-warnings :success)
     (load-asdf-fasl tag))))

;;; Now, functions to compile and load ASDF.

(defun load-test-system (x &key verbose)
  (let ((*load-print* verbose)
        (*load-verbose* verbose))
    (register-directory *test-directory*)
    (acall :oos (asym :load-op) x :verbose verbose)))
416

417 418
(defun get-asdf-version ()
  (when (find-package :asdf)
419 420 421 422 423 424
    (or (symbol-value (find-symbol (string :*asdf-version*) :asdf))
        (let ((ver (symbol-value (find-symbol (string :*asdf-revision*) :asdf))))
          (etypecase ver
            (string ver)
            (cons (format nil "~{~D~^.~}" ver))
            (null "1.0"))))))
425

426

427
(defun test-upgrade (old-method new-method tag) ;; called by run-test
428
  (with-test ()
429 430
    (when old-method
      (cond
431
        ((string-equal tag "REQUIRE")
432
         (format t "Requiring some previous ASDF ~A~%" tag)
433
         (ignore-errors (funcall 'require "asdf"))
434 435 436
         (if (member "ASDF" *modules* :test 'equalp)
             (format t "Your Lisp implementation provided ASDF ~A~%" (get-asdf-version))
             (leave-test "Your Lisp implementation does not provide ASDF. Skipping test.~%" 0)))
437 438 439 440 441
        (t
         (format t "Loading old asdf ~A via ~A~%" tag old-method)
         (funcall old-method tag))))
    (format t "Now loading new asdf via method ~A~%" new-method)
    (funcall new-method)
442
    (format t "Testing it~%")
443
    (register-directory *test-directory*)
444 445 446
    (load-test-system :test-module-depend)
    (assert (eval (intern (symbol-name '#:*file1*) :test-package)))
    (assert (eval (intern (symbol-name '#:*file3*) :test-package)))))
447

448 449 450 451 452 453 454 455 456 457 458 459 460
(defun output-location (&rest sublocation)
  (list* *asdf-directory* "build/fasls" :implementation sublocation))
(defun resolve-output (&rest sublocation)
  (acall :resolve-location (apply 'output-location sublocation)))

(defun test-source (file)
  (acall :subpathname *test-directory* file))
(defun test-output-dir ()
  (resolve-output "asdf" "test"))
(defun test-output (file)
  (acall :subpathname (test-output-dir) file))
(defun test-fasl (file)
  (acall :compile-file-pathname* (test-source file)))
461 462 463 464 465 466 467 468

(defun clean-asdf-system ()
  (let ((fasl (resolve-output "asdf" "build" "asdf.fasl")))
    (when (DBG :clean fasl (probe-file fasl)) (delete-file fasl))))

(defun load-asdf-lisp-clean ()
  (load-asdf-lisp)
  (clean-asdf-system))
469

470 471
(defun configure-asdf ()
  (setf *debug-asdf* (or *debug-asdf* (acall :getenvp "DEBUG_ASDF_TEST")))
472
  (untrace)
473 474 475 476 477
  (eval `(trace ,@(loop :for s :in *trace-symbols* :collect (asym s))))
  (acall :initialize-source-registry
         `(:source-registry :ignore-inherited-configuration))
  (acall :initialize-output-translations
         `(:output-translations
478 479
           ((,*asdf-directory* :**/ :*.*.*) ,(output-location "asdf"))
           (t ,(output-location "root"))
480 481 482
           :ignore-inherited-configuration))
  (set (asym :*central-registry*) `(,*test-directory*))
  (set (asym :*verbose-out*) *standard-output*)
483 484 485 486 487 488 489 490 491 492
  (set (asym :*asdf-verbose*) t)
  (let ((x (acall :system-source-directory :hello-world-example)))
    (assert-pathname-equal *test-directory* x) ;; not always EQUAL (!)
    (unless (equal *test-directory* x)
      (format t "Interestingly, while *test-directory* has components~% ~S~%~
                 ASDF finds the ASDs in~% ~S~%Using the latter.~%"
              (pathname-components *test-directory*)
              (pathname-components x)))
    (setf *test-directory* x))
  t)
493 494

(defun load-asdf (&optional tag)
495
  #+gcl2.6 (load-asdf-lisp tag) #-gcl2.6
496 497
  (load-asdf-fasl tag)
  (use-package :asdf :asdf-test)
498
  (use-package :asdf/driver :asdf-test)
499
  (use-package :asdf/cache :asdf-test)
500 501
  (configure-asdf)
  (setf *package* (find-package :asdf-test)))
502

503 504
(defun debug-asdf ()
  (setf *debug-asdf* t)
505
  (setf *quit-when-done* nil)
506 507
  (setf *package* (find-package :asdf-test)))

508 509
(defun just-load-asdf-fasl () (load-asdf-fasl))

510
;; Actual scripts rely on this function:
511
(defun common-lisp-user::load-asdf () (load-asdf))
512

513 514 515 516 517 518
(setf *package* (find-package :asdf-test))

(defmacro def-test-system (name &rest rest)
  `(apply (asym :register-system-definition) ',name :pathname ,*test-directory*
          :source-file nil ',rest))

519 520
(defun in-plan-p (plan x) (member x plan :key (asym :action-path) :test 'equal))

521 522
(defmacro test-load-systems (&rest x)
  `(do-test-load-systems ',x))
523

524 525 526 527 528 529
(defun do-test-load-systems (systems)
  (load-asdf-lisp)
  (dolist (sys systems)
    (format t "~&Trying to load ~A~%" sys)
    (acall :load-system sys))
  (format t "~&Done!~%"))
530

531 532 533 534
;; These are shorthands for interactive debugging of test scripts:
(!a
 common-lisp-user::debug-asdf debug-asdf
 da debug-asdf common-lisp-user::da debug-asdf
535 536 537
 la load-asdf common-lisp-user::la load-asdf
 ll load-asdf-lisp
 v verbose)
538

539 540 541 542
#| For the record, the following form is sometimes useful to insert in
 asdf/plan:compute-action-stamp to find out what's happening.
 It depends on the DBG macro in contrib/debug.lisp,
 that you should load in your asdf/plan by inserting an (asdf-debug) form in it.
543

544 545 546 547
 (let ((action-path (action-path (cons o c)))) (DBG :cas action-path just-done plan stamp-lookup out-files in-files out-op op-time dep-stamp out-stamps in-stamps missing-in missing-out all-present earliest-out latest-in up-to-date-p done-stamp (operation-done-p o c)
;;; blah
))
|#