[armedbear-cvs] r13698 - trunk/abcl/test/lisp/abcl

[mevenson at common-lisp.net]

Author: mevenson
Date: Wed Nov 23 11:43:18 2011
New Revision: 13698

Log:
Test for ticket #181 for failure somewhere in MERGE-PATHNAMES.

Probably related to underlying Pathname.truename() code from what I
could see in the JVM debugger.

Modified:
   trunk/abcl/test/lisp/abcl/jar-pathname.lisp

Modified: trunk/abcl/test/lisp/abcl/jar-pathname.lisp
==============================================================================
--- trunk/abcl/test/lisp/abcl/jar-pathname.lisp	Wed Nov 23 11:43:08 2011	(r13697)
+++ trunk/abcl/test/lisp/abcl/jar-pathname.lisp	Wed Nov 23 11:43:18 2011	(r13698)
@@ -481,8 +481,14 @@
 			"/foo/**/*.*")
   #p"/foo/d/e/f.lisp")
 
-      
-
-        
-
-  
+;;; ticket #181
+;;; TODO Make reasons for failure more clear
+(deftest jar-pathname.truename.1
+    (let* ((abcl (slot-value (asdf:find-system 'abcl) 'asdf::absolute-pathname))
+           (jar (pathname (format nil "jar:file:~A/dist/abcl-contrib.jar!/jss/jss.asd" (namestring abcl))))
+           (jar-dir (make-pathname :defaults jar :name nil :type nil))
+           (defaults *default-pathname-defaults*))
+      (let ((*default-pathname-defaults* jar-dir))
+        (not (probe-file (merge-pathnames jar)))))
+  nil)
+  
\ No newline at end of file