This is the mail archive of the guile@sourceware.cygnus.com mailing list for the Guile project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]

latest test-suite/tests/numbers.test


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

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]