(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)))))
+
+;;;; ATOMIC-INCF (we should probably rename this file atomic-ops...)
+
+(defstruct box
+ (word 0 :type sb-vm:word))
+
+(defun inc-box (box n)
+ (declare (fixnum n) (box box))
+ (loop repeat n
+ do (sb-ext:atomic-incf (box-word box))))
+
+(defun dec-box (box n)
+ (declare (fixnum n) (box box))
+ (loop repeat n
+ do (sb-ext:atomic-incf (box-word box) -1)))
+
+(let ((box (make-box)))
+ (inc-box box 10000)
+ (assert (= 10000 (box-word box)))
+ (dec-box box 10000)
+ (assert (= 0 (box-word box))))
+
+#+sb-thread
+(let* ((box (make-box))
+ (threads (loop repeat 64
+ collect (sb-thread:make-thread (lambda ()
+ (inc-box box 1000)
+ (dec-box box 10000)
+ (inc-box box 10000)
+ (dec-box box 1000))
+ :name "inc/dec thread"))))
+ (mapc #'sb-thread:join-thread threads)
+ (assert (= 0 (box-word box))))