diff --git a/code/filesys.lisp b/code/filesys.lisp
index 8476d449c351bb07685b40547be16be29e8366a4..2327cc0ac6bdd908af0ec579d484eaaea91e13fc 100644
--- a/code/filesys.lisp
+++ b/code/filesys.lisp
@@ -6,7 +6,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/filesys.lisp,v 1.88 2005/08/31 13:57:08 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/filesys.lisp,v 1.89 2005/09/12 14:38:17 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -339,10 +339,21 @@
 		  (cond (absolute
 			 (cons :absolute (dirs)))
 			((dirs)
-			 (cons :relative (dirs)))
+			 ;; "." in a :relative directory is the same
+			 ;; as if it weren't there, so remove them.
+			 (cons :relative (delete "." (dirs) :test #'equal)))
 			(t
-			 nil)))
-		name
+			 ;; If there is no directory and the name is
+			 ;; ".", we really got directory ".", so make it so.
+			 (if (equal name ".")
+			     (list :relative)
+			 nil))))
+		;; A file with name "." can't be the name of file on
+		;; Unix because it's a directory.  This was handled
+		;; above, so we can just set the name to nil.
+		(if (equal name ".")
+		    nil
+		    name)
 		type
 		version)))))
 
@@ -415,7 +426,9 @@
 	       (t
 		(pieces "/"))))
 	(:relative
-	 ;; Nothing special.
+	 ;; Nothing special, except if we were given '(:relative).
+	 (unless directory
+	   (pieces "./"))
 	 ))
       (dolist (dir directory)
 	(typecase dir
diff --git a/code/pathname.lisp b/code/pathname.lisp
index 256b321fa16e7cb8f856103e3278b94e520c5739..353cb34ba1d836e83d7bcfa238e4a13c633d9111 100644
--- a/code/pathname.lisp
+++ b/code/pathname.lisp
@@ -4,7 +4,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pathname.lisp,v 1.73 2005/05/11 13:51:09 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pathname.lisp,v 1.74 2005/09/12 14:38:17 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -724,8 +724,24 @@ a host-structure or string."
 		     (warn "Silly argument for a unix ~A: ~S"
 			   name-or-type name)))))))
       (check-component-validity name :pathname-name)
-      (check-component-validity type :pathname-type))
-
+      (check-component-validity type :pathname-type)
+      (mapc #'(lambda (d)
+		(check-component-validity d :directory))
+	    (cdr dir)))
+
+    ;; More sanity checking
+    (when dir
+      ;; Try to canonicalize the directory component.  :absolute
+      ;; followed by a bunch of "/" deletes the leading "/"'s.
+      ;; :relative followed by "."  anywhere gets them all deleted.
+      (ecase (first dir)
+	(:absolute
+	 (do ((p (cdr dir) (cdr p)))
+	    ((or (null p)
+		 (not (equal "/" (car p))))
+	     (setf (cdr dir) p))))
+	(:relative
+	 (setf (cdr dir) (delete "." (cdr dir) :test #'equal)))))
     ;; CLHS 19.2.2.4.3 says :absolute or :wild-inferiors immediately
     ;; followed by :up or :back signals a file-error.