;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Aug 31 11:15:14 2003
;;;; Contains: Tests of the - function





(deftest minus.error.1
  (signals-error (-) program-error)
  t)

;;; Unary minus tests
(deftest minus.1
  (loop for x in *numbers*
        unless (eql (- (- x)) x)
        collect x)
  nil)

(deftest minus.2
  (locally
   (declare (notinline -))
   (loop for x in *numbers*
         unless (eql (- (- x)) x)
         collect x))
  nil)

(deftest minus.3
  (loop for x in *reals*
        when (and (integerp x)
                  (not (eql (- x) (- 0 x))))
        collect x)
  nil)

(deftest minus.4
  (loop for x in *reals*
        for neg = (- x)
        when (and (floatp x)
                  (not (zerop x))
                  (not (eql neg (- 0.0s0 x)))
                  (eql (float 1.0s0 x)
                       (float 1.0s0 neg)))
        collect x)
  nil)

(deftest minus.5
  (loop for x in *numbers*
        when (and (complexp x)
                  (rationalp (realpart x))
                  (not (eql (- x) (- 0 x))))
        collect x)
  nil)

(deftest minus.6
  (loop for x in *numbers*
        for neg = (- x)
        when (and (complexp x)
                  (floatp (realpart x))
                  (eql (float 1.0s0 (realpart x))
                       (float 1.0s0 (realpart neg)))
                  (or (/= neg (- 0 x))
                      (and (not (zerop (realpart x)))
                           (not (eqlzt neg (- 0 x))))))
        collect x)
  nil)

(deftest minus.7
  (let ((upper-bound most-positive-fixnum)
        (lower-bound most-negative-fixnum))
    (loop
     for x = (+ (random (- upper-bound lower-bound)) lower-bound)
     for neg = (- x)
     repeat 1000
     unless (and (integerp neg)
                 (eql (abs x) (abs neg))
                 (if (> x 0) (< neg 0) (>= neg 0))
                 (zerop (+ x neg))
                 (eql x (- neg)))
     collect x))
  nil)

(deftest minus.8
  (let ((upper-bound (ash 1 1000))
        (lower-bound (- (ash 1 1000))))
    (loop
     for x = (+ (random (- upper-bound lower-bound)) lower-bound)
     for neg = (- x)
     repeat 1000
     unless (and (integerp neg)
                 (eql (abs x) (abs neg))
                 (if (> x 0) (< neg 0) (>= neg 0))
                 (zerop (+ x neg))
                 (eql x (- neg)))
     collect x))
  nil)

;;; Test that explicit calls to macroexpand in subforms
;;; are done in the correct environment

(deftest minus.9
  (macrolet ((%m (z) z)) (- (expand-in-current-env (%m 1))))
  -1)

;;; Binary minus tests

(deftest subtract.1
  (loop
   for x = (random-fixnum)
   for y = (random-fixnum)
   repeat 1000
   unless (and (eql (+ x (- y)) (- x y))
               (eql (+ 1 x (- y)) (- x (1- y)))
               (eql (+ -1 x (- y)) (- x (1+ y))))
   collect (list x y))
  nil)

(deftest subtract.2
  (let ((bound (ash 1 1000)))
    (loop
     for x = (random-from-interval bound (- bound))
     for y = (random-from-interval bound (- bound))
     repeat 1000
     unless  (and (eql (+ x (- y)) (- x y))
               (eql (+ 1 x (- y)) (- x (1- y)))
               (eql (+ -1 x (- y)) (- x (1+ y))))
     collect (list x y)))
  nil)

(deftest subtract.3
  (let ((args nil))
    (loop for i from 1 below (min 256 (1- call-arguments-limit))
          do (push 1 args)
          always (eql (apply #'- 1000 args) (- 1000 i))))
  t)

;;; Float contagion

(deftest subtract.4
  (loop
   for type1 in '(short-float single-float double-float long-float)
   for bits1 in '(13 24 50 50)
   for bound1 = (ash 1 (- bits1 2))
   for c1 from 1
   nconc
   (loop for type2 in '(short-float single-float double-float long-float)
         for bits2 in '(13 24 50 50)
         for bound2 = (ash 1 (- bits2 2))
         for c2 from 1
         nconc
         (loop
          for i = (random-from-interval bound1)
          for x = (coerce i type1)
          for j = (random-from-interval bound2)
          for y = (coerce j type2)
          for idiff1 = (- i j)
          for idiff2 = (- j i)
          for diff1 = (- x y)
          for diff2 = (- y x)
          repeat 1000
          unless (or (zerop idiff1)
                     (and (eql idiff1 (- idiff2))
                          (eql diff1 (- diff2))
                          (if (<= c1 c2)
                              (eql (float diff1 y) diff1)
                            (eql (float diff1 x) diff1))
                          (eql (float idiff1 diff1) diff1)))
          collect (list i x j y idiff1 idiff2 diff1 diff2))))
  nil)

;;; Complex subtraction

(deftest subtract.5
  (loop for i = (random-fixnum)
        for ci = (complex i (+ i 100))
        for j = (random-fixnum)
        for cj = (complex j (- j 200))
        for diff = (- ci cj)
        repeat 1000
        unless (eql diff (complex (- i j) (+ (- i j) 300)))
        collect (list i ci j cj (- ci cj)))
  nil)

;;; Test that explicit calls to macroexpand in subforms
;;; are done in the correct environment

(deftest subtract.6
  (macrolet ((%m (z) z))
            (values
             (- (expand-in-current-env (%m 2)) 1)
             (- 17 (expand-in-current-env (%m 5)))
             (- 1/2 (expand-in-current-env (%m 1/6))
                (expand-in-current-env (%m 0)))))
  1 12 1/3)