X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=tests%2Fpathnames.impure.lisp;h=927f288c4f2634d8d531dcf39c97313e0d15c0cb;hb=ebee2761543b208483fe763b1d329d5d0014b892;hp=ae1745f63a8156277b8b1148adcf4324a5a84380;hpb=148ae852a476ec673020ecbf99be3bcb4a70eafc;p=sbcl.git

diff --git a/tests/pathnames.impure.lisp b/tests/pathnames.impure.lisp
index ae1745f..927f288 100644
--- a/tests/pathnames.impure.lisp
+++ b/tests/pathnames.impure.lisp
@@ -362,5 +362,52 @@
 (let ((pathname (truename "/")))
   (assert (equalp pathname #p"/"))
   (assert (equal (pathname-directory pathname) '(:absolute))))
+
+;;; 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:**;*\"")))
+
+;;; 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))))
+
+;;; reported by Richard Kreuter: PATHNAME and MERGE-PATHNAMES used to
+;;; be unsafely-flushable. Since they are known to return non-nil values
+;;; only, the test-node of the IF is flushed, and since the function
+;;; is unsafely-flushable, out it goes, and bad pathname designators
+;;; breeze through.
+;;;
+;;; These tests rely on using a stream that appears as a file-stream
+;;; but isn't a valid pathname-designator.
+(assert (eq :false
+            (if (ignore-errors (pathname sb-sys::*tty*)) :true :false)))
+(assert (eq :false
+            (if (ignore-errors (merge-pathnames sb-sys::*tty*)) :true :false)))
+
+;;; This used to return "quux/bar.lisp"
+(assert (equal #p"quux/bar.fasl"
+               (let ((*default-pathname-defaults* #p"quux/"))
+                 (compile-file-pathname "foo.lisp" :output-file "bar"))))
+(assert (equal #p"quux/bar.fasl"
+               (let ((*default-pathname-defaults* #p"quux/"))
+                 (compile-file-pathname "bar.lisp"))))
+
+(enough-namestring #p".a*")
+
 ;;;; success