Skip to content
Snippets Groups Projects
Commit c4b67894 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

Fix test-systed-asdf on Windows (hopefully).

More test cleanups: use assert-compare and assert-equal some more.
parent af1e8fcf
No related branches found
No related tags found
No related merge requests found
...@@ -10,7 +10,7 @@ ...@@ -10,7 +10,7 @@
;; :depends-on ((:version :asdf "2.017.18")) ; no :around-compile before that. ;; :depends-on ((:version :asdf "2.017.18")) ; no :around-compile before that.
:components ((:file "test"))) :components ((:file "test")))
(load-system 'test-around-compile :force t) (load-system 'test-around-compile :force t)
(assert (= 3 (funcall 'add10 1))) ;; add10 must have been compiled in base 2 (assert-equal 3 (funcall 'add10 1)) ;; add10 must have been compiled in base 2
(fmakunbound 'add10) (fmakunbound 'add10)
...@@ -21,4 +21,4 @@ ...@@ -21,4 +21,4 @@
(funcall thunk))) (funcall thunk)))
:components ((:file "test"))) :components ((:file "test")))
(load-system 'test-around-compile-lambda :force t) (load-system 'test-around-compile-lambda :force t)
(assert (= 10 (funcall 'add10 1))) ;; add10 must have been compiled in base 16 (assert-equal 10 (funcall 'add10 1)) ;; add10 must have been compiled in base 16
...@@ -57,8 +57,8 @@ ...@@ -57,8 +57,8 @@
(operate 'dll-op :test-asdf/dll-test) (operate 'dll-op :test-asdf/dll-test)
(si:load-foreign-module (first (output-files 'dll-op :test-asdf/dll-test))) (si:load-foreign-module (first (output-files 'dll-op :test-asdf/dll-test)))
(operate 'load-op :test-asdf/dll-user) (operate 'load-op :test-asdf/dll-user)
(assert (= (test-package::sample-function) 42)) (assert-equal (test-package::sample-function) 42)
(operate 'monolithic-dll-op :test-asdf/monodll) (operate 'monolithic-dll-op :test-asdf/monodll)
(si:load-foreign-module (first (output-files 'monolithic-dll-op :test-asdf/monodll))) (si:load-foreign-module (first (output-files 'monolithic-dll-op :test-asdf/monodll)))
(operate 'load-op :test-asdf/monodll-user) (operate 'load-op :test-asdf/monodll-user)
(assert (= (test-package::always-42) 42))) (assert-equal (test-package::always-42) 42))
...@@ -19,4 +19,4 @@ ...@@ -19,4 +19,4 @@
;; forced, it should be later ;; forced, it should be later
(load-system 'test-force :force t) (load-system 'test-force :force t)
(assert (>= (get-file-stamp file1) file1-date)) (assert-compare (>= (get-file-stamp file1) file1-date))
...@@ -13,7 +13,8 @@ ...@@ -13,7 +13,8 @@
(assert-pathname-equal file2.fasl (test-fasl "file2")) (assert-pathname-equal file2.fasl (test-fasl "file2"))
(assert-pathname-equal file3.fasl (test-fasl "file3")) (assert-pathname-equal file3.fasl (test-fasl "file3"))
(assert (and file1-date file3-date)) (assert file1-date)
(assert file3-date)
;; and loaded ;; and loaded
(assert (asymval '#:*file1* :test-package)) (assert (asymval '#:*file1* :test-package))
...@@ -27,6 +28,6 @@ ...@@ -27,6 +28,6 @@
(touch-file file2.fasl :timestamp (- file3-date 30)) (touch-file file2.fasl :timestamp (- file3-date 30))
(touch-file file3.fasl :timestamp (- file3-date 15)) (touch-file file3.fasl :timestamp (- file3-date 15))
(load-system 'test-module-depend) (load-system 'test-module-depend)
(assert (>= (get-file-stamp file2.fasl) file3-date)) (assert-compare (>= (get-file-stamp file2.fasl) file3-date))
;; does this properly go to the second level? ;; does this properly go to the second level?
(assert (>= (get-file-stamp file3.fasl) file3-date)) (assert-compare (>= (get-file-stamp file3.fasl) file3-date))
...@@ -75,8 +75,8 @@ ...@@ -75,8 +75,8 @@
(when (loop :for (o . c) :in plan :thereis (and (eq c file3c) (typep o 'asdf:compile-op))) (when (loop :for (o . c) :in plan :thereis (and (eq c file3c) (typep o 'asdf:compile-op)))
(error "Excessive operations on file3-only system. Bad propagation of dependencies.")) (error "Excessive operations on file3-only system. Bad propagation of dependencies."))
(operate 'load-op 'test-module-excessive-depend) (operate 'load-op 'test-module-excessive-depend)
(assert (>= (file-write-date file1) before)) (assert-compare (>= (file-write-date file1) before))
(assert (>= (file-write-date file2) before)) (assert-compare (>= (file-write-date file2) before))
(unless (= (file-write-date file3) (unless (= (file-write-date file3)
file3-date) file3-date)
(error "Excessive compilation of file3.lisp: traverse bug.")) (error "Excessive compilation of file3.lisp: traverse bug."))
...@@ -33,6 +33,5 @@ ...@@ -33,6 +33,5 @@
;; now rerun the load-op and check that no files are recompiled ;; now rerun the load-op and check that no files are recompiled
(load-system 'test-redundant-recompile) (load-system 'test-redundant-recompile)
(assert (= file1-date (file-write-date file1))) (assert-equal file1-date (file-write-date file1))
(assert (= file2-date (file-write-date file2))) (assert-equal file2-date (file-write-date file2))
...@@ -51,17 +51,19 @@ ...@@ -51,17 +51,19 @@
(DBG "Checking that Makefile and asdf.asd are in synch") (DBG "Checking that Makefile and asdf.asd are in synch")
(defun system-lisp-files (system) (defun system-lisp-files (system)
(loop :for f :in (required-components system :keep-component 'cl-source-file) (loop :for f :in (required-components system :keep-component 'cl-source-file)
:collect (namestring (enough-pathname (component-pathname f) *asdf-directory*)))) :collect (enough-pathname (component-pathname f) *asdf-directory*)))
(defun makefile-lisp-files (target) (defun makefile-lisp-files (target)
(remove-if 'emptyp (mapcar
(split-string ;; NB: assumes GNU make 'parse-unix-namestring
(run-program `("make" "--quiet" "--no-print-directory" ,target) (remove-if 'emptyp
:output :string :error-output t :directory *asdf-directory*) (split-string ;; NB: assumes GNU make
:separator #(#\space #\newline #\return #\tab)))) (run-program `("make" "--quiet" "--no-print-directory" ,target)
:output :string :error-output t :directory *asdf-directory*)
:separator #(#\space #\newline #\return #\tab)))))
(defmacro compare-files (system target) (defmacro compare-files (system target)
`(assert-equal (system-lisp-files ,system) (makefile-lisp-files ,target))) `(assert-pathnames-equal (system-lisp-files ,system) (makefile-lisp-files ,target)))
(DBG "Testing that the Makefile and ASDF agree on the order of UIOP files") (DBG "Testing that the Makefile and ASDF agree on the order of UIOP files")
(compare-files :uiop "driver-files") (compare-files :uiop "driver-files")
......
...@@ -4,8 +4,7 @@ ...@@ -4,8 +4,7 @@
;;; system that can be found using *system-definition-search-functions* ;;; system that can be found using *system-definition-search-functions*
(defun system-registered-time (name) (defun system-registered-time (name)
(if-let (data (asdf::system-registered-p name)) (car (asdf::system-registered-p name)))
(car data)))
(defparameter test1.asd (nth-value 2 (locate-system :test1))) (defparameter test1.asd (nth-value 2 (locate-system :test1)))
(assert-pathname-equal test1.asd (test-source "test1.asd")) (assert-pathname-equal test1.asd (test-source "test1.asd"))
(defparameter file1.lisp (test-source "file1.lisp")) (defparameter file1.lisp (test-source "file1.lisp"))
...@@ -25,9 +24,9 @@ ...@@ -25,9 +24,9 @@
(DBG :blah date1 date2 date3 date4 date5) (DBG :blah date1 date2 date3 date4 date5)
(assert-equal date2 date5) (assert-equal date2 date5)
(assert-equal date2 date5) (assert-equal date2 date5)
(assert (>= date4 date3)) (assert-compare (>= date4 date3))
(sleep 1) (sleep 1)
(touch-file test1.asd) (touch-file test1.asd)
(find-system :test1) (find-system :test1)
(defparameter date6 (system-registered-time :test1)) (defparameter date6 (system-registered-time :test1))
(assert (> date6 date4)) (assert-compare (> date6 date4))
...@@ -4,9 +4,7 @@ ...@@ -4,9 +4,7 @@
;;; system that canNOT be found using *system-definition-search-functions* ;;; system that canNOT be found using *system-definition-search-functions*
(defun system-registered-time (name) (defun system-registered-time (name)
(let ((data (asdf::system-registered-p name))) (car (asdf::system-registered-p name)))
(when data
(car data))))
(defparameter test1.asd (nth-value 2 (locate-system :test1))) (defparameter test1.asd (nth-value 2 (locate-system :test1)))
(assert-pathname-equal test1.asd (test-source "test1.asd")) (assert-pathname-equal test1.asd (test-source "test1.asd"))
...@@ -21,4 +19,4 @@ ...@@ -21,4 +19,4 @@
(find-system :test1) (find-system :test1)
(defparameter date2 (system-registered-time :test1)) (defparameter date2 (system-registered-time :test1))
(assert date2) (assert date2)
(assert (> date2 date1)) (assert-compare (> date2 date1))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment