X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fpathnames.impure.lisp;h=3d5c721f7974060b741a6cb7d59145c49dd2dc88;hb=cd13034f9415f64cdaa05893a4ac5ff1e95c97bd;hp=f939a49236f97035f6f84fb21bf47309b2a7d960;hpb=0957d59ccfaf3db9aaf79a7f4909a40ea0ca0dcd;p=sbcl.git

diff --git a/tests/pathnames.impure.lisp b/tests/pathnames.impure.lisp
index f939a49..3d5c721 100644
--- a/tests/pathnames.impure.lisp
+++ b/tests/pathnames.impure.lisp
@@ -63,7 +63,7 @@
 ;;; compelling reason for the implementors to choose case
 ;;; insensitivity and a canonical case.)
 (setf (logical-pathname-translations "FOO") 
-      '(("**;*.*.*" "/full/path/to/foo/**/*.*.*")))
+      '(("**;*.*.*" "/full/path/to/foo/**/*.*")))
 (let* ((pn1 (make-pathname :host "FOO" :directory "etc" :name "INETD" 
                            :type "conf"))
        (pn2 (make-pathname :host "foo" :directory "ETC" :name "inetd" 
@@ -264,8 +264,13 @@
 
         ;; FIXME: test version handling in LPNs
         )
-      do (assert (string= (namestring (apply #'merge-pathnames params))
-                          (namestring expected-result))))
+      do (let ((result (apply #'merge-pathnames params)))
+	   (macrolet ((frob (op)
+			`(assert (equal (,op result) (,op expected-result)))))
+	     (frob pathname-host)
+	     (frob pathname-directory)
+	     (frob pathname-name)
+	     (frob pathname-type))))
 
 ;;; host-namestring testing
 (assert (string=
@@ -293,5 +298,21 @@
 (assert (raises-error? (merge-pathnames (make-string-output-stream))
 		       type-error))
 
+;;; ensure read/print consistency (or print-not-readable-error) on
+;;; pathnames:
+(let ((pathnames (list
+		  (make-pathname :name "foo" :type "txt" :version :newest)
+		  (make-pathname :name "foo" :type "txt" :version 1)
+		  (make-pathname :name "foo" :type ".txt")
+		  (make-pathname :name "foo." :type "txt")
+		  (parse-namestring "SCRATCH:FOO.TXT.1")
+		  (parse-namestring "SCRATCH:FOO.TXT.NEWEST")
+		  (parse-namestring "SCRATCH:FOO.TXT"))))
+  (dolist (p pathnames)
+    (handler-case
+	(let ((*print-readably* t))
+	  (assert (equal (read-from-string (format nil "~S" p)) p)))
+      (print-not-readable () nil))))
+
 ;;;; success
 (quit :unix-status 104)