From: Alexey D. <ade...@us...> - 2004-05-09 17:12:26
|
Update of /cvsroot/sbcl/sbcl/tests In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv22935/tests Modified Files: compiler.pure.lisp pprint.impure.lisp print.impure.lisp Log Message: 0.8.10.15: * Fix bug MISC.110A: pathwise CAST remover forgot to mark LVARs for reoptimization; * merge patch by Nikodemus Siivola: SET-PPRINT-DISPATCH does not immediately resolves function names; * fix bug reported by Thomas F. Burdick: compile-time format string checker failed when ~{ did not have the corresponding ~}. Index: compiler.pure.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/tests/compiler.pure.lisp,v retrieving revision 1.92 retrieving revision 1.93 diff -u -d -r1.92 -r1.93 --- compiler.pure.lisp 6 May 2004 16:35:43 -0000 1.92 +++ compiler.pure.lisp 9 May 2004 17:12:15 -0000 1.93 @@ -1329,3 +1329,21 @@ (debug 3) (compilation-speed 3))) (flet ((%f () (multiple-value-prog1 0 (return-from %f 0)))) (complex (%f) 0))))))) + +;;; MISC.110A: CAST optimizer forgot to flush LVAR derived type +(assert (zerop (funcall + (compile + nil + '(lambda (a c) + (declare (type (integer -1294746569 1640996137) a)) + (declare (type (integer -807801310 3) c)) + (declare (optimize (speed 3) (space 3) (safety 0) (debug 0) (compilation-speed 3))) + (catch 'ct7 + (if + (logbitp 0 + (if (/= 0 a) + c + (ignore-errors + (progn (if (ldb-test (byte 0 0) (rational (throw 'ct7 0))) 0 0) 0)))) + 0 0)))) + 391833530 -32785211))) Index: pprint.impure.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/tests/pprint.impure.lisp,v retrieving revision 1.5 retrieving revision 1.6 diff -u -d -r1.5 -r1.6 --- pprint.impure.lisp 4 Feb 2004 21:16:24 -0000 1.5 +++ pprint.impure.lisp 9 May 2004 17:12:15 -0000 1.6 @@ -136,10 +136,11 @@ (write '`(lambda (,x)) :stream s :pretty t :readably t)) "`(LAMBDA (,X))")) -;;; SET-PPRINT-DISPATCH should accept function name arguments +;;; SET-PPRINT-DISPATCH should accept function name arguments, and not +;;; rush to coerce them to functions. +(set-pprint-dispatch '(cons (eql frob)) 'ppd-function-name) (defun ppd-function-name (s o) (print (length o) s)) -(set-pprint-dispatch '(cons (eql frob)) 'ppd-function-name) (let ((s (with-output-to-string (s) (pprint '(frob a b) s)))) (assert (position #\3 s))) Index: print.impure.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/tests/print.impure.lisp,v retrieving revision 1.17 retrieving revision 1.18 diff -u -d -r1.17 -r1.18 --- print.impure.lisp 4 May 2004 11:08:12 -0000 1.17 +++ print.impure.lisp 9 May 2004 17:12:15 -0000 1.18 @@ -213,5 +213,12 @@ (let ((answer (write-to-string '(bar foo :boo 1) :pretty t :escape t))) (assert (string= answer "(?BAR? ?FOO? ?:BOO? ?1?)"))))) +;;; FORMAT string compile-time checker failure, reported by Thomas +;;; F. Burdick +(multiple-value-bind (f w-p f-p) + (compile nil '(lambda () (format nil "~{"))) + (assert (and w-p f-p)) + (assert (nth-value 1 (ignore-errors (funcall f))))) + ;;; success (quit :unix-status 104) |