X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=contrib%2Fsb-cover%2Fcover.lisp;h=28ead428e959f2424e13aad7068c7392d1b91a62;hb=93dd7df18bb1774e6620df84598122d8650127e5;hp=c273b8609925d66e4218d5970e3abf6e5af2495e;hpb=b8f49ceae4a3b513de21f385bb784729d2ddff3f;p=sbcl.git

diff --git a/contrib/sb-cover/cover.lisp b/contrib/sb-cover/cover.lisp
index c273b86..28ead42 100644
--- a/contrib/sb-cover/cover.lisp
+++ b/contrib/sb-cover/cover.lisp
@@ -79,6 +79,19 @@ result to RESTORE-COVERAGE."
         (restore-coverage (read stream))))
     (values)))
 
+(defun pathname-as-directory (pathname &optional (errorp t))
+  (let ((pathname (merge-pathnames pathname)))
+    (if (and (member (pathname-name pathname) '(nil :unspecific))
+             (member (pathname-type pathname) '(nil :unspecific)))
+        pathname
+        (if errorp
+            (error "~S does not designate a directory" pathname)
+            (make-pathname :directory (append (or (pathname-directory pathname)
+                                                  (list :relative))
+                                              (list (file-namestring pathname)))
+                           :name nil :type nil
+                           :defaults pathname)))))
+
 (defun report (directory &key ((:form-mode *source-path-mode*) :whole)
                (external-format :default))
   "Print a code coverage report of all instrumented files into DIRECTORY.
@@ -92,7 +105,7 @@ it has the value :WHOLE the whole form will be annotated (the default).
 The former mode shows explicitly which forms were instrumented, while the
 latter mode is generally easier to read."
   (let ((paths)
-        (*default-pathname-defaults* (merge-pathnames (pathname directory))))
+        (*default-pathname-defaults* (pathname-as-directory directory)))
     (ensure-directories-exist *default-pathname-defaults*)
     (maphash (lambda (k v)
                (declare (ignore v))