X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fpathnames.impure.lisp;h=f939a49236f97035f6f84fb21bf47309b2a7d960;hb=64ec717cf13c44fb4571c1fd7fbd508551ecfe01;hp=00da4c03c891f52bdcf8aa5ab96507045153f7cd;hpb=0f3d47226b4c3f9fcc350e681443534701d56aa4;p=sbcl.git

diff --git a/tests/pathnames.impure.lisp b/tests/pathnames.impure.lisp
index 00da4c0..f939a49 100644
--- a/tests/pathnames.impure.lisp
+++ b/tests/pathnames.impure.lisp
@@ -14,9 +14,8 @@
 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
 ;;;; more information.
 
-(in-package "CL-USER")
-
 (load "assertoid.lisp")
+(use-package "ASSERTOID")
 
 (setf (logical-pathname-translations "demo0")
       '(("**;*.*.*" "/tmp/")))
@@ -25,7 +24,7 @@
 ;;; CL:PARSE-ERROR (or more specifically, of type
 ;;; SB-KERNEL:NAMESTRING-PARSE-ERROR).
 (assert
-  (typep (grab-condition (translate-logical-pathname "demo0::bla;file.lisp"))
+  (typep (grab-condition (logical-pathname "demo0::bla;file.lisp"))
          'parse-error))
 
 ;;; some things SBCL-0.6.9 used not to parse correctly:
@@ -79,17 +78,21 @@
 ;;; FIXME: currently SBCL throws NAMESTRING-PARSE-ERROR: should this be
 ;;; a TYPE-ERROR?
 
-(assert (not (ignore-errors
-               (make-pathname :host "FOO" :directory "!bla" :name "bar"))))
-
-;; error: name-component not valid
-(assert (not (ignore-errors
-               (make-pathname :host "FOO" :directory "bla" :name "!bar"))))
-
-;; error: type-component not valid.
-(assert (not (ignore-errors
-               (make-pathname :host "FOO" :directory "bla" :name "bar"
-                              :type "&baz"))))
+(locally
+  ;; MAKE-PATHNAME is UNSAFELY-FLUSHABLE
+  (declare (optimize safety))
+  
+  (assert (not (ignore-errors
+		(make-pathname :host "FOO" :directory "!bla" :name "bar"))))
+  
+  ;; error: name-component not valid
+  (assert (not (ignore-errors
+		(make-pathname :host "FOO" :directory "bla" :name "!bar"))))
+  
+  ;; error: type-component not valid.
+  (assert (not (ignore-errors
+		(make-pathname :host "FOO" :directory "bla" :name "bar"
+			       :type "&baz")))))
 
 ;;; We may need to parse the host as a LOGICAL-NAMESTRING HOST. The
 ;;; HOST in PARSE-NAMESTRING can be either a string or :UNSPECIFIC
@@ -275,5 +278,20 @@
 	 (setf (logical-pathname-translations "")
 	       (list '("**;*.*.*" "/**/*.*")))))
 
+;;; Bug 200: translate-logical-pathname is according to the spec supposed
+;;; not to give errors if asked to translate a namestring for a valid
+;;; physical pathname.  Failed in 0.7.7.28 and before
+(assert (string= (namestring (translate-logical-pathname "/")) "/"))
+
+
+;;; Not strictly pathname logic testing, but until sbcl-0.7.6.19 we
+;;; had difficulty with non-FILE-STREAM stream arguments to pathname
+;;; functions (they would cause memory protection errors).  Make sure
+;;; that those errors are gone:
+(assert (raises-error? (pathname (make-string-input-stream "FOO"))
+		       type-error))
+(assert (raises-error? (merge-pathnames (make-string-output-stream))
+		       type-error))
+
 ;;;; success
 (quit :unix-status 104)