test-sysdef-asdf.script 6.07 KB
Newer Older
1
;;; -*- Lisp -*-
2

3 4
(format! t "~%Using ASDF ~A~%" (asdf-version))
(assert (version< "3.0" (asdf-version))) ;; check that we have a recent enough ASDF
5
(setf *asdf-session* nil)
6

Francois-Rene Rideau's avatar
Francois-Rene Rideau committed
7 8
(defparameter *ticks* 0)
(defun tick () (incf *ticks*))
9

10 11 12
(DBG "Let's define some methods on input-files, to later check what an upgrade does to them.")
(with-asdf-session (:override t)
  (def-test-system "fooey")
13 14
  (def-test-system "foo")
  (defmethod input-files :after ((o load-op) (c system))
15 16
    (DBG :input-files-after-1 o c
         (tick)))
17 18 19 20 21 22
  (assert-equal *ticks* 0)
  (input-files 'load-op "foo")
  (assert-equal *ticks* 1)
  (input-files 'load-op "foo")
  (assert-equal *ticks* 1) ;; It was cached.
  (assert (find-system "fooey" nil)))
23

24

25
(DBG "Try load ASDF with an empty configuration")
26 27 28
(initialize-source-registry
 '(:source-registry :ignore-inherited-configuration))
(load-system :asdf)
29
;; We haven't found it, and got the fallback
30
(assert-equal nil (system-source-file (find-system :asdf)))
31

32 33 34

(DBG "Bogus attempt at loading an old ASDF: should issue a warning and ignore")
(clear-system "asdf")
35 36 37 38 39 40 41 42
;; Bogus sysdef finding function, for the sake of testing no-load-old-version.
(defun sysdef-bogus-test-search (system)
  (declare (ignore system))
  (subpathname *test-directory* "always-error.lisp"))
(let ((*system-definition-search-functions* '(sysdef-bogus-test-search))
      (state "Didn't catch warning"))
  (handler-bind
      ((simple-warning
43 44 45 46
         #'(lambda (c)
             (when (search "ASDF will ignore this configured system rather than downgrade itself."
                           (simple-condition-format-control c))
               (setf state "Caught warning")))))
47
    (clear-system "asdf")
48
    (upgrade-asdf))
49 50 51 52 53
  (assert-equal state "Caught warning"))


(DBG "2nd bogus attempt at loading same old ASDF: should ignore without a warning")
(let ((*system-definition-search-functions* '(sysdef-bogus-test-search)))
54 55
  (handler-bind
      ((simple-warning
56 57
         #'(lambda (c)
             (error "Should not have issued warning, but did issue:~%  ~A" c))))
58
    (clear-system "asdf")
59
    (upgrade-asdf)))
60
(assert-equal nil (system-source-file (find-system :asdf)))
61

62

63
(DBG "Load ASDF with proper configuration: should find asdf.asd from the source above")
64
(initialize-source-registry
65 66
 `(:source-registry
   (:directory ,*asdf-directory*)
67
   (:directory ,*uiop-directory*)
68
   :ignore-inherited-configuration))
69
(clear-system "asdf")
70
(with-asdf-session (:override t)
71
  (with-expected-failure (#+xcl t)    ;; expected-failure: XCL has trouble with the ASDF upgrade
72 73 74 75 76 77 78 79
    (load-system :asdf)
    (assert-pathname-equal (subpathname *asdf-directory* "asdf.asd")
                           (system-source-file (find-system :asdf))))
  (DBG "Loading from the same version shouldn't have reset methods")
  (setf *ticks* 2)
  (input-files 'load-op "foo")
  (assert-equal *ticks* 3))

80

81
(DBG "Loading from an ancient version WILL reset methods")
82
(assert (find-system "fooey" nil))
83 84 85 86 87
(defparameter *current-version* (asdf-version))
(setf asdf::*asdf-version* "2.0" asdf/upgrade::*previous-asdf-versions* '("2.0"))
(assert (asdf/upgrade::upgrading-p))
(clear-system "asdf")
(reset-session)
88 89 90
(with-expected-failure (#+xcl t)
  ;; expected-failure: XCL has trouble with the ASDF upgrade
  (load-system :asdf)
91
  (assert-equal (asdf-version) *current-version*)
92 93 94
  (assert-pathname-equal (subpathname *asdf-directory* "asdf.asd")
                         (system-source-file (find-system :asdf))))

95

96
(DBG "Upgrading from an old-enough version should have redefined away the input-files method!")
97
(setf *ticks* 4)
98
(input-files 'load-op "asdf")
99 100 101 102
(assert-equal *ticks* 4)
;; It also cleared away previously defined systems
(assert (not (find-system "fooey" nil)))

103

104
(DBG "Actually upgrade, from a different but forward-compatible version")
105
;; The data-punting upgrade will mess up component identity, so clear the cache
106
(reset-session)
107 108
(setf asdf::*asdf-version* asdf/upgrade::*oldest-forward-compatible-asdf-version*)
(clear-system "asdf")
109
(def-test-system "fooey")
110 111
(setf *ticks* 10)
(defmethod input-files :after ((o load-op) (c system))
112 113
  (DBG :input-files-after-2 o c
       (tick)))
114
(input-files 'load-op "uiop")
115
(assert-equal *ticks* 12)
116 117 118
(with-expected-failure (#+xcl t)
  ;; expected-failure: XCL has trouble with the ASDF upgrade
  (load-system :asdf))
119
;; Upgrading from a recent-enough version, the input-files method was preserved!
120
;; But we need to clear the cache for it not to be short-circuited.
121
(reset-session)
122
(assert (find-system "fooey" nil))
123
(setf *ticks* 20)
124
(eval '(input-files 'load-op "uiop"))
125 126
(assert-equal *ticks* 21)

127

128
(DBG "Checking that the bootstrap script and asdf.asd are in synch")
129 130 131 132 133 134
(defun bootstrap-lisp-files (file line-prefix)
  (with-input-file (input (subpathname *asdf-directory* file))
    (loop :for line = (read-line input)
      :when (string-prefix-p line-prefix line)
      :return (subseq line (length line-prefix))
      :finally (error "Didn't find ~a in ~a" line-prefix file))))
135
(defun system-lisp-files (system)
136
  (loop :for f :in (input-files 'concatenate-source-op system)
137
    :collect (unix-namestring (enough-pathname f *asdf-directory*))))
138 139

(DBG "Testing that the Makefile and ASDF agree on the order of UIOP files")
140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161
(loop
  :with errors = ()
  :for (file prefix-fmt value-fmt backslash) :in
  '(("Makefile" "~A := " "~{~A~^ ~}")
    ("make-asdf.sh" "~A=" "\"~{~A~^ ~}\"")
    ("make-asdf.bat" "set ~A=" "~{~A~^ + ~}" t)) :do
  (format t "~%Expecting to find in ~A the following lines:~%" file)
  (loop
    :for (system variable-name) :in
    '((:uiop "driver_lisp")
      (:asdf/defsystem "defsystem_lisp"))
    :for files = (system-lisp-files system)
    :for prefix = (format nil prefix-fmt variable-name)
    :for expected0 = (format nil value-fmt files)
    :for expected = (if backslash (substitute #\\ #\/ expected0) expected0)
    :for found = (bootstrap-lisp-files file prefix)
    :do (format t "~A~A~%" prefix expected)
    :unless (equal expected found)
    :do (push (format nil "In ~A expected:~%~A~A~%~%but found:~%~A~A~%~%~%"
                      file prefix expected prefix found)
              errors))
  :finally (when errors (error (reduce/strcat (reverse errors)))))