From: Nikodemus S. <de...@us...> - 2008-09-17 13:24:25
|
Update of /cvsroot/sbcl/sbcl/tests In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv4026/tests Modified Files: compare-and-swap.impure.lisp Log Message: 1.0.20.7: COMPARE-AND-SWAP on SYMBOL-VALUE to respect constants and declaimed types * For constant symbol names which are declaimed SPECIAL, insert the appropriate THE around the new value. * For other cases use ABOUT-TO-MODIFY-SYMBOL-VALUE. * Tests. Index: compare-and-swap.impure.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/tests/compare-and-swap.impure.lisp,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- compare-and-swap.impure.lisp 15 Jul 2007 22:28:13 -0000 1.1 +++ compare-and-swap.impure.lisp 17 Sep 2008 20:24:22 -0000 1.2 @@ -75,3 +75,32 @@ (ignore-errors (compare-and-swap (svref "foo" 1) 1 2)) (assert (not res)) (assert (typep err 'type-error))) + +;; Check that we don't modify constants +(defconstant +a-constant+ 42) +(assert + (eq :error + (handler-case + (sb-ext:compare-and-swap (symbol-value '+a-constant+) 42 13) + (error () :error)))) +(let ((name '+a-constant+)) + (assert + (eq :error + (handler-case + (sb-ext:compare-and-swap (symbol-value name) 42 13) + (error () :error))))) + +;; Check that we don't mess declaimed types +(declaim (boolean *a-boolean*)) +(defparameter *a-boolean* t) +(assert + (eq :error + (handler-case + (sb-ext:compare-and-swap (symbol-value '*a-boolean*) t 42) + (error () :error)))) +(let ((name '*a-boolean*)) + (assert + (eq :error + (handler-case + (sb-ext:compare-and-swap (symbol-value name) t 42) + (error () :error))))) |