X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-cover%2Ftests.lisp;h=1f2a3235ce286003b6cc82c02ef204c73f105ec1;hb=062283b901155792f65775491aea51481c56faaa;hp=6fb3d9a4006c6a8cadd48fc88e178b1f0f9b269e;hpb=49e92ee57b3b01f5862d0c6fa65f521de1688941;p=sbcl.git

diff --git a/contrib/sb-cover/tests.lisp b/contrib/sb-cover/tests.lisp
index 6fb3d9a..1f2a323 100644
--- a/contrib/sb-cover/tests.lisp
+++ b/contrib/sb-cover/tests.lisp
@@ -1,15 +1,19 @@
-(defpackage sb-cover-test
-  (:use "CL"))
+(defpackage sb-cover-test (:use :cl :asdf :uiop))
 
 (in-package sb-cover-test)
 
-(defparameter *path* #.(truename *compile-file-pathname*))
+(defparameter *source-directory*
+  (system-source-directory :sb-cover))
 (defparameter *output-directory*
-  (merge-pathnames (make-pathname :name nil
-                                  :type nil
-                                  :version nil
-                                  :directory '(:relative "test-output"))
-                   (make-pathname :directory (pathname-directory *path*))))
+  (apply-output-translations *source-directory*))
+
+(setf *default-pathname-defaults* (translate-logical-pathname *default-pathname-defaults*))
+
+(defun compile-load (x)
+  (flet ((in-dir (dir type)
+           (translate-logical-pathname (subpathname dir x :type type))))
+    (load (compile-file (in-dir *source-directory* "lisp")
+                        :output-file (in-dir *output-directory* "fasl")))))
 
 (defun report ()
   (handler-case
@@ -24,19 +28,26 @@
         (error "Should've raised a warning"))
     (warning ())))
 
+
 ;;; No instrumentation
-(load (compile-file (merge-pathnames #p"test-data-1.lisp" *path*)))
+(compile-load "test-data-1")
 (report-expect-failure)
 
-;;; Instrument the file, try again
+;;; Instrument the file, try again -- first with a non-directory pathname
 
 (proclaim '(optimize sb-cover:store-coverage-data))
-(load (compile-file (merge-pathnames #p"test-data-1.lisp" *path*)))
+(compile-load "test-data-1")
+
+(catch 'ok
+  (handler-case
+      (sb-cover:report #p"/tmp/foo")
+    (error ()
+      (throw 'ok nil)))
+  (error "REPORT with a non-pathname directory did not signal an error."))
 
 (report)
 
-(assert (probe-file (make-pathname :name "cover-index" :type "html"
-                                   :defaults *output-directory*)))
+(assert (probe-file (subpathname *output-directory* "cover-index.html")))
 
 ;;; None of the code was executed
 (assert (zerop (sb-cover::ok-of (getf sb-cover::*counts* :branch))))
@@ -71,7 +82,7 @@
 (report-expect-failure)
 
 ;;; Another file, with some branches
-(load (compile-file (merge-pathnames #p"test-data-2.lisp" *path*)))
+(compile-load "test-data-2")
 
 (test2 1)
 (report)
@@ -92,3 +103,11 @@
 ;; Complete branch coverage
 (assert (= (sb-cover::ok-of (getf sb-cover::*counts* :branch))
            (sb-cover::all-of (getf sb-cover::*counts* :branch))))
+
+;; Check for presence of constant coalescing bugs
+(compile-load "test-data-3")
+(test-2)
+
+;; Clean up after the tests
+(map nil #'delete-file
+     (directory (merge-pathnames #p"*.html" *output-directory*)))