+
+;; 1.0 had a broken ATANH on win32
+(with-test (:name :atanh)
+ (assert (= (atanh 0.9d0) 1.4722194895832204d0)))
+
+;; Test some cases of integer operations with constant arguments
+(with-test (:name :constant-integers)
+ (labels ((test-forms (op x y header &rest forms)
+ (let ((val (funcall op x y)))
+ (dolist (form forms)
+ (let ((new-val (funcall (compile nil (append header form)) x y)))
+ (unless (eql val new-val)
+ (error "~S /= ~S: ~S ~S ~S~%" val new-val (append header form) x y))))))
+ (test-case (op x y type)
+ (test-forms op x y `(lambda (x y &aux z)
+ (declare (type ,type x y)
+ (ignorable x y z)
+ (notinline identity)
+ (optimize speed (safety 0))))
+ `((,op x ,y))
+ `((setf z (,op x ,y))
+ (identity x)
+ z)
+ `((values (,op x ,y) x))
+ `((,op ,x y))
+ `((setf z (,op ,x y))
+ (identity y)
+ z)
+ `((values (,op ,x y) y))
+
+ `((identity x)
+ (,op x ,y))
+ `((identity x)
+ (setf z (,op x ,y))
+ (identity x)
+ z)
+ `((identity x)
+ (values (,op x ,y) x))
+ `((identity y)
+ (,op ,x y))
+ `((identity y)
+ (setf z (,op ,x y))
+ (identity y)
+ z)
+ `((identity y)
+ (values (,op ,x y) y))))
+ (test-op (op)
+ (let ((ub `(unsigned-byte ,sb-vm:n-word-bits))
+ (sb `(signed-byte ,sb-vm:n-word-bits)))
+ (loop for (x y type) in `((2 1 fixnum)
+ (2 1 ,ub)
+ (2 1 ,sb)
+ (,(1+ (ash 1 28)) ,(1- (ash 1 28)) fixnum)
+ (,(+ 3 (ash 1 30)) ,(+ 2 (ash 1 30)) ,ub)
+ (,(- -2 (ash 1 29)) ,(- 3 (ash 1 29)) ,sb)
+ ,@(when (> sb-vm:n-word-bits 32)
+ `((,(1+ (ash 1 29)) ,(1- (ash 1 29)) fixnum)
+ (,(1+ (ash 1 31)) ,(1- (ash 1 31)) ,ub)
+ (,(- -2 (ash 1 31)) ,(- 3 (ash 1 30)) ,sb)
+ (,(ash 1 40) ,(ash 1 39) fixnum)
+ (,(ash 1 40) ,(ash 1 39) ,ub)
+ (,(ash 1 40) ,(ash 1 39) ,sb))))
+ do
+ (test-case op x y type)
+ (test-case op x x type)))))
+ (mapc #'test-op '(+ - * truncate
+ < <= = >= >
+ eql
+ eq))))