1.0.36.22: bogus style-warning in DEFSTRUCT edge-case

[sbcl.git] / tests / pathnames.impure.lisp

diff --git a/tests/pathnames.impure.lisp b/tests/pathnames.impure.lisp
index a46c6e0..7ed7250 100644 (file)
--- a/tests/pathnames.impure.lisp
+++ b/tests/pathnames.impure.lisp
@@ -20,12 +20,11 @@
 (setf (logical-pathname-translations "demo0")
       '(("**;*.*.*" "/tmp/")))
 
-;;; In case of a parse error we want to get a condition of type
-;;; CL:PARSE-ERROR (or more specifically, of type
-;;; SB-KERNEL:NAMESTRING-PARSE-ERROR).
+;;; In case of a parse error we want to get a condition of type TYPE-ERROR,
+;;; because ANSI says so. (This used to be PARSE-ERROR.)
 (assert
   (typep (grab-condition (logical-pathname "demo0::bla;file.lisp"))
-         'parse-error))
+         'type-error))
 
 ;;; some things SBCL-0.6.9 used not to parse correctly:
 ;;;
@@ -457,4 +456,34 @@
 #|:UNSPECIFIC|#     "C:\\tmp\\"   "C:\\tmp\\"   NIL           NIL
 #|""         |#     "C:\\tmp\\"   "C:\\tmp\\"   "C:\\tmp\\."  "C:\\tmp\\.a"
 #|"a"        |#     "C:\\tmp\\a"  "C:\\tmp\\a"  "C:\\tmp\\a." "C:\\tmp\\a.a")))
+
+(with-test (:name :delete-file-logical-pathname)
+  (setf (logical-pathname-translations "SB-TEST")
+        (list (list "**;*.*.*" (make-pathname :name :wild
+                                              :type :wild
+                                              :defaults (truename ".")))))
+  (let ((test (pathname "SB-TEST:delete-logical-pathname.tmp")))
+    (assert (typep test 'logical-pathname))
+    (with-open-file (f test :direction :output)
+      (write-line "delete me!" f))
+    (assert (probe-file test))
+    (assert (delete-file test))
+    (assert (not (probe-file test)))))
+
+(with-test (:name :logical-pathname-type-error)
+  (assert (eq :type-error-ok
+              (handler-case (logical-pathname "FOO.txt")
+                (type-error () :type-error-ok))))
+  (assert (eq :type-error-ok
+              (handler-case (logical-pathname "SYS:%")
+                (type-error () :type-error-ok)))))
+
+;;; Reported by Willem Broekema: Reading #p"\\\\" caused an error due
+;;; to insufficient sanity in input testing in EXTRACT-DEVICE (in
+;;; src;code;win32-pathname).
+#+win32
+(with-test (:name :bug-489698)
+  (assert (equal (make-pathname :directory '(:absolute))
+                 (read-from-string "#p\"\\\\\\\\\""))))
+
 ;;;; success