[osicat-cvs] CVS update: src/osicat.lisp src/test-osicat.lisp

[Julian E. C. Squires]

Update of /project/osicat/cvsroot/src
In directory common-lisp.net:/tmp/cvs-serv3584

Modified Files:
	osicat.lisp test-osicat.lisp 
Log Message:
 * Fixed a bug in READ-LINK for long links.
 * Updated tests with respect to dead NORMPATH.
 * Added WITH-DIRECTORY-ITERATOR tests.

Date: Sun Apr 25 10:57:57 2004
Author: jsquires

Index: src/osicat.lisp
diff -u src/osicat.lisp:1.27 src/osicat.lisp:1.28
--- src/osicat.lisp:1.27	Sun Apr 25 10:44:34 2004
+++ src/osicat.lisp	Sun Apr 25 10:57:57 2004
@@ -306,7 +306,7 @@
     (with-c-file (path (absolute-pathname pathspec) :symbolic-link)
       (do* ((size 64 (* size 2))
 	    (buffer #1=(allocate-foreign-string size) #1#)
-	    (got (readlink path buffer size)))
+	    (got #2=(readlink path buffer size) #2#))
 	   ((< got size)
 	    (let ((str (convert-from-foreign-string buffer :length got)))
 	      (free-foreign-object buffer)


Index: src/test-osicat.lisp
diff -u src/test-osicat.lisp:1.8 src/test-osicat.lisp:1.9
--- src/test-osicat.lisp:1.8	Sat Apr 24 12:40:02 2004
+++ src/test-osicat.lisp	Sun Apr 25 10:57:57 2004
@@ -50,9 +50,8 @@
   t)
 
 (deftest environment.1
-    (namestring (osicat::normpath (cdr (assoc "HOME" (environment)
-					      :test #'equal))
-				  t))
+    (namestring (probe-file (cdr (assoc "HOME" (environment)
+					:test #'equal))))
   #.(namestring (user-homedir-pathname)))
 
 (deftest environment.2
@@ -158,7 +157,30 @@
 	(delete-file file)
 	(delete-file link)))
   :symbolic-link)
-	 
+
+;; Test the case of reading a link to a directory.
+(deftest read-link.1
+    (let ((link (merge-pathnames "read-link-test-link" *test-dir*)))
+      (unwind-protect
+	   (progn
+	     (make-link link :target *test-dir*)
+	     (namestring (read-link link)))
+	(delete-file link)))
+  #.(namestring *test-dir*))
+
+;; Test the case of reading a link with a very long name.
+(deftest read-link.1
+    (let ((link (merge-pathnames "make-link-test-link" *test-dir*))
+	  (file (ensure-file "a-very-long-tmp-file-name-explicitly-for-the-purpose-of-testing-a-certain-condition-in-read-link-please-ignore-thanks")))
+      (unwind-protect
+	   (progn
+	     (make-link link :target file)
+	     (equal (namestring (merge-pathnames file *test-dir*))
+		    (namestring (read-link link))))
+	(delete-file link)
+	(delete-file file)))
+  t)
+
 (deftest maunbound-environment-variable.1
     (let ((old (environment-variable :path)))
       (unwind-protect
@@ -225,6 +247,63 @@
 	     (when (/= (length list) 2) (error "too many path elements.")))
 	(delete-directory dir)))
   nil)
+
+;; Be careful with this test.  It deletes directories recursively.
+(deftest with-directory-iterator.1
+    (let ((dirs (list "wdi-test-1/" ".wdi-test.2/" ".wdi.test.3../")))
+      (ensure-directories-exist (reduce (lambda (x y) (merge-pathnames y x))
+					(cons *test-dir* dirs)))
+      (labels ((rm-r (dir)
+	       (with-directory-iterator (next dir)
+		 (loop for file = (next)
+		       while file
+		       when (and (eql (file-kind file) :directory)
+				 (member (namestring file) dirs
+					 :test #'string=))
+		       do (progn (rm-r file)
+				 (delete-directory file))))))
+	(rm-r *test-dir*)))
+  nil)
+
+;; Test iteration over a variety of objects.
+(deftest with-directory-iterator.2
+    (let ((playground '(:directory "wdi-test-1/"
+			(:directory "wdi-test-2/"
+			 (:symbolic-link "bar" "foo")
+			 (:directory "baz/"
+			  (:file "quux"))
+			 (:file "foo")))))
+      (labels
+	  ((create-playground (x base-dir)
+	     (case (car x)
+	       (:file (ensure-file (cadr x) base-dir))
+	       (:symbolic-link (make-link (merge-pathnames (cadr x) base-dir)
+					  :target (merge-pathnames
+						   (caddr x) base-dir)))
+	       (:directory (ensure-directories-exist (merge-pathnames
+						      (cadr x) base-dir))
+			   (dolist (y (cddr x))
+			     (create-playground y (merge-pathnames
+						   (cadr x) base-dir))))))
+	   (walk (dir)
+	     (with-directory-iterator (next dir)
+	       (loop for file = (next)
+		     while file
+		     collect (case (file-kind file)
+			       (:directory
+				(append (list :directory (namestring file))
+					(sort (walk file)
+					      (lambda (a b)
+						(string<= (cadr a) (cadr b))))))
+			       (:symbolic-link
+				(list :symbolic-link (namestring file)
+				      (pathname-name (namestring
+						      (read-link file)))))
+			       (t (list :file (namestring file))))))))
+	(create-playground playground *test-dir*)
+	(equal (walk (merge-pathnames (cadr playground) *test-dir*))
+	       (cddr playground))))
+  t)
 
 ;; Test behavior in the case of an obviously incorrect username.
 (deftest user-info.1