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

[Nikodemus Siivola]

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

Modified Files:
	osicat.lisp 
Log Message:
Fix behaviour if with-directory-iterator when fed directory-names without a slash.
Date: Sun Oct 26 10:31:27 2003
Author: nsiivola

Index: src/osicat.lisp
diff -u src/osicat.lisp:1.4 src/osicat.lisp:1.5
--- src/osicat.lisp:1.4	Sun Oct 26 09:38:02 2003
+++ src/osicat.lisp	Sun Oct 26 10:31:27 2003
@@ -51,23 +51,23 @@
 
 (defmacro with-c-file ((c-file pathname &optional required-kind follow-p) &body forms)
   ;; FIXME: This assumes that OS has the same idea of current dir as Lisp
-  (with-unique-names (path)
+  (with-unique-names (path kind)
     `(let ((,path ,pathname))
        (when (wild-pathname-p ,path)
 	 (error "Pathname is wild: ~S." ,path))
        (with-cstring (,c-file (namestring ,path))
-	 ,(etypecase required-kind
-	     (keyword `(let ((real-kind (c-file-kind ,c-file ,follow-p)))
-			 (unless (eq ,required-kind real-kind)
-			   (if real-kind
+	 (let ((,kind (c-file-kind ,c-file ,follow-p)))
+	   ,(etypecase required-kind
+	       (keyword `(unless (eq ,required-kind ,kind)
+			   (if ,kind
 			       (error "~A is ~A, not ~A."
-				      ,path real-kind ,required-kind)
+				      ,path ,kind ,required-kind)
 			       (error "~A ~S does not exist."
-				      ,required-kind ,path)))))
-	     ((eql t) `(unless (c-file-kind ,c-file ,follow-p)
-			 (error "~A does not exist." ,path)))
-	     (null nil))
-	 , at forms))))
+				      ,required-kind ,path))))
+	       ((eql t) `(unless ,kind
+			   (error "~A does not exist." ,path)))
+	       (null nil))
+	   , at forms)))))
 
 (defun file-kind (pathspec)
   "function FILE-KIND pathspec => file-kind
@@ -125,8 +125,14 @@
        (with-c-file (,cdir ,dir :directory t)
 	 (let ((,dp nil)
 	       (,default (make-pathname :name nil
-					:version nil
 					:type nil
+					:directory (append ;KLUDGE: deal with missing /'s
+						    (pathname-directory ,dir)
+						    (remove-if (lambda (o)
+								 (or (null o)
+								     (keywordp o)))
+							       (list (pathname-name ,dir)
+								     (pathname-type ,dir))))
 					:defaults ,dir)))
 	   (unwind-protect
 		(labels ((,iterator ()