[prev in list] [next in list] [prev in thread] [next in thread] 

List:       sbcl-commits
Subject:    [Sbcl-commits] master: tests: Collect DIRECTORY tests in one place in filesys.pure.lisp
From:       Jan Moringen via Sbcl-commits <sbcl-commits () lists ! sourceforge ! net>
Date:       2017-12-31 15:07:54
Message-ID: 1514732874.582019.31691 () sfp-scm-2 ! v30 ! ch3 ! sourceforge ! com
[Download RAW message or body]

The branch "master" has been updated in SBCL:
       via  c1223ee5816663165218ebec1d4588fd6c539147 (commit)
      from  e0e60159fa42eabf2d5b5d6ffd417a57b9ab9444 (commit)

- Log -----------------------------------------------------------------
commit c1223ee5816663165218ebec1d4588fd6c539147
Author: Jan Moringen <jmoringe@techfak.uni-bielefeld.de>
Date:   Sun Dec 31 14:41:04 2017 +0100

    tests: Collect DIRECTORY tests in one place in filesys.pure.lisp
---
 tests/filesys.pure.lisp | 93 ++++++++++++++++++++++++++-----------------------
 1 file changed, 49 insertions(+), 44 deletions(-)

diff --git a/tests/filesys.pure.lisp b/tests/filesys.pure.lisp
index 377ad18..123c948 100644
--- a/tests/filesys.pure.lisp
+++ b/tests/filesys.pure.lisp
@@ -11,6 +11,55 @@
 
 (in-package "CL-USER")
 
+
+;;;; DIRECTORY
+
+;;; In sbcl-0.6.9 DIRECTORY failed on paths with :WILD or
+;;; :WILD-INFERIORS in their directory components.
+(with-test (:name (directory :wild-inferiors))
+  (let ((dir (directory "../**/*.*")))
+    ;; We know a little bit about the structure of this result;
+    ;; let's test to make sure that this test file is in it.
+    (assert (find-if (lambda (pathname)
+                       (search "tests/filesys.pure.lisp"
+                               (namestring pathname)))
+                     dir))))
+;;; In sbcl-0.9.7 DIRECTORY failed on pathnames with character-set
+;;; components.
+(with-test (:name (directory :character-set :pattern) )
+  (let ((dir (directory "[f]*.*")))
+    ;; We know a little bit about the structure of this result;
+    ;; let's test to make sure that this test file is in it.
+    (assert (find-if (lambda (pathname)
+                       (search "filesys.pure.lisp"
+                               (namestring pathname)))
+                     dir))))
+
+;;; Canonicalization of pathnames for DIRECTORY
+(with-test (:name (directory :/.))
+  (assert (equal (directory #p".") (directory #p"./")))
+  (assert (equal (directory #p".") (directory #p""))))
+(with-test (:name (directory :/..))
+  (assert (equal (directory #p"..") (directory #p"../"))))
+(with-test (:name (directory :unspecific))
+  (assert (equal (directory #p".")
+                 (directory (make-pathname
+                             :name :unspecific
+                             :type :unspecific)))))
+
+;;; This used to signal a TYPE-ERROR.
+(with-test (:name (directory :..*))
+  (directory "somedir/..*"))
+
+;;; DIRECTORY used to treat */** as **.
+(with-test (:name (directory :*/**))
+  (assert (equal (directory "*/**/*.*")
+                 (mapcan (lambda (directory)
+                           (directory (merge-pathnames "**/*.*" directory)))
+                         (directory "*/")))))
+
+;;;; OPEN
+
 ;;; In sbcl-0.6.9 FOO-NAMESTRING functions  returned "" instead of NIL.
 (with-test (:name (file-namestring directory-namestring :name))
   (let ((pathname0 (make-pathname :host nil
@@ -27,27 +76,6 @@
     (assert (equal (file-namestring pathname1) ""))
     (assert (equal (directory-namestring pathname1) ""))))
 
-;;; In sbcl-0.6.9 DIRECTORY failed on paths with :WILD or
-;;; :WILD-INFERIORS in their directory components.
-(with-test (:name (directory :wild-inferiors))
-  (let ((dir (directory "../**/*.*")))
-    ;; We know a little bit about the structure of this result;
-    ;; let's test to make sure that this test file is in it.
-    (assert (find-if (lambda (pathname)
-                       (search "tests/filesys.pure.lisp"
-                               (namestring pathname)))
-                     dir))))
-;;; In sbcl-0.9.7 DIRECTORY failed on pathnames with character-set
-;;; components.
-(with-test (:name (directory :character-set :pattern) )
-  (let ((dir (directory "[f]*.*")))
-    ;; We know a little bit about the structure of this result;
-    ;; let's test to make sure that this test file is in it.
-    (assert (find-if (lambda (pathname)
-                       (search "filesys.pure.lisp"
-                               (namestring pathname)))
-                     dir))))
-
 ;;; Set *default-pathname-defaults* to something other than the unix
 ;;; cwd, to catch functions which access the filesystem without
 ;;; merging properly.  We should test more functions than just OPEN
@@ -197,29 +225,6 @@
 (with-test (:name (file-write-date integerp))
   (assert (integerp (file-write-date (user-homedir-pathname)))))
 
-;;; Canonicalization of pathnames for DIRECTORY
-(with-test (:name (directory :/.))
-  (assert (equal (directory #p".") (directory #p"./")))
-  (assert (equal (directory #p".") (directory #p""))))
-(with-test (:name (directory :/..))
-  (assert (equal (directory #p"..") (directory #p"../"))))
-(with-test (:name (directory :unspecific))
-  (assert (equal (directory #p".")
-                 (directory (make-pathname
-                             :name :unspecific
-                             :type :unspecific)))))
-
-;;; This used to signal a TYPE-ERROR.
-(with-test (:name (directory :..*))
-  (directory "somedir/..*"))
-
-;;; DIRECTORY used to treat */** as **.
-(with-test (:name (directory :*/**))
-  (assert (equal (directory "*/**/*.*")
-                 (mapcan (lambda (directory)
-                           (directory (merge-pathnames "**/*.*" directory)))
-                         (directory "*/")))))
-
 ;;; Generated with
 ;;; (loop for exist in '(nil t)
 ;;;       append

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL

------------------------------------------------------------------------------
Check out the vibrant tech community on one of the world's most
engaging tech sites, Slashdot.org! http://sdm.link/slashdot
_______________________________________________
Sbcl-commits mailing list
Sbcl-commits@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/sbcl-commits
[prev in list] [next in list] [prev in thread] [next in thread]