0.6.10.13:

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

diff --git a/tests/pathnames.impure.lisp b/tests/pathnames.impure.lisp
index 703fdb0..4afbba0 100644 (file)
--- a/tests/pathnames.impure.lisp
+++ b/tests/pathnames.impure.lisp
@@ -16,10 +16,9 @@
 
 (in-package "CL-USER")
 
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (defmacro grab-condition (&body body)
-    `(nth-value 1
-      (ignore-errors ,@body))))
+(defmacro grab-condition (&body body)
+  `(nth-value 1
+     (ignore-errors ,@body)))
 
 (setf (logical-pathname-translations "demo0")
       '(("**;*.*.*" "/tmp/")))
@@ -57,7 +56,7 @@
 ;;; handle the following case exactly (otherwise we get an error:
 ;;; "#'IDENTITY CALLED WITH 2 ARGS."
 (setf (logical-pathname-translations "demo2")
-        '(("test;**;*.*" "/tmp/demo2/test/")))
+        '(("test;**;*.*" "/tmp/demo2/test")))
 (enough-namestring "demo2:test;foo.lisp")
 
 ;;; When a pathname comes from a logical host, it should be in upper
@@ -90,6 +89,10 @@
                    (translate-logical-pathname
                     "FOO:")))
 
+;;; ANSI says PARSE-NAMESTRING returns TYPE-ERROR on host mismatch.
+(let ((cond (grab-condition (parse-namestring "foo:jeamland" "demo2"))))
+  (assert (typep cond 'type-error)))
+
 ;;; ANSI, in its wisdom, specifies that it's an error (specifically a
 ;;; TYPE-ERROR) to query the system about the translations of a string
 ;;; which doesn't have any translations. It's not clear why we don't
@@ -123,4 +126,3 @@
 
 ;;; success
 (quit :unix-status 104)
-(in-package :cl-user)