HCoop / bpt / guile.git / blame
| Commit | Line | Data |
|---|---|---|
| 17e69f21 KR |
1 | ;;;; srfi-60.test --- Test suite for Guile's SRFI-60 functions. -*- scheme -*- |
| 2 | ;;;; | |
| 6e7d5622 | 3 | ;;;; Copyright 2005, 2006 Free Software Foundation, Inc. |
| 17e69f21 | 4 | ;;;; |
| 53befeb7 NJ |
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, | |
| 17e69f21 | 11 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 53befeb7 NJ |
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 | |
| 17e69f21 KR |
18 | |
| 19 | (define-module (test-srfi-60) | |
| 23f2b9a3 | 20 | #:duplicates (last) ;; avoid warning about srfi-60 replacing `bit-count' |
| 17e69f21 KR |
21 | #:use-module (test-suite lib) |
| 22 | #:use-module (srfi srfi-60)) | |
| 23 | ||
| 24 | ||
| 25 | (pass-if "cond-expand srfi-60" | |
| 26 | (cond-expand (srfi-60 #t) | |
| 27 | (else #f))) | |
| 28 | ||
| 29 | ;; | |
| 30 | ;; logand | |
| 31 | ;; | |
| 32 | ||
| 33 | (with-test-prefix "logand" | |
| 34 | (pass-if (eqv? 6 (logand 14 6)))) | |
| 35 | ||
| 36 | ;; | |
| 37 | ;; bitwise-and | |
| 38 | ;; | |
| 39 | ||
| 40 | (with-test-prefix "bitwise-and" | |
| 41 | (pass-if (eqv? 6 (bitwise-and 14 6)))) | |
| 42 | ||
| 43 | ;; | |
| 44 | ;; logior | |
| 45 | ;; | |
| 46 | ||
| 47 | (with-test-prefix "logior" | |
| 48 | (pass-if (eqv? 14 (logior 10 12)))) | |
| 49 | ||
| 50 | ;; | |
| 51 | ;; bitwise-ior | |
| 52 | ;; | |
| 53 | ||
| 54 | (with-test-prefix "bitwise-ior" | |
| 55 | (pass-if (eqv? 14 (bitwise-ior 10 12)))) | |
| 56 | ||
| 57 | ;; | |
| 58 | ;; logxor | |
| 59 | ;; | |
| 60 | ||
| 61 | (with-test-prefix "logxor" | |
| 62 | (pass-if (eqv? 6 (logxor 10 12)))) | |
| 63 | ||
| 64 | ;; | |
| 65 | ;; bitwise-xor | |
| 66 | ;; | |
| 67 | ||
| 68 | (with-test-prefix "bitwise-xor" | |
| 69 | (pass-if (eqv? 6 (bitwise-xor 10 12)))) | |
| 70 | ||
| 71 | ;; | |
| 72 | ;; lognot | |
| 73 | ;; | |
| 74 | ||
| 75 | (with-test-prefix "lognot" | |
| 76 | (pass-if (eqv? -1 (lognot 0))) | |
| 77 | (pass-if (eqv? 0 (lognot -1)))) | |
| 78 | ||
| 79 | ;; | |
| 80 | ;; bitwise-not | |
| 81 | ;; | |
| 82 | ||
| 83 | (with-test-prefix "bitwise-not" | |
| 84 | (pass-if (eqv? -1 (bitwise-not 0))) | |
| 85 | (pass-if (eqv? 0 (bitwise-not -1)))) | |
| 86 | ||
| 87 | ;; | |
| 88 | ;; bitwise-if | |
| 89 | ;; | |
| 90 | ||
| 91 | (with-test-prefix "bitwise-if" | |
| 92 | (pass-if (eqv? 9 (bitwise-if 3 1 8))) | |
| 93 | (pass-if (eqv? 0 (bitwise-if 3 8 1)))) | |
| 94 | ||
| 95 | ;; | |
| 96 | ;; bitwise-merge | |
| 97 | ;; | |
| 98 | ||
| 99 | (with-test-prefix "bitwise-merge" | |
| 100 | (pass-if (eqv? 9 (bitwise-merge 3 1 8))) | |
| 101 | (pass-if (eqv? 0 (bitwise-merge 3 8 1)))) | |
| 102 | ||
| 103 | ;; | |
| 104 | ;; logtest | |
| 105 | ;; | |
| 106 | ||
| 107 | (with-test-prefix "logtest" | |
| 108 | (pass-if (eq? #t (logtest 3 6))) | |
| 109 | (pass-if (eq? #f (logtest 3 12)))) | |
| 110 | ||
| 111 | ;; | |
| 112 | ;; any-bits-set? | |
| 113 | ;; | |
| 114 | ||
| 115 | (with-test-prefix "any-bits-set?" | |
| 116 | (pass-if (eq? #t (any-bits-set? 3 6))) | |
| 117 | (pass-if (eq? #f (any-bits-set? 3 12)))) | |
| 118 | ||
| 119 | ;; | |
| 120 | ;; logcount | |
| 121 | ;; | |
| 122 | ||
| 123 | (with-test-prefix "logcount" | |
| 124 | (pass-if (eqv? 2 (logcount 12)))) | |
| 125 | ||
| 126 | ;; | |
| 127 | ;; bit-count | |
| 128 | ;; | |
| 129 | ||
| 130 | (with-test-prefix "bit-count" | |
| 131 | (pass-if (eqv? 2 (bit-count 12)))) | |
| 132 | ||
| 133 | ;; | |
| 134 | ;; integer-length | |
| 135 | ;; | |
| 136 | ||
| 137 | (with-test-prefix "integer-length" | |
| 138 | (pass-if (eqv? 0 (integer-length 0))) | |
| 139 | (pass-if (eqv? 8 (integer-length 128))) | |
| 140 | (pass-if (eqv? 8 (integer-length 255))) | |
| 141 | (pass-if (eqv? 9 (integer-length 256)))) | |
| 142 | ||
| 143 | ;; | |
| 144 | ;; log2-binary-factors | |
| 145 | ;; | |
| 146 | ||
| 147 | (with-test-prefix "log2-binary-factors" | |
| 148 | (pass-if (eqv? -1 (log2-binary-factors 0))) | |
| 149 | (pass-if (eqv? 0 (log2-binary-factors 1))) | |
| 150 | (pass-if (eqv? 0 (log2-binary-factors 3))) | |
| 151 | (pass-if (eqv? 2 (log2-binary-factors 4))) | |
| 152 | (pass-if (eqv? 1 (log2-binary-factors 6))) | |
| 153 | (pass-if (eqv? 0 (log2-binary-factors -1))) | |
| 154 | (pass-if (eqv? 1 (log2-binary-factors -2))) | |
| 155 | (pass-if (eqv? 0 (log2-binary-factors -3))) | |
| 156 | (pass-if (eqv? 2 (log2-binary-factors -4))) | |
| 157 | (pass-if (eqv? 128 (log2-binary-factors #x100000000000000000000000000000000)))) | |
| 158 | ||
| 159 | ;; | |
| 160 | ;; first-set-bit | |
| 161 | ;; | |
| 162 | ||
| 163 | (with-test-prefix "first-set-bit" | |
| 164 | (pass-if (eqv? -1 (first-set-bit 0))) | |
| 165 | (pass-if (eqv? 0 (first-set-bit 1))) | |
| 166 | (pass-if (eqv? 0 (first-set-bit 3))) | |
| 167 | (pass-if (eqv? 2 (first-set-bit 4))) | |
| 168 | (pass-if (eqv? 1 (first-set-bit 6))) | |
| 169 | (pass-if (eqv? 0 (first-set-bit -1))) | |
| 170 | (pass-if (eqv? 1 (first-set-bit -2))) | |
| 171 | (pass-if (eqv? 0 (first-set-bit -3))) | |
| 172 | (pass-if (eqv? 2 (first-set-bit -4)))) | |
| 173 | ||
| 174 | ;; | |
| 175 | ;; logbit? | |
| 176 | ;; | |
| 177 | ||
| 178 | (with-test-prefix "logbit?" | |
| 179 | (pass-if (eq? #t (logbit? 0 1))) | |
| 180 | (pass-if (eq? #f (logbit? 1 1))) | |
| 181 | (pass-if (eq? #f (logbit? 1 8))) | |
| 182 | (pass-if (eq? #t (logbit? 1000 -1)))) | |
| 183 | ||
| 184 | ;; | |
| 185 | ;; bit-set? | |
| 186 | ;; | |
| 187 | ||
| 188 | (with-test-prefix "bit-set?" | |
| 189 | (pass-if (eq? #t (bit-set? 0 1))) | |
| 190 | (pass-if (eq? #f (bit-set? 1 1))) | |
| 191 | (pass-if (eq? #f (bit-set? 1 8))) | |
| 192 | (pass-if (eq? #t (bit-set? 1000 -1)))) | |
| 193 | ||
| 194 | ;; | |
| 195 | ;; copy-bit | |
| 196 | ;; | |
| 197 | ||
| 198 | (with-test-prefix "copy-bit" | |
| 199 | (pass-if (eqv? 0 (copy-bit 0 0 #f))) | |
| 200 | (pass-if (eqv? 0 (copy-bit 30 0 #f))) | |
| 201 | (pass-if (eqv? 0 (copy-bit 31 0 #f))) | |
| 202 | (pass-if (eqv? 0 (copy-bit 62 0 #f))) | |
| 203 | (pass-if (eqv? 0 (copy-bit 63 0 #f))) | |
| 204 | (pass-if (eqv? 0 (copy-bit 128 0 #f))) | |
| 205 | ||
| 206 | (pass-if (eqv? -1 (copy-bit 0 -1 #t))) | |
| 207 | (pass-if (eqv? -1 (copy-bit 30 -1 #t))) | |
| 208 | (pass-if (eqv? -1 (copy-bit 31 -1 #t))) | |
| 209 | (pass-if (eqv? -1 (copy-bit 62 -1 #t))) | |
| 210 | (pass-if (eqv? -1 (copy-bit 63 -1 #t))) | |
| 211 | (pass-if (eqv? -1 (copy-bit 128 -1 #t))) | |
| 212 | ||
| 213 | (pass-if (eqv? 1 (copy-bit 0 0 #t))) | |
| 214 | (pass-if (eqv? #x106 (copy-bit 8 6 #t))) | |
| 215 | (pass-if (eqv? 6 (copy-bit 8 6 #f))) | |
| 216 | (pass-if (eqv? -2 (copy-bit 0 -1 #f))) | |
| 217 | ||
| 218 | (pass-if "bignum becomes inum" | |
| 219 | (eqv? 0 (copy-bit 128 #x100000000000000000000000000000000 #f))) | |
| 220 | ||
| 221 | ;; bignums unchanged | |
| 222 | (pass-if (eqv? #x100000000000000000000000000000000 | |
| 223 | (copy-bit 128 #x100000000000000000000000000000000 #t))) | |
| 224 | (pass-if (eqv? #x100000000000000000000000000000000 | |
| 225 | (copy-bit 64 #x100000000000000000000000000000000 #f))) | |
| 226 | (pass-if (eqv? #x-100000000000000000000000000000000 | |
| 227 | (copy-bit 64 #x-100000000000000000000000000000000 #f))) | |
| 228 | (pass-if (eqv? #x-100000000000000000000000000000000 | |
| 229 | (copy-bit 256 #x-100000000000000000000000000000000 #t)))) | |
| 230 | ||
| 231 | ;; | |
| 232 | ;; bit-field | |
| 233 | ;; | |
| 234 | ||
| 235 | (with-test-prefix "bit-field" | |
| 236 | (pass-if (eqv? 0 (bit-field 6 0 1))) | |
| 237 | (pass-if (eqv? 3 (bit-field 6 1 3))) | |
| 238 | (pass-if (eqv? 1 (bit-field 6 2 999))) | |
| 239 | (pass-if (eqv? 1 (bit-field #x100000000000000000000000000000000 128 129)))) | |
| 240 | ||
| 241 | ;; | |
| 242 | ;; copy-bit-field | |
| 243 | ;; | |
| 244 | ||
| 245 | (with-test-prefix "copy-bit-field" | |
| 246 | (pass-if (eqv? #b111 (copy-bit-field #b110 1 0 1))) | |
| 247 | (pass-if (eqv? #b110 (copy-bit-field #b110 1 1 2))) | |
| 248 | (pass-if (eqv? #b010 (copy-bit-field #b110 1 1 3)))) | |
| 249 | ||
| 250 | ;; | |
| 251 | ;; ash | |
| 252 | ;; | |
| 253 | ||
| 254 | (with-test-prefix "ash" | |
| 255 | (pass-if (eqv? 2 (ash 1 1))) | |
| 256 | (pass-if (eqv? 0 (ash 1 -1)))) | |
| 257 | ||
| 258 | ;; | |
| 259 | ;; arithmetic-shift | |
| 260 | ;; | |
| 261 | ||
| 262 | (with-test-prefix "arithmetic-shift" | |
| 263 | (pass-if (eqv? 2 (arithmetic-shift 1 1))) | |
| 264 | (pass-if (eqv? 0 (arithmetic-shift 1 -1)))) | |
| 265 | ||
| 266 | ;; | |
| 267 | ;; rotate-bit-field | |
| 268 | ;; | |
| 269 | ||
| 270 | (with-test-prefix "rotate-bit-field" | |
| 7f8ad91b MW |
271 | (define-syntax-rule (check expected x count start end) |
| 272 | (begin | |
| 273 | (pass-if-equal expected (rotate-bit-field x count start end)) | |
| 274 | (pass-if-equal (lognot expected) | |
| 275 | (rotate-bit-field (lognot x) count start end)))) | |
| 276 | ||
| 277 | (check #b110 #b110 1 1 2) | |
| 278 | (check #b1010 #b110 1 2 4) | |
| 279 | (check #b1011 #b0111 -1 1 4) | |
| 280 | ||
| 281 | (check #b0 #b0 128 0 256) | |
| 282 | (check #b1 #b1 128 1 256) | |
| 283 | (check #x100000000000000000000000000000000 | |
| 284 | #x100000000000000000000000000000000 128 0 64) | |
| 285 | (check #x100000000000000000000000000000008 | |
| 286 | #x100000000000000000000000000000001 3 0 64) | |
| 287 | (check #x100000000000000002000000000000000 | |
| 288 | #x100000000000000000000000000000001 -3 0 64) | |
| 289 | ||
| 290 | (check #b110 #b110 0 0 10) | |
| 291 | (check #b110 #b110 0 0 256) | |
| 292 | ||
| 293 | (check #b110 #b110 1 1 1) | |
| 294 | ||
| 295 | (check #b10111010001100111101110010101 | |
| 296 | #b11010001100111101110001110101 -26 5 28) | |
| 297 | (check #b11000110011110111000111011001 | |
| 298 | #b11010001100111101110001110101 28 2 28) | |
| 299 | ||
| 300 | (check #b01111010001100111101110010101 | |
| 301 | #b11010001100111101110001110101 -3 5 29) | |
| 302 | (check #b10100011001111011100011101101 | |
| 303 | #b11010001100111101110001110101 28 2 29) | |
| 304 | ||
| 305 | (check #b110110100011001111011100010101 | |
| 306 | #b011010001100111101110001110101 48 5 30) | |
| 307 | (check #b110100011001111011100011101001 | |
| 308 | #b011010001100111101110001110101 85 2 30) | |
| 309 | (check #b011010001100111101110001110101 | |
| 310 | #b110100011001111011100011101001 83 2 30) | |
| 311 | ||
| 312 | (check | |
| 313 | #b1101100110101001110000111110011010000111011101011101110111011 | |
| 314 | #b1100110101001110000111110011010000111011101011101110110111011 -3 5 60) | |
| 315 | (check | |
| 316 | #b1011010100111000011111001101000011101110101110111011011101110 | |
| 317 | #b1100110101001110000111110011010000111011101011101110110111011 62 0 60) | |
| 318 | ||
| 319 | (check | |
| 320 | #b1011100110101001110000111110011010000111011101011101110111011 | |
| 321 | #b1100110101001110000111110011010000111011101011101110110111011 53 5 61) | |
| 322 | (check | |
| 323 | #b1001101010011100001111100110100001110111010111011101101110111 | |
| 324 | #b1100110101001110000111110011010000111011101011101110110111011 62 0 61) | |
| 325 | ||
| 326 | (check | |
| 327 | #b11011001101010011100001111100110100001110111010111011100111011 | |
| 328 | #b01100110101001110000111110011010000111011101011101110110111011 53 7 62) | |
| 329 | (check | |
| 330 | #b11011001101010011100001111100110100001110111010111011100111011 | |
| 331 | #b01100110101001110000111110011010000111011101011101110110111011 -2 7 62) | |
| 332 | (check | |
| 333 | #b01100110101001110000111110011010000111011101011101110110111011 | |
| 334 | #b11011001101010011100001111100110100001110111010111011100111011 2 7 62) | |
| 335 | ||
| 336 | (pass-if-equal "bignum becomes inum" | |
| 337 | 1 | |
| 338 | (rotate-bit-field #x100000000000000000000000000000000 1 0 129))) | |
| 17e69f21 KR |
339 | |
| 340 | ;; | |
| 341 | ;; reverse-bit-field | |
| 342 | ;; | |
| 343 | ||
| 344 | (with-test-prefix "reverse-bit-field" | |
| 345 | (pass-if (eqv? 6 (reverse-bit-field 6 1 3))) | |
| 346 | (pass-if (eqv? 12 (reverse-bit-field 6 1 4))) | |
| 347 | ||
| 348 | (pass-if (eqv? #x80000000 (reverse-bit-field 1 0 32))) | |
| 349 | (pass-if (eqv? #x40000000 (reverse-bit-field 1 0 31))) | |
| 350 | (pass-if (eqv? #x20000000 (reverse-bit-field 1 0 30))) | |
| 351 | ||
| 352 | (pass-if (eqv? (logior (ash -1 32) #xFBFFFFFF) | |
| 353 | (reverse-bit-field -2 0 27))) | |
| 354 | (pass-if (eqv? (logior (ash -1 32) #xF7FFFFFF) | |
| 355 | (reverse-bit-field -2 0 28))) | |
| 356 | (pass-if (eqv? (logior (ash -1 32) #xEFFFFFFF) | |
| 357 | (reverse-bit-field -2 0 29))) | |
| 358 | (pass-if (eqv? (logior (ash -1 32) #xDFFFFFFF) | |
| 359 | (reverse-bit-field -2 0 30))) | |
| 360 | (pass-if (eqv? (logior (ash -1 32) #xBFFFFFFF) | |
| 361 | (reverse-bit-field -2 0 31))) | |
| 362 | (pass-if (eqv? (logior (ash -1 32) #x7FFFFFFF) | |
| 363 | (reverse-bit-field -2 0 32))) | |
| 364 | ||
| 365 | (pass-if "bignum becomes inum" | |
| 366 | (eqv? 5 (reverse-bit-field #x140000000000000000000000000000000 0 129)))) | |
| 367 | ||
| 368 | ;; | |
| 369 | ;; integer->list | |
| 370 | ;; | |
| 371 | ||
| 372 | (with-test-prefix "integer->list" | |
| 373 | (pass-if (equal? '(#t #t #f) (integer->list 6))) | |
| 374 | (pass-if (equal? '(#f #t #t #f) (integer->list 6 4))) | |
| 375 | (pass-if (equal? '(#t #f) (integer->list 6 2))) | |
| 376 | ||
| 377 | (pass-if "zeros above top of positive inum" | |
| 378 | (equal? '(#f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f | |
| 379 | #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f | |
| 380 | #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f | |
| 381 | #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f | |
| 382 | #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f | |
| 383 | #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f | |
| 384 | #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f | |
| 385 | #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #t) | |
| 386 | (integer->list 1 128))) | |
| 387 | ||
| 388 | (pass-if "ones above top of negative inum" | |
| 389 | (equal? '(#t #t #t #t #t #t #t #t #t #t #t #t #t #t #t #t | |
| 390 | #t #t #t #t #t #t #t #t #t #t #t #t #t #t #t #t | |
| 391 | #t #t #t #t #t #t #t #t #t #t #t #t #t #t #t #t | |
| 392 | #t #t #t #t #t #t #t #t #t #t #t #t #t #t #t #t | |
| 393 | #t #t #t #t #t #t #t #t #t #t #t #t #t #t #t #t | |
| 394 | #t #t #t #t #t #t #t #t #t #t #t #t #t #t #t #t | |
| 395 | #t #t #t #t #t #t #t #t #t #t #t #t #t #t #t #t | |
| 396 | #t #t #t #t #t #t #t #t #t #t #t #t #t #t #t #t) | |
| 397 | (integer->list -1 128))) | |
| 398 | ||
| 399 | (pass-if (equal? '(#t | |
| 400 | #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f | |
| 401 | #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f | |
| 402 | #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f | |
| 403 | #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f | |
| 404 | #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f | |
| 405 | #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f | |
| 406 | #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f | |
| 407 | #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f) | |
| 408 | (integer->list #x100000000000000000000000000000000)))) | |
| 409 | ||
| 410 | ;; | |
| 411 | ;; list->integer | |
| 412 | ;; | |
| 413 | ||
| 414 | (with-test-prefix "list->integer" | |
| 415 | (pass-if (eqv? 6 (list->integer '(#t #t #f)))) | |
| 416 | (pass-if (eqv? 6 (list->integer '(#f #t #t #f)))) | |
| 417 | (pass-if (eqv? 2 (list->integer '(#t #f)))) | |
| 418 | ||
| 419 | (pass-if "leading #f's" | |
| 420 | (eqv? 1 (list->integer | |
| 421 | '(#f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f | |
| 422 | #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f | |
| 423 | #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f | |
| 424 | #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f | |
| 425 | #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f | |
| 426 | #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f | |
| 427 | #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f | |
| 428 | #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #t)))) | |
| 429 | ||
| 430 | (pass-if (eqv? #x100000000000000000000000000000000 | |
| 431 | (list->integer | |
| 432 | '(#t | |
| 433 | #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f | |
| 434 | #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f | |
| 435 | #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f | |
| 436 | #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f | |
| 437 | #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f | |
| 438 | #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f | |
| 439 | #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f | |
| 440 | #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f)))) | |
| 441 | ||
| 442 | (pass-if (eqv? #x03FFFFFF (list->integer '(#t #t | |
| 443 | #t #t #t #t #t #t #t #t | |
| 444 | #t #t #t #t #t #t #t #t | |
| 445 | #t #t #t #t #t #t #t #t)))) | |
| 446 | (pass-if (eqv? #x07FFFFFF (list->integer '(#t #t #t | |
| 447 | #t #t #t #t #t #t #t #t | |
| 448 | #t #t #t #t #t #t #t #t | |
| 449 | #t #t #t #t #t #t #t #t)))) | |
| 450 | (pass-if (eqv? #x0FFFFFFF (list->integer '(#t #t #t #t | |
| 451 | #t #t #t #t #t #t #t #t | |
| 452 | #t #t #t #t #t #t #t #t | |
| 453 | #t #t #t #t #t #t #t #t)))) | |
| 454 | (pass-if (eqv? #x1FFFFFFF (list->integer '(#t #t #t #t #t | |
| 455 | #t #t #t #t #t #t #t #t | |
| 456 | #t #t #t #t #t #t #t #t | |
| 457 | #t #t #t #t #t #t #t #t)))) | |
| 458 | (pass-if (eqv? #x3FFFFFFF (list->integer '(#t #t #t #t #t #t | |
| 459 | #t #t #t #t #t #t #t #t | |
| 460 | #t #t #t #t #t #t #t #t | |
| 461 | #t #t #t #t #t #t #t #t)))) | |
| 462 | (pass-if (eqv? #x7FFFFFFF (list->integer '(#t #t #t #t #t #t #t | |
| 463 | #t #t #t #t #t #t #t #t | |
| 464 | #t #t #t #t #t #t #t #t | |
| 465 | #t #t #t #t #t #t #t #t)))) | |
| 466 | (pass-if (eqv? #xFFFFFFFF (list->integer '(#t #t #t #t #t #t #t #t | |
| 467 | #t #t #t #t #t #t #t #t | |
| 468 | #t #t #t #t #t #t #t #t | |
| 469 | #t #t #t #t #t #t #t #t)))) | |
| 470 | (pass-if (eqv? #x1FFFFFFFF (list->integer '(#t | |
| 471 | #t #t #t #t #t #t #t #t | |
| 472 | #t #t #t #t #t #t #t #t | |
| 473 | #t #t #t #t #t #t #t #t | |
| 474 | #t #t #t #t #t #t #t #t))))) | |
| 475 | ||
| 476 | ;; | |
| 477 | ;; list->integer | |
| 478 | ;; | |
| 479 | ||
| 480 | (with-test-prefix "list->integer" | |
| 481 | (pass-if (eqv? 0 (booleans->integer))) | |
| 482 | (pass-if (eqv? 6 (booleans->integer #t #t #f)))) |