| 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 | \f |
| 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) -3))) |
| 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))) |