1(include "test.scm") 2 3(import (chicken bitwise)) 4 5(current-test-epsilon 0) ;; We want exact comparisons by default 6 7;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8;; run tests 9 10(test-begin "numbers (Alex Shinn's tests)") 11 12(test-group "basic cases, fixnum base" 13 (test-equal (expt 0 0) 1) 14 (test-equal (expt 2 0) 1) 15 (test-equal (expt 2 1) 2) 16 (test-equal (expt 2 2) 4) 17 (test-equal (expt 3 2) 9) 18 (test-equal (expt 3 2.0) 9.0) 19 (parameterize ((current-test-epsilon 0.001)) 20 (test-equal (expt 3 2.1) 10.0451) 21 (test-equal (expt 3 0.1) 1.1161) 22 (test-equal (expt 3 -1) (/ 1 3)) 23 (test-equal (expt 3 -2) (/ 1 9)) 24 (test-equal (expt 3 -2.1) 0.09955))) 25 26(test-group "basic cases, flonum base" 27 (test-equal (expt 0.0 0) 1.0) 28 (test-equal (expt 3.14 0) 1.0) 29 (test-equal (expt 3.14 1) 3.14) 30 (test-equal (expt 3.14 2) 9.8596) 31 (test-equal (expt 3.14 2.0) 9.8596) 32 (parameterize ((current-test-epsilon 0.001)) 33 (test-equal (expt 3.14 2.1) 11.0548) 34 (test-equal (expt 3.14 0.1) 1.1212) 35 (test-equal (expt 3.14 -1) 0.31847) 36 (test-equal (expt 3.14 -2) 0.10142) 37 (test-equal (expt 3.14 -2.1) 0.090458))) 38 39(test-group "overflows into bignums" 40 (test-equal (expt 2 30) 1073741824) 41 (test-equal (expt 2 31) 2147483648) 42 (test-equal (expt 2 32) 4294967296) 43 (test-equal (expt 2 62) 4611686018427387904) 44 (test-equal (expt 2 63) 9223372036854775808) 45 (test-equal (expt 2 64) 18446744073709551616)) 46 47(define (one-followed-by-n-zeros n) 48 (string->number (string-append "1" (make-string n #\0)))) 49 50(test-group "bug reported on the chicken list" 51 (test-equal (expt 10 100) (one-followed-by-n-zeros 100))) 52 53(test-group "bignum base" 54 (test-equal (expt (one-followed-by-n-zeros 100) 0) 1) 55 (parameterize ((current-test-epsilon 0.001)) 56 (test-equal (expt (one-followed-by-n-zeros 100) 1) (one-followed-by-n-zeros 100)) 57 (test-equal (expt (one-followed-by-n-zeros 100) 2) (one-followed-by-n-zeros 200)) 58 (test-equal (expt (one-followed-by-n-zeros 100) 0.1) 10000000000.0))) 59 60(define (real-approx= expected result) 61 (cond ((zero? result) (< (abs expected) (current-test-epsilon))) 62 ((zero? expected) (< (abs result) (current-test-epsilon))) 63 (else (< (min (abs (- 1 (/ expected result))) 64 (abs (- 1 (/ result expected)))) 65 (current-test-epsilon))))) 66 67;; test-equal? doesn't work on compnums 68(define (test-equal/comp? a b) 69 (and (real-approx= (real-part a) (real-part b)) 70 (real-approx= (imag-part a) (imag-part b)))) 71 72(test-group "e^(pi*i) = -1" 73 (parameterize ((current-test-epsilon 0.001) 74 (current-test-comparator test-equal/comp?)) 75 (test-equal (expt (exp 1) (* (acos -1) (sqrt -1))) -1.0))) 76 77(test-group "rational rounding" 78 (test-equal (round (/ 9 10)) 1) 79 (test-equal (round (/ 6 10)) 1) 80 (test-equal (round (/ 5 10)) 0) 81 (test-equal (round (/ 1 10)) 0) 82 (test-equal (round (/ 0 10)) 0) 83 (test-equal (round (/ -1 10)) 0) 84 (test-equal (round (/ -5 10)) 0) 85 (test-equal (round (/ -6 10)) -1) 86 (test-equal (round (/ -9 10)) -1) 87 (test-equal (round (/ (expt 10 10000) (+ (expt 10 10000) 1))) 1) 88 (test-equal (round (/ (+ 1 (expt 10 10000)) (expt 10 100))) (expt 10 9900))) 89 90(test-group "srfi-33" 91 (test-equal (bitwise-and #b0 #b1) 0) 92 (test-equal (bitwise-and #b1 #b1) 1) 93 (test-equal (bitwise-and #b1 #b10) 0) 94 (test-equal (bitwise-and #b11 #b10) #b10) 95 (test-equal (bitwise-and #b101 #b111) #b101) 96 (test-equal (bitwise-and -1 #b111) #b111) 97 (test-equal (bitwise-and -2 #b111) #b110) 98 (test-equal (bitwise-and -4290775858 1694076839) 3769478) 99 (test-equal (bitwise-and -193073517 1689392892) 1680869008) 100 ;; (test-equal (bitwise-ior 1694076839 -4290775858) -2600468497) 101 ;; (test-equal (bitwise-ior -193073517 1689392892) -184549633) 102 ;; (test-equal (bitwise-xor 1694076839 -4290775858) -2604237975) 103 ;; (test-equal (bitwise-xor -193073517 1689392892) -1865418641) 104 105 (test-equal (arithmetic-shift 1 0) 1) 106 (test-equal (arithmetic-shift 1 1) 2) 107 (test-equal (arithmetic-shift 1 2) 4) 108 (test-equal (arithmetic-shift 1 3) 8) 109 (test-equal (arithmetic-shift 1 4) 16) 110 (test-equal (arithmetic-shift 1 31) (expt 2 31)) 111 (test-equal (arithmetic-shift 1 32) (expt 2 32)) 112 (test-equal (arithmetic-shift 1 33) (expt 2 33)) 113 (test-equal (arithmetic-shift 1 63) (expt 2 63)) 114 (test-equal (arithmetic-shift 1 64) (expt 2 64)) 115 (test-equal (arithmetic-shift 1 65) (expt 2 65)) 116 (test-equal (arithmetic-shift 1 127) (expt 2 127)) 117 (test-equal (arithmetic-shift 1 128) (expt 2 128)) 118 (test-equal (arithmetic-shift 1 129) (expt 2 129)) 119 (test-equal (arithmetic-shift 11829675785914119 8) 3028397001194014464) 120 121 (test-equal (arithmetic-shift -1 0) -1) 122 (test-equal (arithmetic-shift -1 1) -2) 123 (test-equal (arithmetic-shift -1 2) -4) 124 (test-equal (arithmetic-shift -1 3) -8) 125 (test-equal (arithmetic-shift -1 4) -16) 126 (test-equal (arithmetic-shift -1 31) (- (expt 2 31))) 127 (test-equal (arithmetic-shift -1 32) (- (expt 2 32))) 128 (test-equal (arithmetic-shift -1 33) (- (expt 2 33))) 129 (test-equal (arithmetic-shift -1 63) (- (expt 2 63))) 130 (test-equal (arithmetic-shift -1 64) (- (expt 2 64))) 131 (test-equal (arithmetic-shift -1 65) (- (expt 2 65))) 132 (test-equal (arithmetic-shift -1 127) (- (expt 2 127))) 133 (test-equal (arithmetic-shift -1 128) (- (expt 2 128))) 134 (test-equal (arithmetic-shift -1 129) (- (expt 2 129))) 135 136 (test-equal (arithmetic-shift 1 -63) 0) 137 (test-equal (arithmetic-shift 1 -64) 0) 138 (test-equal (arithmetic-shift 1 -65) 0) 139 140 (test-equal (arithmetic-shift #x100000000000000010000000000000000 64) 141 #x1000000000000000100000000000000000000000000000000) 142 143 (test-assert (not (bit->boolean 1 64))) 144 (test-assert (bit->boolean #x10000000000000000 64))) 145 146(test-end) 147 148(test-exit) 149