test-module-excessive-depend.script 3.8 KB
Newer Older
1
;;; -*- Lisp -*-
2
(load "script-support.lisp")
3 4 5 6 7 8 9 10 11 12 13 14 15 16
(load-asdf)

;;;---------------------------------------------------------------------------
;;; Here's what we are trying to test.  Let us say we have a system X that
;;; contains a file, "file1" and a module, "quux" that depends on file 1.  In
;;; turn, "quux" contains "file2" which depends on loading another system, Y
;;; (note that this dependency cannot be recorded using only the defsystem
;;; grammar; we must use an ancillary method definition).  If we over-force
;;; actions, then the recompiling of "file1" will force "quux" to be loaded,
;;; forcing "file2" load and in turn forcing the reload and recompilation of Y.
;;; If operations are done properly, a change to file1 will force recompilation
;;; and reloading of "file2," but /not/ of system Y.
;;;---------------------------------------------------------------------------

17
(with-test ()
18

19
  (def-test-system :test-module-excessive-depend
20 21 22 23 24 25
   :components ((:file "file1")
                (:module "quux"
                 :pathname ""
                 :depends-on ("file1")
                 :components ((:file "file2")))))

26 27
  (defun find-quux ()
    (find-component :test-module-excessive-depend "quux"))
28

29 30
  (defun find-file2 ()
    (find-component (find-quux) "file2"))
31

32 33 34 35
  (defmethod component-depends-on ((op load-op)
                                   (c (eql (find-file2))))
    (cons `(load-op ,(find-system "file3-only"))
          (call-next-method)))
36

37 38 39 40
  (defmethod component-depends-on ((op compile-op)
                                   (c (eql (find-file2))))
    (cons `(load-op ,(find-system "file3-only"))
          (call-next-method)))
41

42 43
  (DBG "loading test-module-excessive-depend"
       (operate 'load-op 'test-module-excessive-depend))
44

45 46 47 48 49 50 51 52 53
  ;; test that it compiled
  (let* ((file1 (compile-file-pathname* "file1"))
         (file2 (compile-file-pathname* "file2"))
         (file3 (compile-file-pathname* "file3"))
         (file1-date (file-write-date file1))
         (file2-date (file-write-date file2))
         (file3-date (file-write-date file3)))
    (unless (and file1-date file2-date file3-date)
      (error "Failed to compile one of the three files ~
54
	     that should be compiled for this test: ~{~a~}"
55 56 57 58
             (mapcar #'cdr
                     (remove-if #'car
                                (pairlis (list file1-date file2-date file3-date)
                                         '("file1" "file2" "file3"))))))
59

60 61 62
    ;; and loaded
    (assert (eval (asdf::find-symbol* '#:*file1* :test-package)))
    (assert (eval (asdf::find-symbol* '#:*file3* :test-package)))
63 64


65 66 67 68
    ;; now touch file1 and check that file2 _is_ also recompiled
    ;; but that file3 is _not_ recompiled.
    ;; this will only work if the cross-module (intra-system)
    ;; dependency bug is fixed and the excessive compilation bug is fixed.
69

70 71 72 73 74
    (let ((before file3-date))
      (touch-file "file1.lisp" :timestamp (- before 60))
      (touch-file file1 :timestamp (- before 90))
      (touch-file "file2.lisp" :timestamp (- before 30))
      (touch-file file2 :timestamp (- before 15))
75

76 77 78 79 80 81 82 83 84 85 86 87 88
      (let ((plan (asdf::traverse
                   (make-instance 'asdf:load-op)
                   (asdf:find-system 'test-module-excessive-depend)))
            (file3 (asdf:find-component :file3-only "file3")))
        #|(format t "~%Operation plan is:~%")(pprint plan)(terpri)|#
        (when (loop :for (o . c) :in plan :thereis (and (eq c file3) (typep o 'asdf:compile-op)))
          (error "Excessive operations on file3-only system.  Bad propagation of dependencies.")))
      (asdf:operate 'asdf:load-op 'test-module-excessive-depend)
      (assert (>= (file-write-date file1) before))
      (assert (>= (file-write-date file2) before)))
    (unless (= (file-write-date file3)
               file3-date)
      (error "Excessive compilation of file3.lisp:  traverse bug."))))