From: Christophe R. <cr...@us...> - 2002-05-10 10:48:38
|
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) |