Update of /cvsroot/sbcl/sbcl/tests
In directory vz-cvs-3.sog:/tmp/cvs-serv5440/tests
Modified Files:
compiler.pure.lisp
Log Message:
1.0.47.13: extend LVAR-FUN-IS to constant functions and function names
Allows optizing eg. (MEMBER X Y :TEST 'EQ) unlike the previous one.
Additionally make the code work like the comment says, and return
true only if the function is not NOTINLINE.
Index: compiler.pure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/compiler.pure.lisp,v
retrieving revision 1.250
retrieving revision 1.251
diff -u -d -r1.250 -r1.251
--- compiler.pure.lisp 7 Apr 2011 12:53:33 -0000 1.250
+++ compiler.pure.lisp 7 Apr 2011 13:02:02 -0000 1.251
@@ -3791,3 +3791,25 @@
(f (mod a e))))
s)))
(g a)))))
+
+;;; This doesn't test LVAR-FUN-IS directly, but captures it
+;;; pretty accurately anyways.
+(with-test (:name :lvar-fun-is)
+ (dolist (fun (list
+ (lambda (x) (member x x :test #'eq))
+ (lambda (x) (member x x :test 'eq))
+ (lambda (x) (member x x :test #.#'eq))))
+ (assert (equal (list #'sb-kernel:%member-eq)
+ (ctu:find-named-callees fun))))
+ (dolist (fun (list
+ (lambda (x)
+ (declare (notinline eq))
+ (member x x :test #'eq))
+ (lambda (x)
+ (declare (notinline eq))
+ (member x x :test 'eq))
+ (lambda (x)
+ (declare (notinline eq))
+ (member x x :test #.#'eq))))
+ (assert (member #'sb-kernel:%member-test
+ (ctu:find-named-callees fun)))))
|