1;;; arithmetic-fixnums.test --- Test suite for R6RS (rnrs arithmetic bitwise) 2 3;; Copyright (C) 2010, 2011, 2013 Free Software Foundation, Inc. 4;; 5;; This library is free software; you can redistribute it and/or 6;; modify it under the terms of the GNU Lesser General Public 7;; License as published by the Free Software Foundation; either 8;; version 3 of the License, or (at your option) any later version. 9;; 10;; This library is distributed in the hope that it will be useful, 11;; but WITHOUT ANY WARRANTY; without even the implied warranty of 12;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13;; Lesser General Public License for more details. 14;; 15;; You should have received a copy of the GNU Lesser General Public 16;; License along with this library; if not, write to the Free Software 17;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 18 19 20(define-module (test-suite test-r6rs-arithmetic-fixnums) 21 :use-module ((rnrs arithmetic fixnums) :version (6)) 22 :use-module ((rnrs conditions) :version (6)) 23 :use-module ((rnrs exceptions) :version (6)) 24 :use-module (test-suite lib)) 25 26(with-test-prefix "fixnum-width" 27 (pass-if-equal "consistent with least-fixnum" 28 (- (expt 2 (- (fixnum-width) 1))) 29 (least-fixnum)) 30 (pass-if-equal "consistent with greatest-fixnum" 31 (- (expt 2 (- (fixnum-width) 1)) 1) 32 (greatest-fixnum))) 33 34(with-test-prefix "fixnum?" 35 (pass-if "fixnum? is #t for fixnums" (fixnum? 0)) 36 37 (pass-if "fixnum? is #f for non-fixnums" (not (fixnum? 'foo))) 38 39 (pass-if "fixnum? is #f for non-fixnum numbers" 40 (and (not (fixnum? 1.0)) (not (fixnum? (+ (greatest-fixnum) 1)))))) 41 42(with-test-prefix "fx=?" 43 (pass-if "fx=? is #t for eqv inputs" (fx=? 3 3 3)) 44 45 (pass-if "fx=? is #f for non-eqv inputs" (not (fx=? 1 2 3)))) 46 47(with-test-prefix "fx>?" 48 (pass-if "fx>? is #t for monotonically > inputs" (fx>? 3 2 1)) 49 50 (pass-if "fx>? is #f for non-monotonically > inputs" (not (fx>? 1 2 3)))) 51 52(with-test-prefix "fx<?" 53 (pass-if "fx<? is #t for monotonically < inputs" (fx<? 1 2 3)) 54 55 (pass-if "fx<? is #t for non-monotonically < inputs" (not (fx<? 3 2 1)))) 56 57(with-test-prefix "fx>=?" 58 (pass-if "fx>=? is #t for monotonically > or = inputs" (fx>=? 3 2 2 1)) 59 60 (pass-if "fx>=? is #f for non-monotonically > or = inputs" 61 (not (fx>=? 1 2 3)))) 62 63(with-test-prefix "fx<=?" 64 (pass-if "fx<=? is #t for monotonically < or = inputs" (fx<=? 1 2 2 3)) 65 66 (pass-if "fx<=? is #f for non-monotonically < or = inputs" 67 (not (fx<=? 3 2 1)))) 68 69(with-test-prefix "fxzero?" 70 (pass-if "fxzero? is #t for zero" (fxzero? 0)) 71 72 (pass-if "fxzero? is #f for non-zero fixnums" 73 (and (not (fxzero? 1)) (not (fxzero? -1))))) 74 75(with-test-prefix "fxpositive?" 76 (pass-if "fxpositive? is #t for positive fixnums" (fxpositive? 1)) 77 78 (pass-if "fxpositive? is #f for non-positive fixnums" 79 (and (not (fxpositive? -1)) 80 (not (fxpositive? 0))))) 81 82(with-test-prefix "fxnegative?" 83 (pass-if "fxnegative? is #t for negative fixnums" (fxnegative? -1)) 84 85 (pass-if "fxnegative? is #f for non-negative fixnums" 86 (and (not (fxnegative? 1)) 87 (not (fxnegative? 0))))) 88 89(with-test-prefix "fxodd?" 90 (pass-if "fxodd? is #t for odd fixnums" (fxodd? 1)) 91 92 (pass-if "fxodd? is #f for even fixnums" (not (fxodd? 2)))) 93 94(with-test-prefix "fxeven?" 95 (pass-if "fxeven? is #t for even fixnums" (fxeven? 2)) 96 97 (pass-if "fxeven? is #f for odd fixnums" (not (fxeven? 1)))) 98 99(with-test-prefix "fxmax" (pass-if "simple" (fx=? (fxmax 1 3 2) 3))) 100 101(with-test-prefix "fxmin" (pass-if "simple" (fx=? (fxmin -1 0 2) -1))) 102 103(with-test-prefix "fx+" 104 (pass-if "simple" (fx=? (fx+ 1 2) 3)) 105 106 (pass-if "&implementation-restriction on non-fixnum result" 107 (guard (condition ((implementation-restriction-violation? condition) #t) 108 (else #f)) 109 (begin (fx+ (greatest-fixnum) 1) #f)))) 110 111(with-test-prefix "fx*" 112 (pass-if "simple" (fx=? (fx* 2 3) 6)) 113 114 (pass-if "&implementation-restriction on non-fixnum result" 115 (guard (condition ((implementation-restriction-violation? condition) #t) 116 (else #f)) 117 (begin (fx* (greatest-fixnum) 2) #f)))) 118 119(with-test-prefix "fx-" 120 (pass-if "unary fx- negates argument" (fx=? (fx- 1) -1)) 121 122 (pass-if "simple" (fx=? (fx- 3 2) 1)) 123 124 (pass-if "&assertion on non-fixnum result" 125 (guard (condition ((assertion-violation? condition) #t) (else #f)) 126 (fx- (least-fixnum) 1)))) 127 128(with-test-prefix "fxdiv-and-mod" 129 (pass-if "simple" 130 (call-with-values (lambda () (fxdiv-and-mod 123 10)) 131 (lambda (d m) 132 (and (fx=? d 12) (fx=? m 3)))))) 133 134(with-test-prefix "fxdiv" (pass-if "simple" (fx=? (fxdiv -123 10) -13))) 135(with-test-prefix "fxmod" (pass-if "simple" (fx=? (fxmod -123 10) 7))) 136 137(with-test-prefix "fxdiv0-and-mod0" 138 (pass-if "simple" 139 (call-with-values (lambda () (fxdiv0-and-mod0 -123 10)) 140 (lambda (d m) 141 (and (fx=? d -12) (fx=? m -3)))))) 142 143(with-test-prefix "fxdiv0" (pass-if "simple" (fx=? (fxdiv0 -123 10) -12))) 144(with-test-prefix "fxmod0" (pass-if "simple" (fx=? (fxmod0 -123 10) -3))) 145 146 147;; Without working div and mod implementations and without any example results 148;; from the spec, I have no idea what the results of these functions should 149;; be. -juliang 150;; UPDATE: div and mod implementations are now working properly -mhw 151 152(with-test-prefix "fx+/carry" (pass-if "simple" (throw 'unresolved))) 153 154(with-test-prefix "fx-/carry" (pass-if "simple" (throw 'unresolved))) 155 156(with-test-prefix "fx*/carry" (pass-if "simple" (throw 'unresolved))) 157 158(with-test-prefix "fxnot" (pass-if "simple" (fx=? (fxnot 3) -4))) 159 160(with-test-prefix "fxand" (pass-if "simple" (fx=? (fxand 5 6) 4))) 161 162(with-test-prefix "fxior" (pass-if "simple" (fx=? (fxior 2 4) 6))) 163 164(with-test-prefix "fxxor" (pass-if "simple" (fx=? (fxxor 5 4) 1))) 165 166(with-test-prefix "fxif" (pass-if "simple" (fx=? (fxif 5 3 4) 1))) 167 168(with-test-prefix "fxbit-count" 169 (pass-if "simple" (fx=? (fxbit-count 5) 2)) 170 (pass-if "negative" (fx=? (fxbit-count -5) -2))) 171 172(with-test-prefix "fxlength" (pass-if "simple" (fx=? (fxlength 5) 3))) 173 174(with-test-prefix "fxfirst-bit-set" 175 (pass-if "simple" 176 (and (eqv? (fxfirst-bit-set 1) 0) 177 (eqv? (fxfirst-bit-set -4) 2))) 178 179 (pass-if "fxfirst-bit-set is -1 on zero" 180 (and (eqv? (fxfirst-bit-set 0) -1)))) 181 182(with-test-prefix "fxbit-set?" 183 (pass-if "fxbit-set? is #t on index of set bit" (fxbit-set? 5 2)) 184 185 (pass-if "fxbit-set? is #f on index of unset bit" (not (fxbit-set? 5 1)))) 186 187(with-test-prefix "fxcopy-bit" (pass-if "simple" (fx=? (fxcopy-bit 2 2 1) 6))) 188 189(with-test-prefix "fxbit-field" 190 (pass-if "simple" (fx=? (fxbit-field 50 1 4) 1))) 191 192(with-test-prefix "fxcopy-bit-field" 193 (pass-if "simple" (fx=? (fxcopy-bit-field 255 2 6 10) 235))) 194 195(with-test-prefix "fxarithmetic-shift" 196 (pass-if "simple" 197 (and (fx=? (fxarithmetic-shift -6 -1) -3) 198 (fx=? (fxarithmetic-shift -5 -1) -3) 199 (fx=? (fxarithmetic-shift -4 -1) -2) 200 (fx=? (fxarithmetic-shift -3 -1) -2) 201 (fx=? (fxarithmetic-shift -2 -1) -1) 202 (fx=? (fxarithmetic-shift -1 -1) -1)))) 203 204(with-test-prefix "fxarithmetic-shift-left" 205 (pass-if "simple" (fx=? (fxarithmetic-shift-left -6 1) -12))) 206 207(with-test-prefix "fxarithmetic-shift-right" 208 (pass-if "simple" (fx=? (fxarithmetic-shift-right -6 1) -3))) 209 210(with-test-prefix "fxrotate-bit-field" 211 (pass-if "simple" (fx=? (fxrotate-bit-field 227 2 6 2) 203))) 212 213(with-test-prefix "fxreverse-bit-field" 214 (pass-if "simple" (fx=? (fxreverse-bit-field 82 1 4) 88))) 215