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

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

(DBG "Try load ASDF with an empty configuration")
7 8 9
(initialize-source-registry
 '(:source-registry :ignore-inherited-configuration))
(load-system :asdf)
10
;; We haven't found it, and got the fallback
11
(assert-equal nil (system-source-file (find-system :asdf)))
12

13 14 15 16 17
;; 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"))

18
(clear-system "asdf")
19 20 21 22 23
(let ((*system-definition-search-functions* '(sysdef-bogus-test-search))
      (state "Didn't catch warning"))
  (DBG "Bogus attempt at loading an old ASDF: should issue a warning and ignore")
  (handler-bind
      ((simple-warning
24 25 26 27
	 #'(lambda (c)
	     (when (search "ASDF will ignore this configured system rather than downgrade itself."
			   (simple-condition-format-control c))
	       (setf state "Caught warning")))))
28
    (clear-system "asdf")
29
    (upgrade-asdf))
30 31 32 33
  (assert-equal state "Caught warning")
  (DBG "2nd bogus attempt at loading same old ASDF: should ignore without a warning")
  (handler-bind
      ((simple-warning
34 35
	 #'(lambda (c)
	     (error "Should not have issued warning, but did issue:~%  ~A" c))))
36
    (clear-system "asdf")
37 38 39
    (upgrade-asdf)))

(DBG "Load ASDF with proper configuration: should find asdf.asd from the source above")
40
(initialize-source-registry
41 42
 `(:source-registry
   (:directory ,*asdf-directory*)
43
   (:directory ,*uiop-directory*)
44
   :ignore-inherited-configuration))
45
(clear-system "asdf")
46
(load-system :asdf)
47 48
;; This time we found it, but it was skipped because the version was the same
(assert-equal nil (system-source-file (find-system :asdf)))
49

50 51
;; But if we cheat on our version, that should work
(setf asdf::*asdf-version* "3.0")
52
(clear-system "asdf")
53
#-xcl ;; expected-failure: XCL has trouble with the ASDF upgrade
54
(load-system :asdf)
55
(assert-pathname-equal (subpathname *asdf-directory* "asdf.asd")
56
		       (system-source-file (find-system :asdf)))
57

58
(DBG "Checking that the bootstrap script and asdf.asd are in synch")
59 60
(defun system-lisp-files (system)
  (loop :for f :in (required-components system :keep-component 'cl-source-file)
61
        :collect (enough-pathname (component-pathname f) *asdf-directory*)))
62

63
(defun bootstrap-lisp-files (target)
64
  (mapcar
65 66
   'parse-native-namestring
   (remove-if (lambda (x) (or (emptyp x) #+os-windows (equal x "+")))
67
              (split-string ;; don't use make(1), use the bootstrap script
68 69 70 71
               (run-program `(;; CMUCL hates ./make.sh -- sigh.
                              #+os-unix ,(native-namestring (subpathname *asdf-directory* "make.sh"))
                              #+os-windows "make.bat"
                              ,target)
72
			    #+os-windows :force-shell #+os-windows t
73
                            :directory *asdf-directory* :output :string :error-output t)
74
               :separator #(#\space #\newline #\return #\tab)))))
75 76

(defmacro compare-files (system target)
77
  `(assert-pathnames-equal (system-lisp-files ,system) (bootstrap-lisp-files ,target)))
78 79

(DBG "Testing that the Makefile and ASDF agree on the order of UIOP files")
80
(compare-files :uiop "driver_files")
81 82

(DBG "Testing that the Makefile and ASDF agree on the order of ASDF/DEFSYSTEM files")
83
(compare-files :asdf/defsystem "defsystem_files")