From: Christophe Rhodes <csr21@cam.ac.uk>
Date: Wed, 18 Jan 2006 12:57:46 +0000 (+0000)
Subject: 0.9.8.44:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=148ae852a476ec673020ecbf99be3bcb4a70eafc;p=sbcl.git

0.9.8.44:
	Fix for (truename #p"/") (reported by tomppa on #lisp)
---

diff --git a/NEWS b/NEWS
index 10eeab1..ad6e59d 100644
--- a/NEWS
+++ b/NEWS
@@ -11,6 +11,8 @@ changes in sbcl-0.9.9 relative to sbcl-0.9.8:
   * bug fix: saving a core corrupted callbacks on x86/x86-64
   * bug fix: closed a loophole in metacircularity detection and
     grounding in the PCL implementation of CLOS.
+  * bug fix: TRUENAME on "/" no longer returns a relative pathname.
+    (reported by tomppa on #lisp)
   * optimization: major improvements to GC efficiency on GENCGC platforms
   * optimization: faster implementation of EQUAL
   * optimization: emit more efficient opcodes for some common 
diff --git a/src/code/unix.lisp b/src/code/unix.lisp
index f4d0ef3..d4666d7 100644
--- a/src/code/unix.lisp
+++ b/src/code/unix.lisp
@@ -889,8 +889,12 @@ SYSCALL-FORM. Repeat evaluation of SYSCALL-FORM if it is interrupted."
   ;; KLUDGE: readlink and lstat are unreliable if given symlinks
   ;; ending in slashes -- fix the issue here instead of waiting for
   ;; libc to change...
+  ;;
+  ;; but be careful!  Must not strip the final slash from "/".  (This
+  ;; adjustment might be a candidate for being transferred into the C
+  ;; code in a wrap_readlink() function, too.) CSR, 2006-01-18
   (let ((len (length pathname)))
-    (when (and (plusp len) (eql #\/ (schar pathname (1- len))))
+    (when (and (> len 1) (eql #\/ (schar pathname (1- len))))
       (setf pathname (subseq pathname 0 (1- len)))))
   (/noshow "entering UNIX-RESOLVE-LINKS")
   (loop with previous-pathnames = nil do
diff --git a/tests/pathnames.impure.lisp b/tests/pathnames.impure.lisp
index 280334b..ae1745f 100644
--- a/tests/pathnames.impure.lisp
+++ b/tests/pathnames.impure.lisp
@@ -356,5 +356,11 @@
                  (list* 'write-to-string pathname vars)
                  expected
                  actual))
+
+;;; we got (truename "/") wrong for about 6 months.  Check that it's
+;;; still right.
+(let ((pathname (truename "/")))
+  (assert (equalp pathname #p"/"))
+  (assert (equal (pathname-directory pathname) '(:absolute))))
 
 ;;;; success
diff --git a/version.lisp-expr b/version.lisp-expr
index 4a76338..476138a 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.8.43"
+"0.9.8.44"