X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fpathnames.impure.lisp;h=724692488e7b782081666e3ee9d3152a5dbdcd25;hb=6d36f2d6954cb79e3c88fef33fe0c3ad63deaea8;hp=7f8f065b2045906b6332cc409bf046e6f7d21adb;hpb=a7e90050c1617168d162b7219c4aeede3e90205a;p=sbcl.git

diff --git a/tests/pathnames.impure.lisp b/tests/pathnames.impure.lisp
index 7f8f065..7246924 100644
--- a/tests/pathnames.impure.lisp
+++ b/tests/pathnames.impure.lisp
@@ -568,4 +568,29 @@
       (ignore-errors (delete-file bar))
       (setf (logical-pathname-translations "SYS") translations))))
 
+(with-test (:name :tilde-expansion)
+  (assert (equal '(:absolute :home "foo") (pathname-directory "~/foo/bar.txt")))
+  (assert (equal '(:absolute (:home "jdoe") "quux") (pathname-directory "~jdoe/quux/")))
+  (assert (equal "~/foo/x" (namestring (make-pathname :directory '(:absolute :home "foo")
+                                                      :name "x"))))
+  (assert (equal (native-namestring (merge-pathnames "a/b.c" (user-homedir-pathname)))
+                 (native-namestring #p"~/a/b.c")))
+  ;; Not a directory.
+  (assert (equal (native-namestring #p"~foo") "~foo"))
+  ;; Not at the start of the first directory
+  (assert (equal (native-namestring #p"foo/~/bar")
+                 #-win32 "foo/~/bar"
+                 #+win32 "foo\\~\\bar")))
+
+;;; lp#673625
+(with-test (:name :pathname-escape-first-directory-component
+                  :fails-on :win32)
+  ;; ~ / :HOME
+  (assert (equal (pathname-directory #p"\\~/foo/") '(:relative "~" "foo")))
+  (assert (equal (native-namestring #p"\\~/foo/") "~/foo/"))
+  (assert (equal (namestring (make-pathname :directory '(:absolute "~zot")))
+                 "\\~zot/"))
+  ;; * / :WILD
+  (assert (equal (pathname-directory #p"\\*/") '(:relative "*"))))
+
 ;;;; success