[armedbear-cvs] r13010 - in trunk/abcl: . test/lisp/abcl

[Mark Evenson]

Author: mevenson
Date: Sun Nov  7 07:10:45 2010
New Revision: 13010

Log:
Test for working :WILD-INFERIORS.

Added tests in 'test/lisp/abcl/wild-inferiors.lisp', for which Ville's
implementation passes.



Added:
   trunk/abcl/test/lisp/abcl/wild-pathnames.lisp
Modified:
   trunk/abcl/abcl.asd

Modified: trunk/abcl/abcl.asd
==============================================================================
--- trunk/abcl/abcl.asd	(original)
+++ trunk/abcl/abcl.asd	Sun Nov  7 07:10:45 2010
@@ -55,6 +55,7 @@
                       (:file "latin1-tests")
                       #+abcl
                       (:file "bugs" :depends-on ("file-system-tests"))
+                      (:file "wild-pathnames" :depends-on ("file-system-tests"))
                       #+abcl
                       (:file "pathname-tests")))))
 

Added: trunk/abcl/test/lisp/abcl/wild-pathnames.lisp
==============================================================================
--- (empty file)
+++ trunk/abcl/test/lisp/abcl/wild-pathnames.lisp	Sun Nov  7 07:10:45 2010
@@ -0,0 +1,56 @@
+(in-package :abcl.test.lisp)
+
+;;; Various tests for PATHNAMES :WILD and :WILD-INFERIORS
+
+(defvar *test-files*
+  '("foo.ext" "a/b/c/foo.ext" "a/d/e/foo.ext" "b/foo.ext" "a/foo.ext"))
+
+(defvar *temp-directory-root* 
+  (merge-pathnames "tmp/" *this-directory*))
+
+(defun create-wild-test-hierarchy ()
+  (dolist (file *test-files*)
+    (let ((file (merge-pathnames file *temp-directory-root*)))
+      (ensure-directories-exist (directory-namestring file))
+      (touch file))))
+
+(defun remove-wild-test-hierarchy ()
+  (delete-directory-and-files *temp-directory-root*))
+
+(defmacro with-test-directories (&rest body)
+  `(prog2 (create-wild-test-hierarchy)
+          , at body
+     (remove-wild-test-hierarchy)))
+
+(defun set-equal (a b)
+  (and
+   (= (length a) (length b))
+   (subsetp a b :test #'equal)
+   (subsetp b a :test #'equal)))
+    
+(deftest wild-pathnames.1
+    (let ((results
+           (with-test-directories
+               (directory (merge-pathnames "**/*.ext"
+                                           *temp-directory-root*))))
+          (expected
+           (loop :for file :in *test-files*
+              :collecting (merge-pathnames file
+                                           *temp-directory-root*))))
+      (set-equal results expected))
+  t)
+
+;;; XXX try to track this down by going to the git version?
+;;;
+;;; Passing, but some form of :VERSION :NEWEST was failing for
+;;; ASDF-2.116 according to Faré in proviate email of 18.08.2010
+(deftest wild-pathnames.2
+    (equal 
+     (first (with-test-directories
+                (directory (make-pathname :directory (pathname-directory *temp-directory-root*)
+                                          :name :wild :type "ext"
+                                          :version :newest))))
+     (merge-pathnames *temp-directory-root* "foo.ext"))
+  t)
+
+