[Sbcl-commits] CVS: sbcl/tests pathnames.impure.lisp,1.13,1.14 print.impure.lisp,1.7,1.8

[Christophe R. <cr...@us...>]

Update of /cvsroot/sbcl/sbcl/tests
In directory usw-pr-cvs1:/tmp/cvs-serv12298/tests

Modified Files:
	pathnames.impure.lisp print.impure.lisp 
Log Message:
0.7.3.13:
	Fix bug 22, throwing an error for bad directives inside ~< ~:> 
	format blocks.
	Bugfix for host-namestring (and associated host-using functions):
	... make the physical host name be "" (not "Unix), as this cannot 
		be a logical host name
	... some sanity checking in logical host functionality regarding
		this change
	Remove fixed buglets from BUGS
	Added .cvsignore files for files built in warm init.


Index: pathnames.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/pathnames.impure.lisp,v
retrieving revision 1.13
retrieving revision 1.14
diff -C2 -d -r1.13 -r1.14
*** pathnames.impure.lisp	18 Apr 2002 21:58:57 -0000	1.13
--- pathnames.impure.lisp	10 May 2002 10:48:35 -0000	1.14
***************
*** 178,183 ****
  ;;;; ANSI-compliance unless your PARSE-NAMESTRING works like ours.
  
! (setf (logical-pathname-translations "scratch")
!       '(("**;*.*.*" "/usr/local/doc/**/*")))
  
  (loop for (expected-result . params) in
--- 178,188 ----
  ;;;; ANSI-compliance unless your PARSE-NAMESTRING works like ours.
  
! ;;; Needs to be done at compile time, so that the #p"" read-macro
! ;;; correctly parses things as logical pathnames. This is not a
! ;;; problem as was, as this is an impure file and so gets loaded in,
! ;;; but just for future proofing...
! (eval-when (:compile-toplevel :load-toplevel :execute)
!   (setf (logical-pathname-translations "scratch")
!         '(("**;*.*.*" "/usr/local/doc/**/*"))))
  
  (loop for (expected-result . params) in
***************
*** 195,199 ****
          (#p"/dir/name.supplied-type"
           ,(make-pathname :type "supplied-type")
! 	 #p"/dir/name.type")
          ;; If (pathname-directory pathname) is a list whose car is
          ;; :relative, and (pathname-directory default-pathname) is a
--- 200,204 ----
          (#p"/dir/name.supplied-type"
           ,(make-pathname :type "supplied-type")
!          #p"/dir/name.type")
          ;; If (pathname-directory pathname) is a list whose car is
          ;; :relative, and (pathname-directory default-pathname) is a
***************
*** 206,210 ****
           ;; "../" in a namestring is parsed as :up not :back, so make-pathname
           ,(make-pathname :directory '(:relative :back "blah"))
! 	 #p"/aaa/bbb/ccc/ddd/eee")
          ;; If (pathname-directory default-pathname) is not a list or
          ;; (pathname-directory pathname) is not a list whose car is
--- 211,215 ----
           ;; "../" in a namestring is parsed as :up not :back, so make-pathname
           ,(make-pathname :directory '(:relative :back "blah"))
!          #p"/aaa/bbb/ccc/ddd/eee")
          ;; If (pathname-directory default-pathname) is not a list or
          ;; (pathname-directory pathname) is not a list whose car is
***************
*** 213,221 ****
          (#P"/absolute/path/name.type"
           #p"/absolute/path/name"
! 	 #p"/dir/default-name.type")
          ;; === logical pathnames ===
          ;; recognizes a logical pathname namestring when
          ;; default-pathname is a logical pathname
! 	;; FIXME: 0.6.12.23 fails this one.
          #+nil (#P"scratch:foo;name1" #p"name1" #p"scratch:foo;")
          ;; or when the namestring begins with the name of a defined
--- 218,234 ----
          (#P"/absolute/path/name.type"
           #p"/absolute/path/name"
!          #p"/dir/default-name.type")
          ;; === logical pathnames ===
          ;; recognizes a logical pathname namestring when
          ;; default-pathname is a logical pathname
!         ;; FIXME: 0.6.12.23 fails this one.
! 	;;
! 	;; And, as it happens, it's right to fail it. Because
! 	;; #p"name1" is read in with the ambient *d-p-d* value, which
! 	;; has a physical (Unix) host; therefore, the host of the
! 	;; default-pathname argument to merge-pathnames is
! 	;; irrelevant. The result is (correctly) different if
! 	;; '#p"name1"' is replaced by "name1", below, though it's
! 	;; still not what one might expect... -- CSR, 2002-05-09
          #+nil (#P"scratch:foo;name1" #p"name1" #p"scratch:foo;")
          ;; or when the namestring begins with the name of a defined
***************
*** 251,254 ****
--- 264,278 ----
        do (assert (string= (namestring (apply #'merge-pathnames params))
                            (namestring expected-result))))
+ 
+ ;;; host-namestring testing
+ (assert (string=
+ 	 (namestring (parse-namestring "/foo" (host-namestring #p"/bar")))
+ 	 "/foo"))
+ (assert (string=
+ 	 (namestring (parse-namestring "FOO" (host-namestring #p"SCRATCH:BAR")))
+ 	 "SCRATCH:FOO"))
+ (assert (raises-error?
+ 	 (setf (logical-pathname-translations "")
+ 	       (list '("**;*.*.*" "/**/*.*")))))
  
  ;;;; success

Index: print.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/print.impure.lisp,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** print.impure.lisp	12 Mar 2002 15:47:54 -0000	1.7
--- print.impure.lisp	10 May 2002 10:48:35 -0000	1.8
***************
*** 86,89 ****
--- 86,95 ----
  (assert (string= (format nil "~/cl-user::print-foo:print-foo/" 2) "2"))
  
+ ;;; Check for error detection of illegal directives in a~<..~> justify
+ ;;; block (see ANSI section 22.3.5.2)
+ (assert (raises-error? (format nil "~<~W~>" 'foo)))
+ (assert (raises-error? (format nil "~<~<~A~:>~>" '(foo))))
+ (assert (string= (format nil "~<~<~A~>~>" 'foo) "FOO"))
+ 
  ;;; success
  (quit :unix-status 104)