This is the mail archive of the
guile@sourceware.cygnus.com
mailing list for the Guile project.
latest test-suite/tests/numbers.test
- To: guile at sourceware dot cygnus dot com
- Subject: latest test-suite/tests/numbers.test
- From: thi <ttn at revel dot glug dot org>
- Date: Fri, 24 Mar 2000 19:55:10 -0800
- Reply-to: ttn at glug dot org
even though this still could use some work, i'm posting it because i
have to go do other stuff... :-/
thi
------------------------------------
;;;; numbers.test --- test suite for Guile's numerical ops -*- scheme -*-
;;;;
;;;; Copyright (C) 2000 Free Software Foundation, Inc.
;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2, or (at your option)
;;;; any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this software; see the file COPYING. If not, write to
;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
;;;; Boston, MA 02111-1307 USA
;;;; Commentary:
;;; This file contains tests for numerical operations outside those (54)
;;; defined in R4RS and R5RS, listed here for reference:
;;;
;;; * + - / < <= = > >= abs acos angle asin atan ceiling complex? cos
;;; denominator even? exact->inexact exact? exp expt floor gcd imag-part
;;; inexact->exact inexact? integer? lcm log magnitude make-polar
;;; make-rectangular max min modulo negative? number? numerator odd?
;;; positive? quotient rational? rationalize real-part real? remainder
;;; round sin sqrt tan truncate zero?
;;;
;;; R?RS operations should be placed in the appropriate r?rs.test file.
;;;
;;; Currently, non-R?RS operations include:
;;;
;;; logand logior logxor logtest logbit? lognot integer-expt ash
;;; bit-extract logcount integer-length number->string string->number
;;; asinh acosh atanh
;;;; Code:
(use-modules (test-suite lib))
(defmacro pass-if-pred (pred x y)
`(let ((test '(,pred ,x ,y)))
(pass-if (with-output-to-string (lambda () (write test)))
(eval test))))
(defmacro pass-if-= (x y) `(pass-if-pred = ,x ,y))
(defmacro pass-if-string= (x y) `(pass-if-pred string=? ,x ,y))
(defmacro pass-if-equal? (x y) `(pass-if-pred equal? ,x ,y))
(defmacro check-bx (sig bit expected) ; snarfed from THUD
`(pass-if-= ,expected (bit-extract ,sig ,bit (+ 1 ,bit))))
(define (check-Bx sig bit len expected) ; snarfed from THUD
`(pass-if-= ,expected (bit-extract ,sig ,bit (+ ,bit ,len))))
;;
;; Tests
;;
(with-test-prefix "logand"
(pass-if-= 0 (logand 0 0))
(pass-if-= #b10001 (logand #b11111 #b10001))
(pass-if-= #b10001 (logand #b10001 #b11111))
(pass-if-= 65552 (logand #b10010010100010111 #b10000101011111000))
;; Add tests here.
)
(with-test-prefix "logior"
(pass-if-= #b1100001101011010 (logior #b1000001001001000 #b0100000100010010))
;; Add tests here.
)
(with-test-prefix "logxor"
(pass-if-= #b101101101 (logxor #b111111111 #b010010010))
;; Add tests here.
)
(with-test-prefix "logtest"
(pass-if-equal? #t (logtest #b101 #b100))
(pass-if-equal? #t (logtest #b101 #b001))
(pass-if-equal? #f (logtest #b101 #b010))
(pass-if-equal? #t (logtest #b10100000 #b10000000))
(pass-if-equal? #t (logtest #b10100000 #b00100000))
(pass-if-equal? #f (logtest #b10100000 #b01000000))
;; Add tests here.
)
(with-test-prefix "logbit?"
(pass-if-equal? #t (logbit? 0 #b101))
(pass-if-equal? #f (logbit? 1 #b101))
(pass-if-equal? #t (logbit? 2 #b101))
(pass-if-equal? #t (logbit? 10 #b1010000000000))
(pass-if-equal? #f (logbit? 11 #b1010000000000))
(pass-if-equal? #t (logbit? 12 #b1010000000000))
;; Add tests here.
)
(with-test-prefix "lognot"
(pass-if-= #b10010110 (lognot #b01101001))
(pass-if-= #b10010110 (lognot (lognot #b10010110)))
;; Add tests here.
)
(with-test-prefix "integer-expt"
(pass-if-= 4096 (integer-expt 16 3))
(pass-if-= (integer-expt 27 6) (integer-expt 3 18))
;; Add tests here.
)
(with-test-prefix "ash"
;; "near FOO" means the result is "near FOO"
;; FOO is some typical power-of-2 boundary
(with-test-prefix "near 0"
(pass-if-= 2 (ash 2 0))
(pass-if-= 4 (ash 2 1))
(pass-if-= 1 (ash 2 -1))
(pass-if-= 1 (ash 1 0))
(pass-if-= 2 (ash 1 1))
(pass-if-= 0 (ash 1 -1))
(pass-if-= 0 (ash 0 0))
(pass-if-= 0 (ash 0 1))
(pass-if-= 0 (ash 0 -1))
(pass-if-= -1 (ash -1 0))
(pass-if-= -2 (ash -1 1))
(pass-if-= -1 (ash -1 -1))
(pass-if-= -2 (ash -2 0))
(pass-if-= -4 (ash -2 1))
(pass-if-= -1 (ash -2 -1))
;; Add tests here.
)
(with-test-prefix "near 16 bits"
(with-test-prefix "pos"
(pass-if-= #x10000 (ash #x1 16))
(pass-if-= #x10000 (ash #x2 15))
(pass-if-= #x10000 (ash #x10 12))
(pass-if-= #x10000 (ash #x100 8))
(pass-if-= #x10000 (ash #x1000 4))
(pass-if-= #x10000 (ash #x2000 3))
(pass-if-= #x10000 (ash #x4000 2))
(pass-if-= #x10000 (ash #x8000 1))
(pass-if-= #x10000 (ash #x10000 0))
(pass-if-= #x10000 (ash #x20000 -1))
(pass-if-= #x10000 (ash #x40000 -2))
(pass-if-= #x10000 (ash #x80000 -3))
(pass-if-= #x10000 (ash #x40000000 -14))
(pass-if-= #x10000 (ash #x80000000 -15))
(pass-if-= #x10000 (ash #x100000000 -16))
(pass-if-= #x10000 (ash #x200000000 -17))
(pass-if-= #x10000 (ash #x800000000000 -31))
(pass-if-= #x10000 (ash #x1000000000000 -32))
(pass-if-= #x10000 (ash #x2000000000000 -33))
;; Add tests here.
)
(with-test-prefix "neg"
(pass-if-= -42 (ash -42 0))
(pass-if-= -42 (ash (- #b101010) 0))
;; Add tests here.
))
(with-test-prefix "near 32 bits"
(with-test-prefix "pos"
(pass-if-= #x100000000 (ash #x10000 16))
(pass-if-= #x100000000 (ash #x20000 15))
(pass-if-= #x100000000 (ash #x100000 12))
(pass-if-= #x100000000 (ash #x1000000 8))
(pass-if-= #x100000000 (ash #x10000000 4))
(pass-if-= #x100000000 (ash #x20000000 3))
(pass-if-= #x100000000 (ash #x40000000 2))
(pass-if-= #x100000000 (ash #x80000000 1))
(pass-if-= #x100000000 (ash #x100000000 0))
(pass-if-= #x100000000 (ash #x200000000 -1))
(pass-if-= #x100000000 (ash #x400000000 -2))
(pass-if-= #x100000000 (ash #x800000000 -3))
(pass-if-= #x100000000 (ash #x400000000000 -14))
(pass-if-= #x100000000 (ash #x800000000000 -15))
(pass-if-= #x100000000 (ash #x1000000000000 -16))
(pass-if-= #x100000000 (ash #x2000000000000 -17))
(pass-if-= #x100000000 (ash #x8000000000000000 -31))
(pass-if-= #x100000000 (ash #x10000000000000000 -32))
(pass-if-= #x100000000 (ash #x20000000000000000 -33))
;; Add tests here.
)
(with-test-prefix "neg"
(pass-if-string= "TODO" "TODO")
;; Add tests here.
)))
(with-test-prefix "bit-extract"
;; 23 is #b10111
(check-bx 23 0 1) ; bx
(check-bx 23 1 1)
(check-bx 23 2 1)
(check-bx 23 3 0)
(check-bx 23 4 1)
(check-Bx 23 0 1 #b1) ; Bx
(check-Bx 23 0 2 #b11)
(check-Bx 23 0 3 #b111)
(check-Bx 23 0 4 #b0111)
(check-Bx 23 0 5 #b10111)
(check-Bx 23 1 1 #b1)
(check-Bx 23 1 2 #b11)
(check-Bx 23 1 3 #b011)
(check-Bx 23 1 4 #b1011)
(check-Bx 23 2 1 #b1)
(check-Bx 23 2 2 #b01)
(check-Bx 23 2 3 #b101)
(check-Bx 23 3 1 #b0)
(check-Bx 23 3 2 #b10)
(check-Bx 23 4 1 #b1)
;; 2234234 is #b1000100001011101111010
(check-bx 2234234 0 0) ; bx
(check-bx 2234234 1 1)
(check-bx 2234234 2 0)
(check-bx 2234234 3 1)
(check-bx 2234234 4 1)
(check-bx 2234234 5 1)
(check-bx 2234234 6 1)
(check-bx 2234234 7 0)
(check-bx 2234234 8 1)
(check-bx 2234234 9 1)
(check-bx 2234234 10 1)
(check-bx 2234234 11 0)
(check-bx 2234234 12 1)
(check-bx 2234234 13 0)
(check-bx 2234234 14 0)
(check-bx 2234234 15 0)
(check-bx 2234234 16 0)
(check-bx 2234234 17 1)
(check-bx 2234234 18 0)
(check-bx 2234234 19 0)
(check-bx 2234234 20 0)
(check-bx 2234234 21 1)
(check-Bx 2234234 19 2 #b00) ; Bx
(check-Bx 2234234 5 10 #b0010111011)
(check-Bx 2234234 3 15 #b100001011101111)
;; Add tests here.
)
(with-test-prefix "logcount"
(pass-if-= 4 (logcount -31))
(pass-if-= 0 (logcount 0))
(pass-if-= 1 (logcount 1))
(pass-if-= 1 (logcount 2))
(pass-if-= 2 (logcount 3))
(pass-if-= 1 (logcount 4))
(pass-if-= 2 (logcount 5))
(pass-if-= 2 (logcount 6))
(pass-if-= 3 (logcount 7))
(pass-if-= 1 (logcount 8))
(pass-if-= 2 (logcount 9))
(pass-if-= 2 (logcount 10))
(pass-if-= 3 (logcount 11))
(pass-if-= 2 (logcount 12))
(pass-if-= 3 (logcount 13))
(pass-if-= 3 (logcount 14))
(pass-if-= 4 (logcount 15))
(pass-if-= 1 (logcount 16))
(pass-if-= 2 (logcount 17))
(pass-if-= 2 (logcount 18))
(pass-if-= 3 (logcount 19))
(pass-if-= 2 (logcount 20))
(pass-if-= 3 (logcount 21))
(pass-if-= 3 (logcount 22))
(pass-if-= 4 (logcount 23))
(pass-if-= 2 (logcount 24))
(pass-if-= 3 (logcount 25))
(pass-if-= 3 (logcount 26))
(pass-if-= 4 (logcount 27))
(pass-if-= 3 (logcount 28))
(pass-if-= 4 (logcount 29))
(pass-if-= 4 (logcount 30))
(pass-if-= 5 (logcount 31))
(pass-if-= 1 (logcount 32))
;; Add tests here.
)
(with-test-prefix "integer-length"
(pass-if-= 1 (integer-length 1))
(pass-if-= 2 (integer-length 2))
(pass-if-= 2 (integer-length 3))
(pass-if-= 3 (integer-length 4))
(pass-if-= 3 (integer-length 7))
(pass-if-= 4 (integer-length 8))
(pass-if-= 42 (integer-length 2234233498234))
;; Add tests here.
)
(with-test-prefix "number->string"
(pass-if-string= "42" (number->string 42))
;; Add tests here.
)
(with-test-prefix "string->number"
(pass-if-= 42 (string->number "42"))
;; Add tests here.
)
(with-test-prefix "asinh"
(pass-if-string= "TODO" "TODO")
;; Add tests here.
)
(with-test-prefix "acosh"
(pass-if-string= "TODO" "TODO")
;; Add tests here.
)
(with-test-prefix "atanh"
(pass-if-string= "TODO" "TODO")
;; Add tests here.
)
;;;; numbers.test ends here