test-sysdef-asdf.script 3.44 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 57 58
                       (system-source-file (find-system :asdf)))


59
;;; disabling this test on windows since it relies on running make-asdf.bat, which
60 61 62 63 64
;;; does not work for me under cygwin. - rpg 2016-03-20

(defun search-makefile (target)
  (with-open-file (str (merge-pathnames (make-pathname :name "Makefile" :type nil)
                                        *asdf-directory* ))
65
    (let ((line
66 67 68 69 70
           (loop for x = (read-line str)
                 when (search target x)
                 return (subseq x (length target))
                 finally (error "Didn't find ~a in Makefile." target))))
      (mapcar 'parse-native-namestring (split-string line)))))
71

72
(DBG "Checking that the bootstrap script and asdf.asd are in synch")
73
(defun system-lisp-files (system)
74 75
  (loop :for f :in (input-files 'concatenate-source-op system)
    :collect (enough-pathname f *asdf-directory*)))
76

77
(defun bootstrap-lisp-files (target)
78 79
  (let ((target (format nil "~a := " target)))
    (search-makefile target)))
80 81

(defmacro compare-files (system target)
82
   `(assert-pathnames-equal (system-lisp-files ,system) (bootstrap-lisp-files ,target)))
83 84

(DBG "Testing that the Makefile and ASDF agree on the order of UIOP files")
85
(compare-files :uiop "driver_lisp")
86 87

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