0.9.14.6:

[sbcl.git] / tests / pathnames.impure.lisp

diff --git a/tests/pathnames.impure.lisp b/tests/pathnames.impure.lisp
index 280334b..6993c55 100644 (file)
--- a/tests/pathnames.impure.lisp
+++ b/tests/pathnames.impure.lisp
@@ -356,5 +356,36 @@
                  (list* 'write-to-string pathname vars)
                  expected
                  actual))
+\f
+;;; we got (truename "/") wrong for about 6 months.  Check that it's
+;;; still right.
+(let ((pathname (truename "/")))
+  (assert (equalp pathname #p"/"))
+  (assert (equal (pathname-directory pathname) '(:absolute))))
+\f
+;;; we failed to unparse logical pathnames with :NAME :WILD :TYPE NIL.
+;;; (Reported by Pascal Bourguignon.
+(let ((pathname (make-pathname :host "SYS" :directory '(:absolute :wild-inferiors)
+                               :name :wild :type nil)))
+  (assert (string= (namestring pathname) "SYS:**;*"))
+  (assert (string= (write-to-string pathname :readably t) "#P\"SYS:**;*\"")))
+\f
+;;; reported by James Y Knight on sbcl-devel 2006-05-17
+(let ((p1 (make-pathname :directory '(:relative "bar")))
+      (p2 (make-pathname :directory '(:relative :back "foo"))))
+  (assert (equal (merge-pathnames p1 p2)
+                 (make-pathname :directory '(:relative :back "foo" "bar")))))
 
+;;; construct native namestrings even if the directory is empty (means
+;;; that same as if (:relative))
+(assert (equal (sb-ext:native-namestring (make-pathname :directory '(:relative)
+                                                        :name "foo"
+                                                        :type "txt"))
+               (sb-ext:native-namestring (let ((p (make-pathname :directory nil
+                                                                 :name "foo"
+                                                                 :type "txt")))
+                                           (assert (not (pathname-directory p)))
+                                           p))))
+
+\f
 ;;;; success