0.9.1.27: (truename "symlink-to-dir") === (truename "symlink-to-dir/")

  * it appears that libc doesn't like trailing slashes at the end of symlink
     names; paper over this sillyness.

diff --git a/NEWS b/NEWS
index 80967a5..e1f0fa4 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -6,6 +6,8 @@ changes in sbcl-0.9.2 relative to sbcl-0.9.1:
   * new feature: WITH-COMPILATION-UNIT now accepts a non-standard
     :SOURCE-PLIST option. See (DOCUMENTATION #'WITH-COMPILATION-UNIT T)
     for more information.
+  * TRUENAME and PROBE-FILE now correctly resolve symlinks even if the
+    pathname is a directory pathname.
   * SB-SPROF now works (more) reliably on non-GENCGC platforms.
   * fixed some lockups due to gc/thread interaction
   * dynamic space size on PPC has been increased to 768Mb. (thanks to

diff --git a/src/code/unix.lisp b/src/code/unix.lisp
index 7da7e55..2f1888f 100644 (file)
--- a/src/code/unix.lisp
+++ b/src/code/unix.lisp
@@ -831,10 +831,16 @@ previous timer after the body has finished executing"
 (defun unix-resolve-links (pathname)
   (declare (type simple-base-string pathname))
   (aver (not (relative-unix-pathname? pathname)))
+  ;; KLUDGE: readlink and lstat are unreliable if given symlinks
+  ;; ending in slashes -- fix the issue here instead of waiting for
+  ;; libc to change...
+  (let ((len (length pathname)))
+    (when (and (plusp len) (eql #\/ (schar pathname (1- len))))
+      (setf pathname (subseq pathname 0 (1- len)))))
   (/noshow "entering UNIX-RESOLVE-LINKS")
   (loop with previous-pathnames = nil do
-       (/noshow pathname previous-pathnames)
-       (let ((link (unix-readlink pathname)))
+       (/noshow pathname previous-pathnames)
+       (let ((link (unix-readlink pathname)))
          (/noshow link)
          ;; Unlike the old CMU CL code, we handle a broken symlink by
          ;; returning the link itself. That way, CL:TRUENAME on a

diff --git a/tests/filesys.test.sh b/tests/filesys.test.sh
index 4d78f7d..76f6338 100644 (file)
--- a/tests/filesys.test.sh
+++ b/tests/filesys.test.sh
@@ -18,6 +18,7 @@ echo this is a test > $testdir/test-1.tmp
 echo this is a test > $testdir/test-2.tmp
 echo this is a test > $testdir/wild\?test.tmp
 cd $testdir
+ln -s $testdir dirlinktest
 ln -s test-1.tmp link-1
 ln -s `pwd`/test-2.tmp link-2
 ln -s i-do-not-exist link-3
@@ -25,7 +26,8 @@ ln -s link-4 link-4
 ln -s link-5 link-6
 ln -s `pwd`/link-6 link-5
 expected_truenames=\
-"'(#p\"$testdir/link-3\"\
+"'(#p\"$testdir/\"\
+   #p\"$testdir/link-3\"\
    #p\"$testdir/link-4\"\
    #p\"$testdir/link-5\"\
    #p\"$testdir/link-6\"\
@@ -39,6 +41,8 @@ $SBCL <<EOF
     (format t "~&TRUENAMES=~S~%" truenames)
     (finish-output)
     (assert (equal truenames $expected_truenames)))
+  (assert (equal (truename "dirlinktest") #p"$testdir/"))
+  (assert (equal (truename "dirlinktest/") #p"$testdir/"))
   (assert (equal (truename "test-1.tmp") #p"$testdir/test-1.tmp"))
   (assert (equal (truename "link-1")     #p"$testdir/test-1.tmp"))
   (assert (equal (truename "link-2")     #p"$testdir/test-2.tmp"))

diff --git a/version.lisp-expr b/version.lisp-expr
index a7f3c7a..eb876b4 100644 (file)
--- 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.1.26"
+"0.9.1.27"