From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Wed, 7 Jun 2006 09:49:54 +0000 (+0000)
Subject: 0.9.13.31: native-namestring bugfix
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=85487ad136765c62450eb42a906c085932217cda;p=sbcl.git

0.9.13.31: native-namestring bugfix
 * The native-namestring should be same for :DIRECTORY (:RELATIVE) and
   NIL.
---

diff --git a/src/code/unix-pathname.lisp b/src/code/unix-pathname.lisp
index 6f1cf6a..302fce0 100644
--- a/src/code/unix-pathname.lisp
+++ b/src/code/unix-pathname.lisp
@@ -245,9 +245,10 @@
         (type (pathname-type pathname)))
     (coerce
      (with-output-to-string (s)
-       (ecase (car directory)
-         (:absolute (write-char #\/ s))
-         (:relative))
+       (when directory
+         (ecase (car directory)
+           (:absolute (write-char #\/ s))
+           (:relative)))
        (dolist (piece (cdr directory))
          (typecase piece
            ((member :up) (write-string ".." s))
diff --git a/tests/pathnames.impure.lisp b/tests/pathnames.impure.lisp
index 86bf11b..6993c55 100644
--- a/tests/pathnames.impure.lisp
+++ b/tests/pathnames.impure.lisp
@@ -375,5 +375,17 @@
       (p2 (make-pathname :directory '(:relative :back "foo"))))
   (assert (equal (merge-pathnames p1 p2)
                  (make-pathname :directory '(:relative :back "foo" "bar")))))
+
+;;; construct native namestrings even if the directory is empty (means
+;;; that same as if (:relative))
+(assert (equal (sb-ext:native-namestring (make-pathname :directory '(:relative)
+                                                        :name "foo"
+                                                        :type "txt"))
+               (sb-ext:native-namestring (let ((p (make-pathname :directory nil
+                                                                 :name "foo"
+                                                                 :type "txt")))
+                                           (assert (not (pathname-directory p)))
+                                           p))))
+
 
 ;;;; success
diff --git a/version.lisp-expr b/version.lisp-expr
index c0ec8dc..1091375 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.13.30"
+"0.9.13.31"