diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp index ec37fd46134041781b1e3c0b4343204110f2187a..c2e1a83f5ca94c7e13755da022e5950f2501f976 100644 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -2033,41 +2033,6 @@ (list (- limit)) limit) :high (list limit)))))) -#| Test cases -(floor-quotient-bound (make-interval :low 0.3 :high 10.3)) -=> #S(INTERVAL :LOW 0 :HIGH 10) -(floor-quotient-bound (make-interval :low 0.3 :high '(10.3))) -=> #S(INTERVAL :LOW 0 :HIGH 10) -(floor-quotient-bound (make-interval :low 0.3 :high 10)) -=> #S(INTERVAL :LOW 0 :HIGH 10) -(floor-quotient-bound (make-interval :low 0.3 :high '(10))) -=> #S(INTERVAL :LOW 0 :HIGH 9) -(floor-quotient-bound (make-interval :low '(0.3) :high 10.3)) -=> #S(INTERVAL :LOW 0 :HIGH 10) -(floor-quotient-bound (make-interval :low '(0.0) :high 10.3)) -=> #S(INTERVAL :LOW 0 :HIGH 10) -(floor-quotient-bound (make-interval :low '(-1.3) :high 10.3)) -=> #S(INTERVAL :LOW -2 :HIGH 10) -(floor-quotient-bound (make-interval :low '(-1.0) :high 10.3)) -=> #S(INTERVAL :LOW -1 :HIGH 10) -(floor-quotient-bound (make-interval :low -1.0 :high 10.3)) -=> #S(INTERVAL :LOW -1 :HIGH 10) - - -(floor-rem-bound (make-interval :low 0.3 :high 10.3)) -=> #S(INTERVAL :LOW 0 :HIGH '(10.3)) -(floor-rem-bound (make-interval :low 0.3 :high '(10.3))) -=> #S(INTERVAL :LOW 0 :HIGH '(10.3)) -(floor-rem-bound (make-interval :low -10 :high -2.3)) -#S(INTERVAL :LOW (-10) :HIGH 0) -(floor-rem-bound (make-interval :low 0.3 :high 10)) -=> #S(INTERVAL :LOW 0 :HIGH '(10)) -(floor-rem-bound (make-interval :low '(-1.3) :high 10.3)) -=> #S(INTERVAL :LOW '(-10.3) :HIGH '(10.3)) -(floor-rem-bound (make-interval :low '(-20.3) :high 10.3)) -=> #S(INTERVAL :LOW (-20.3) :HIGH (20.3)) -|# - ;;; Same functions for CEILING (defun ceiling-quotient-bound (quot) @@ -2133,45 +2098,7 @@ limit) :high (list limit)))))) -#| Test cases -(ceiling-quotient-bound (make-interval :low 0.3 :high 10.3)) -=> #S(INTERVAL :LOW 1 :HIGH 11) -(ceiling-quotient-bound (make-interval :low 0.3 :high '(10.3))) -=> #S(INTERVAL :LOW 1 :HIGH 11) -(ceiling-quotient-bound (make-interval :low 0.3 :high 10)) -=> #S(INTERVAL :LOW 1 :HIGH 10) -(ceiling-quotient-bound (make-interval :low 0.3 :high '(10))) -=> #S(INTERVAL :LOW 1 :HIGH 10) -(ceiling-quotient-bound (make-interval :low '(0.3) :high 10.3)) -=> #S(INTERVAL :LOW 1 :HIGH 11) -(ceiling-quotient-bound (make-interval :low '(0.0) :high 10.3)) -=> #S(INTERVAL :LOW 1 :HIGH 11) -(ceiling-quotient-bound (make-interval :low '(-1.3) :high 10.3)) -=> #S(INTERVAL :LOW -1 :HIGH 11) -(ceiling-quotient-bound (make-interval :low '(-1.0) :high 10.3)) -=> #S(INTERVAL :LOW 0 :HIGH 11) -(ceiling-quotient-bound (make-interval :low -1.0 :high 10.3)) -=> #S(INTERVAL :LOW -1 :HIGH 11) - - -(ceiling-rem-bound (make-interval :low 0.3 :high 10.3)) -=> #S(INTERVAL :LOW (-10.3) :HIGH 0) -(ceiling-rem-bound (make-interval :low 0.3 :high '(10.3))) -=> #S(INTERVAL :LOW 0 :HIGH '(10.3)) -(ceiling-rem-bound (make-interval :low -10 :high -2.3)) -=> #S(INTERVAL :LOW 0 :HIGH (10)) -(ceiling-rem-bound (make-interval :low 0.3 :high 10)) -=> #S(INTERVAL :LOW (-10) :HIGH 0) -(ceiling-rem-bound (make-interval :low '(-1.3) :high 10.3)) -=> #S(INTERVAL :LOW (-10.3) :HIGH (10.3)) -(ceiling-rem-bound (make-interval :low '(-20.3) :high 10.3)) -=> #S(INTERVAL :LOW (-20.3) :HIGH (20.3)) -|# - - - - (defun truncate-quotient-bound (quot) ;; For positive quotients, truncate is exactly like floor. For ;; negative quotients, truncate is exactly like ceiling. Otherwise, diff --git a/tests/srctran.lisp b/tests/srctran.lisp new file mode 100644 index 0000000000000000000000000000000000000000..f88e977126ecf2a58224d72c47a69562f99476de --- /dev/null +++ b/tests/srctran.lisp @@ -0,0 +1,82 @@ +;; Tests for various source transformations. + +(defpackage :srctran-tests + (:use :cl :lisp-unit)) + +(in-package "SRCTRAN-TESTS") + +(define-test floor-quotient-bound + "Test the first value of FLOOR returns the correct interval" + (assert-equalp (c::make-interval :low 0 :high 10) + (c::floor-quotient-bound + (c::make-interval :low 0.3 :high 10.3))) + (assert-equalp (c::make-interval :LOW 0 :HIGH 10) + (c::floor-quotient-bound + (c::make-interval :low 0.3 :high '(10.3)))) + (assert-equalp (c::make-interval :LOW 0 :HIGH 10) + (c::floor-quotient-bound (c::make-interval :low 0.3 :high 10))) + (assert-equalp (c::make-interval :LOW 0 :HIGH 9) + (c::floor-quotient-bound (c::make-interval :low 0.3 :high '(10)))) + (assert-equalp (c::make-interval :LOW 0 :HIGH 9) + (c::floor-quotient-bound (c::make-interval :low 0.3 :high '(10)))) + (assert-equalp (c::make-interval :LOW 0 :HIGH 10) + (c::floor-quotient-bound (c::make-interval :low '(0.3) :high 10.3))) + (assert-equalp (c::make-interval :LOW 0 :HIGH 10) + (c::floor-quotient-bound (c::make-interval :low '(0.0) :high 10.3))) + (assert-equalp (c::make-interval :LOW -2 :HIGH 10) + (c::floor-quotient-bound (c::make-interval :low '(-1.3) :high 10.3))) + (assert-equalp (c::make-interval :LOW -1 :HIGH 10) + (c::floor-quotient-bound (c::make-interval :low '(-1.0) :high 10.3))) + (assert-equalp (c::make-interval :LOW -1 :HIGH 10) + (c::floor-quotient-bound (c::make-interval :low -1.0 :high 10.3)))) + +(define-test floor-rem-bound + "Test the second value of FLOOR returns the correct interval" + (assert-equalp (c::make-interval :low 0 :high '(10.3)) + (c::floor-rem-bound (c::make-interval :low 0.3 :high 10.3))) + (assert-equalp (c::make-interval :low 0 :high '(10.3)) + (c::floor-rem-bound (c::make-interval :low 0.3 :high '(10.3)))) + (assert-equalp (c::make-interval :low '(-10) :high 0) + (c::floor-rem-bound (c::make-interval :low -10 :high -2.3))) + (assert-equalp (c::make-interval :low 0 :high '(10)) + (c::floor-rem-bound (c::make-interval :low 0.3 :high 10))) + (assert-equalp (c::make-interval :low '(-10.3) :high '(10.3)) + (c::floor-rem-bound (c::make-interval :low '(-1.3) :high 10.3))) + (assert-equalp (c::make-interval :low '(-20.3) :high '(20.3)) + (c::floor-rem-bound (c::make-interval :low '(-20.3) :high 10.3)))) + +(define-test ceiling-quotient-bound + "Test the first value of CEILING returns the correct interval" + (assert-equalp (c::make-interval :low 1 :high 11) + (c::ceiling-quotient-bound (c::make-interval :low 0.3 :high 10.3))) + (assert-equalp (c::make-interval :low 1 :high 11) + (c::ceiling-quotient-bound (c::make-interval :low 0.3 :high '(10.3)))) + (assert-equalp (c::make-interval :low 1 :high 10) + (c::ceiling-quotient-bound (c::make-interval :low 0.3 :high 10))) + (assert-equalp (c::make-interval :low 1 :high 10) + (c::ceiling-quotient-bound (c::make-interval :low 0.3 :high '(10)))) + (assert-equalp (c::make-interval :low 1 :high 11) + (c::ceiling-quotient-bound (c::make-interval :low '(0.3) :high 10.3))) + (assert-equalp (c::make-interval :low 1 :high 11) + (c::ceiling-quotient-bound (c::make-interval :low '(0.0) :high 10.3))) + (assert-equalp (c::make-interval :low -1 :high 11) + (c::ceiling-quotient-bound (c::make-interval :low '(-1.3) :high 10.3))) + (assert-equalp (c::make-interval :low 0 :high 11) + (c::ceiling-quotient-bound (c::make-interval :low '(-1.0) :high 10.3))) + (assert-equalp (c::make-interval :low -1 :high 11) + (c::ceiling-quotient-bound (c::make-interval :low -1.0 :high 10.3)))) + +(define-test ceiling-rem-bound + "Test the second value of CEILING returns the correct interval" + (assert-equalp (c::make-interval :low '(-10.3) :high 0) + (c::ceiling-rem-bound (c::make-interval :low 0.3 :high 10.3))) + (assert-equalp (c::make-interval :low '(-10.3) :high 0) + (c::ceiling-rem-bound (c::make-interval :low 0.3 :high '(10.3)))) + (assert-equalp (c::make-interval :low 0 :high '(10)) + (c::ceiling-rem-bound (c::make-interval :low -10 :high -2.3))) + (assert-equalp (c::make-interval :low '(-10) :high 0) + (c::ceiling-rem-bound (c::make-interval :low 0.3 :high 10))) + (assert-equalp (c::make-interval :low '(-10.3) :high '(10.3)) + (c::ceiling-rem-bound (c::make-interval :low '(-1.3) :high 10.3))) + (assert-equalp (c::make-interval :low '(-20.3) :high '(20.3)) + (c::ceiling-rem-bound (c::make-interval :low '(-20.3) :high 10.3))))