From 0a77c9d7ec62d51e9653af8702145e571a5b41ff Mon Sep 17 00:00:00 2001
From: Jan Moringen <jmoringe@techfak.uni-bielefeld.de>
Date: Thu, 1 Sep 2016 21:41:37 +0200
Subject: [PATCH] Fix TYPE-ERROR from (directory "SOME-DIRECTORY/..*")

---
 src/code/filesys.lisp   | 24 ++++++++++++------------
 tests/filesys.pure.lisp |  3 +++
 2 files changed, 15 insertions(+), 12 deletions(-)

diff --git a/src/code/filesys.lisp b/src/code/filesys.lisp
index 4b93242dd..cf4c74a40 100644
--- a/src/code/filesys.lisp
+++ b/src/code/filesys.lisp
@@ -739,18 +739,18 @@ matching filenames."
     (let ((name (simplify (pathname-name pathname)))
           (type (simplify (pathname-type pathname)))
           (dir (canonicalize-directory (pathname-directory pathname))))
-      (cond ((equal "." name)
-             (cond ((not type)
-                    (make-pathname :name nil :defaults pathname))
-                   ((equal "" type)
-                    (make-pathname :name nil
-                                   :type nil
-                                   :directory (butlast dir)
-                                   :defaults pathname))))
-            (t
-             (make-pathname :name name :type type
-                            :directory dir
-                            :defaults pathname))))))
+      (cond
+        ((not (equal "." name))
+         (make-pathname :name name :type type :directory dir
+                        :defaults pathname))
+        ((not type)
+         (make-pathname :name nil :defaults pathname))
+        ((equal "" type)
+         (make-pathname :name nil :type nil :directory (butlast dir)
+                        :defaults pathname))
+        (t
+         (make-pathname :name name :type type :directory dir
+                        :defaults pathname))))))
 
 ;;; Given a native namestring, provides a WITH-HASH-TABLE-ITERATOR style
 ;;; interface to mapping over namestrings of entries in the corresponding
diff --git a/tests/filesys.pure.lisp b/tests/filesys.pure.lisp
index f3d237950..efc55c7d1 100644
--- a/tests/filesys.pure.lisp
+++ b/tests/filesys.pure.lisp
@@ -191,6 +191,9 @@
                  (directory (make-pathname
                              :name :unspecific
                              :type :unspecific)))))
+(with-test (:name (directory :..*))
+  ;; This used to signal a TYPE-ERROR.
+  (directory "somedir/..*"))
 
 ;;; Generated with
 ;;; (loop for exist in '(nil t)
-- 
2.11.4.GIT