;;; some things SBCL-0.6.9 used not to parse correctly:
;;;
;;; SBCL used to throw an error saying there's no translation.
-(with-test (:name (:logical-pathname 1) :fails-on :win32)
+(with-test (:name (:logical-pathname 1))
(assert (equal (namestring (translate-logical-pathname "demo0:file.lisp"))
"/tmp/file.lisp")))
"/tmp/**/foo.lisp"))))
;;; That should be correct:
-(with-test (:name (:logical-pathname 4) :fails-on :win32)
+(with-test (:name (:logical-pathname 4))
(assert (equal (namestring (translate-logical-pathname "demo1:foo.lisp"))
"/tmp/foo.lisp")))
;;; Check for absolute/relative path confusion:
-(with-test (:name (:logical-pathname 5) :fails-on :win32)
+(with-test (:name (:logical-pathname 5))
(assert (not (equal (namestring (translate-logical-pathname "demo1:;foo.lisp"))
"tmp/rel/foo.lisp")))
(assert (equal (namestring (translate-logical-pathname "demo1:;foo.lisp"))
;;; there's some code in this section which should be attributed
;;; to something in the ANSI spec, but I don't know what code it is
;;; or what section of the specification has the related code.
-(with-test (:name (:logical-pathname 14) :fails-on :win32)
+(with-test (:name (:logical-pathname 14))
(setf (logical-pathname-translations "test0")
'(("**;*.*.*" "/library/foo/**/")))
(assert (equal (namestring (translate-logical-pathname
;;; ANSI section 19.3.1.1.5 specifies that translation to a filesystem
;;; which doesn't have versions should ignore the version slot. CMU CL
;;; didn't ignore this as it should, but we do.
-(with-test (:name (:logical-pathname 15) :fails-on :win32)
+(with-test (:name (:logical-pathname 15))
(assert (equal (namestring (translate-logical-pathname
"test0:foo;bar;baz;mum.quux.3"))
"/library/foo/foo/bar/baz/mum.quux")))
(assert (equal (make-pathname :directory '(:absolute))
(read-from-string "#p\"\\\\\\\\\""))))
-(with-test (:name :load-logical-pathname-translations :fails-on :win32)
+(with-test (:name :load-logical-pathname-translations)
(let* ((cwd (truename "."))
(foo (merge-pathnames "llpnt-foo.translations" cwd))
(bar (merge-pathnames "llpnt-bar.translations" cwd))
;; * / :WILD
(assert (equal (pathname-directory #p"\\*/") '(:relative "*"))))
-(with-test (:name :ensure-directories-exist-with-odd-d-p-d
- :fails-on :win32)
+(with-test (:name :ensure-directories-exist-with-odd-d-p-d)
(let ((*default-pathname-defaults* #p"/tmp/foo"))
(ensure-directories-exist "/")))
+(with-test (:name :long-file-name :skipped-on '(not :win32))
+ (let* ((x '("hint--if-you-are-having-trouble-deleting-this-test-directory"
+ "use-the-7zip-file-manager"))
+ (base (truename
+ (directory-namestring (or *load-pathname* *compile-pathname*))))
+ (shallow (make-pathname :directory `(:relative ,(car x))))
+ (shallow (merge-pathnames shallow base))
+ (deep (make-pathname
+ :directory `(:relative ,@(loop repeat 10 appending x))))
+ (deep (merge-pathnames deep base))
+ (native (sb-ext:native-namestring deep)))
+ (assert (> (length native) 260))
+ (assert (eql 3 (mismatch "\\\\?" native)))
+ (assert (not (probe-file shallow)))
+ (unwind-protect
+ (progn
+ (ensure-directories-exist deep)
+ (assert (probe-file deep)))
+ (sb-ext:delete-directory shallow :recursive t))
+ (assert (not (probe-file shallow)))))
+
;;;; success