Update of /cvsroot/sbcl/sbcl/tests
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv3923/tests
Modified Files:
compiler.impure.lisp
Log Message:
1.0.17.31: more constant cleverness
* Make MAYBE-EMIT-MAKE-LOAD-FORM can dump _all_ references to
non-trivial named constants using the name (well, not FP constants
for SBCL itself.)
This means that after (DEFCONSTANT +FOO+ "FOO") all references to
+FOO+ are EQ, even in different files.
...some people are going to use this as an unportable performance
hack, and their code will break horribly sooner or later, but more
importantly we need to grovel less things, and more sharing means
less memory use and better cache behaviour.
* Tests.
Index: compiler.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/compiler.impure.lisp,v
retrieving revision 1.90
retrieving revision 1.91
diff -u -d -r1.90 -r1.91
--- compiler.impure.lisp 5 Jun 2008 16:32:37 -0000 1.90
+++ compiler.impure.lisp 6 Jun 2008 12:00:25 -0000 1.91
@@ -1628,8 +1628,8 @@
(defvar *sneaky-nested-thing* (list (make-instance 'some-constant-thing)))
(defconstant +sneaky-nested-thing+ *sneaky-nested-thing*)
(multiple-value-bind (file-fun core-fun) (compile2 '(lambda () +sneaky-nested-thing+))
- (assert (eq *sneaky-nested-thing* (funcall file-fun)))
- (assert (eq *sneaky-nested-thing* (funcall core-fun))))
+ (assert (equal *sneaky-nested-thing* (funcall file-fun)))
+ (assert (equal *sneaky-nested-thing* (funcall core-fun))))
;;; catch constant modifications thru undefined variables
(defun sneak-set-dont-set-me (x)
@@ -1643,4 +1643,30 @@
(assert (not (sneak-set-dont-set-me2 13)))
(assert (typep dont-set-me2 'some-constant-thing))
+;;; check that non-trivial constants are EQ across different files: this is
+;;; not something ANSI either guarantees or requires, but we want to do it
+;;; anyways.
+(defconstant +share-me-1+ 123.456d0)
+(defconstant +share-me-2+ "a string to share")
+(defconstant +share-me-3+ (vector 1 2 3))
+(defconstant +share-me-4+ (* 2 most-positive-fixnum))
+(multiple-value-bind (f1 c1) (compile2 '(lambda () (values +share-me-1+
+ +share-me-2+
+ +share-me-3+
+ +share-me-4+
+ pi)))
+ (multiple-value-bind (f2 c2) (compile2 '(lambda () (values +share-me-1+
+ +share-me-2+
+ +share-me-3+
+ +share-me-4+
+ pi)))
+ (flet ((test (fa fb)
+ (mapc (lambda (a b)
+ (assert (eq a b)))
+ (multiple-value-list (funcall fa))
+ (multiple-value-list (funcall fb)))))
+ (test f1 c1)
+ (test f1 f2)
+ (test f1 c2))))
+
;;; success
|