From: Nikodemus S. <de...@us...> - 2006-02-27 13:12:44
|
Update of /cvsroot/sbcl/sbcl/tests In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv2812/tests Modified Files: compiler.pure.lisp eval.impure.lisp Log Message: 0.9.10.4: better CONSTANTP * Recognizes constant argument calls to foldable functions and also deals with some simple special forms like. * Replace a ton of EVAL calls with CONSTANT-FORM-VALUE. Index: compiler.pure.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/tests/compiler.pure.lisp,v retrieving revision 1.135 retrieving revision 1.136 diff -u -d -r1.135 -r1.136 --- compiler.pure.lisp 9 Feb 2006 10:09:18 -0000 1.135 +++ compiler.pure.lisp 27 Feb 2006 13:12:35 -0000 1.136 @@ -1977,3 +1977,5 @@ (declare (optimize (safety 3) (space 3) (compilation-speed 3) (speed 0) (debug 1))) (not (not (logbitp 0 (floor 2147483651 (min -23 0)))))))))) + + Index: eval.impure.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/tests/eval.impure.lisp,v retrieving revision 1.10 retrieving revision 1.11 diff -u -d -r1.10 -r1.11 --- eval.impure.lisp 26 Aug 2005 21:09:04 -0000 1.10 +++ eval.impure.lisp 27 Feb 2006 13:12:35 -0000 1.11 @@ -100,6 +100,46 @@ (assert (constantp (find-class 'symbol))) (assert (constantp #p"")) +;;; More CONSTANTP tests +;;; form constantp sb-int:constant-form-value +(dolist (test '((t t t) + (x nil) + ('x t x) + (:keyword t :keyword) + (42 t 42) + ((if t :ok x) t :ok) + ((if t x :no) nil) + ((progn + (error "oops") + t) nil) + ((progn 1 2 3) t 3) + ((block foo :good) t :good) + ((block foo + (return-from foo t)) nil) + ((progv + (list (gensym)) + '(1) + (+ 1)) nil) + ((progv + '(x) + (list (random 2)) + x) nil) + ((progv + '(x) + '(1) + (1+ x)) t 2) + ((unwind-protect 1 nil) t 1) + ((unwind-protect 1 + (xxx)) nil) + ((the integer 1) t 1) + ((the integer (+ 1 1)) t 2) + ((the integer (foo)) nil) + ((+ 1 2) t 3))) + (destructuring-bind (form c &optional v) test + (assert (eql (constantp form) c)) + (when c + (assert (eql v (sb-int:constant-form-value form)))))) + ;;; DEFPARAMETER must assign a dynamic variable (let ((var (gensym))) (assert (equal (eval `(list (let ((,var 1)) |