Changeset 13757 in project


Ignore:
Timestamp:
03/14/09 19:58:26 (11 years ago)
Author:
Kon Lovett
Message:

Added tests. Fixed arg order, missing (, extra arg.

Location:
release/4/err5rs-arithmetic/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/4/err5rs-arithmetic/trunk/chicken-primitive-object-inlines.scm

    r13750 r13757  
    279279(define-inline (%fx<= x y) (##core#inline "C_fixnum_less_or_equal_p" x y))
    280280
    281 (define-inline (%fxclosed-right? l x h) (and (%< l x) (%fx<= x h)))
    282 (define-inline (%fxclosed? l x h) (and (%<= l x) (%fx<= x h)))
    283 (define-inline (%fxclosed-left? l x h) (and (%<= l x) (%fx< x h)))
     281(define-inline (%fxclosed-right? l x h) (and (fx%< l x) (%fx<= x h)))
     282(define-inline (%fxclosed? l x h) (and (%fx<= l x) (%fx<= x h)))
     283(define-inline (%fxclosed-left? l x h) (and (%fx<= l x) (%fx< x h)))
    284284
    285285(define-inline (%fxzero? fx) (%fx= 0 fx))
  • release/4/err5rs-arithmetic/trunk/err5rs-arithmetic-bitwise.scm

    r13716 r13757  
    256256(define-inline (%check-fixnum loc obj) (unless (%fixnum? obj) (error-type-fixnum loc obj)))
    257257
    258 (define-inline (%check-list loc obj) (unless (%list? obj) (error-type-list obj loc)))
    259 
    260 (define-inline (%check-integer loc obj) (unless (%integer? obj) (error-type-integer obj loc)))
     258(define-inline (%check-list loc obj) (unless (%list? obj) (error-type-list loc obj)))
     259
     260(define-inline (%check-integer loc obj) (unless (%integer? obj) (error-type-integer loc obj)))
    261261
    262262;;
     
    294294  (if (and (%number? obj) (%zero? obj)) #b0
    295295      (%boolean->bit obj) ) )
    296 
    297296
    298297;;;
     
    410409  (let ((negval? (%negative? n)))
    411410    (do ((mask (if negval? (%bitwise-not n) n) (%arithmetic-shift mask -1))
    412          (count (%fxsub1 c) (%fxsub1 c))
     411         (count (%fxsub1 c) (%fxsub1 count))
    413412         (revval 0 (%bitwise-ior (%arithmetic-shift revval 1) (%bitwise-and 1 mask))) )
    414         ((%negative? count) (if negval? (%bitwise-not revval) revval)) ) ) )
     413        ((%fxnegative? count) (if negval? (%bitwise-not revval) revval)) ) ) )
    415414
    416415#; ;DOESN'T WORK
     
    421420  (let* ((width (%fx- e s))
    422421         (mask (%bitwise-not (%arithmetic-shift -1 width)))
    423          (field (%bitwise-and mask (%arithmetic-shift n %fxneg s))) )
     422         (field (%bitwise-and mask (%arithmetic-shift n (%fxneg s)))) )
    424423    (%bitwise-ior
    425424     (%arithmetic-shift (*bitwise-reverse field width) s)
     
    515514  (%check-integer 'bitwise-copy-bit to)
    516515  (%check-word-bits-range 'bitwise-copy-bit index)
    517   (*bitwise-copy-bit to index (%boolean->bit* bit) bit) )
     516  (*bitwise-copy-bit to index (%boolean->bit* bit)) )
    518517
    519518(define (bitwise-bit-field value start end)
  • release/4/err5rs-arithmetic/trunk/tests/run.scm

    r13645 r13757  
    55
    66
    7 #;
    87(test-group "Fixnum Functions"
     8
     9  (test 4 (fx+# 2 2))
     10  (test -26 (fx+# 74 -100))
     11  (test 1073741823 (fx+# #x3ffffffe 1))
     12  (test -1073741824 (fx+# #x3fffffff 1))
     13  (test 4 (fx-# 6 2))
     14  (test -4 (fx-# 1000 1004))
     15  (test 2004 (fx-# 1000 -1004))
     16  (test -1073741824 (fx-# (- #x3fffffff) 1))
     17  (test 1073741823 (fx-# (- #x3fffffff) 2))
    918)
    1019
    11 #;
    1220(test-group "Flonum Functions"
     21
     22  (test -4.0 (flround -4.3))
     23  (test 4.0 (flround 3.5))
     24  (test 4.0 (flround (fl/ 7.0 2.0)))
     25  (test 7.0 (flround 7.0))
     26  (test-assert (fl=? -0.0 (flround -0.5)))
     27  (test-assert (flzero? (flround -0.5)))
     28  (test-assert (flzero? (flround -0.3)))
     29  (test -1.0 (flround -0.6))
     30  (test-assert (flzero? (flround 0.5)))
     31  (test-assert (flzero? (flround 0.3)))
     32  (test 1.0 (flround 0.6))
     33
     34  (current-test-epsilon 0.001)
     35
     36  ;; basic cases, fixnum base
     37  (test 1.0 (flexpt 0.0 0.0))
     38  (test 1.0 (flexpt 2.0 0.0))
     39  (test 2.0 (flexpt 2.0 1.0))
     40  (test 4.0 (flexpt 2.0 2.0))
     41  (test 9.0 (flexpt 3.0 2.0))
     42  (test 9.0 (flexpt 3.0 2.0))
     43  (test 10.0451 (flexpt 3.0 2.1))
     44  (test 1.1161 (flexpt 3.0 0.1))
     45  (test (fl/ 1.0 3.0) (flexpt 3.0 -1.0))
     46  (test (fl/ 1.0 9.0) (flexpt 3.0 -2.0))
     47  (test 0.09955 (flexpt 3.0 -2.1))
     48
     49  ;; basic cases, flonum base
     50  (test 1.0 (flexpt 0.0 0.0))
     51  (test 1.0 (flexpt 3.14 0.0))
     52  (test 3.14 (flexpt 3.14 1.0))
     53  (test 9.8596 (flexpt 3.14 2.0))
     54  (test 9.8596 (flexpt 3.14 2.0))
     55  (test 11.0548 (flexpt 3.14 2.1))
     56  (test 1.1212 (flexpt 3.14 0.1))
     57  (test 0.31847 (flexpt 3.14 -1.0))
     58  (test 0.10142 (flexpt 3.14 -2.0))
     59  (test 0.090458 (flexpt 3.14 -2.1))
     60
     61  ;; check overflows into bignums
     62  (test (string->number "1073741824") (flexpt 2.0 30.0))
     63  (test (string->number "2147483648") (flexpt 2.0 31.0))
     64  (test (string->number "4294967296") (flexpt 2.0 32.0))
     65  (test (string->number "4611686018427387904") (flexpt 2.0 62.0))
     66  (test (string->number "9223372036854775808") (flexpt 2.0 63.0))
     67  (test (string->number "18446744073709551616") (flexpt 2.0 64.0))
     68
     69  (define (one-followed-by-n-zeros n)
     70    (exact->inexact (string->number (string-append "1" (make-string n #\0)))))
     71
     72  ;; bug reported on the chicken list
     73  (test (one-followed-by-n-zeros 100) (flexpt 10.0 100.0))
     74
     75  ;; bignum base
     76  (test 1.0 (flexpt (one-followed-by-n-zeros 100) 0.0))
     77  (test (one-followed-by-n-zeros 100) (flexpt (one-followed-by-n-zeros 100) 1.0))
     78  (test (one-followed-by-n-zeros 200) (flexpt (one-followed-by-n-zeros 100) 2.0))
     79  (test 10000000000.0 (flexpt (one-followed-by-n-zeros 100) 0.1))
     80
     81  ;; cannot compute e^(pi*i) = -1 in domain FL
     82  (test-assert (flnan? (flexpt (flexp 1.0) (* (flacos -1.0) (flsqrt -1.0)))))
     83
     84  ;; rational rounding
     85  (test 1.0 (flround (fl/ 9.0 10.0)))
     86  (test 1.0 (flround (fl/ 6.0 10.0)))
     87  (test 0.0 (flround (fl/ 5.0 10.0)))
     88  (test 0.0 (flround (fl/ 1.0 10.0)))
     89  (test 0.0 (flround (fl/ 0.0 10.0)))
     90  (test 0.0 (flround (fl/ -1.0 10.0)))
     91  (test 0.0 (flround (fl/ -5.0 10.0)))
     92  (test -1.0 (flround (fl/ -6.0 10.0)))
     93  (test -1.0 (flround (fl/ -9.0 10.0)))
     94  (test-assert (flnan? (flround (fl/ (flexpt 10.0 10000.0) (fl+ (flexpt 10.0 10000.0) 1.0)))))
     95  (test 1.0 (flround (fl/ (flexpt 10.0 100.0) (fl+ (flexpt 10.0 100.0) 1.0))))
     96  (test (flexpt 10.0 9900.0) (flround (fl/ (fl+ 1.0 (flexpt 10.0 10000.0)) (flexpt 10.0 100.0))))
    1397)
    1498
    1599(test-group "Bitwise Functions"
    16100
    17   (test-assert #b011 (bitwise-if #b100 #b000 #b111))
    18   (test-assert #b100 (bitwise-if #b011 #b000 #b100))
     101  (test #b011 (bitwise-if #b100 #b000 #b111))
     102  (test #b100 (bitwise-if #b011 #b000 #b100))
    19103
    20   (test-assert #b100 (bitwise-if-not #b100 #b000 #b111))
    21   (test-assert #b000 (bitwise-if-not #b011 #b000 #b100))
    22   (test-assert #b110 (bitwise-if-not #b011 #b101 #b010))
     104  (test #b100 (bitwise-if-not #b100 #b000 #b111))
     105  (test #b000 (bitwise-if-not #b011 #b000 #b100))
     106  (test #b110 (bitwise-if-not #b011 #b101 #b010))
    23107
    24   (test-assert #t (bitwise-test? #b0010 #b0111))
    25   (test-assert #f (bitwise-test? #b0001 #b0100))
    26         (test-assert #f (bitwise-test? #b0100 #b1011))
    27         (test-assert #t (bitwise-test? #b0100 #b0111))
     108  (test #t (bitwise-test? #b0010 #b0111))
     109  (test #f (bitwise-test? #b0001 #b0100))
     110        (test #f (bitwise-test? #b0100 #b1011))
     111        (test #t (bitwise-test? #b0100 #b0111))
    28112
    29         (test-assert 4 (bitwise-bit-count #b10101010))
    30         (test-assert 0 (bitwise-bit-count 0))
    31         (test-assert 1 (bitwise-bit-count -2))
     113        (test 4 (bitwise-bit-count #b10101010))
     114        (test 0 (bitwise-bit-count 0))
     115        (test 1 (bitwise-bit-count -2))
    32116
    33         (test-assert 8 (bitwise-length #b10101010))
    34         (test-assert 0 (bitwise-length 0))
    35         (test-assert 4 (bitwise-length #b1111))
    36         (test-assert 5 (bitwise-length -27))
     117        (test 8 (bitwise-length #b10101010))
     118        (test 0 (bitwise-length 0))
     119        (test 4 (bitwise-length #b1111))
     120        (test 5 (bitwise-length -27))
    37121
    38         (test-assert #t (bitwise-bit-set? #b1101 0))
    39         (test-assert #f (bitwise-bit-set? #b1101 1))
    40         (test-assert #t (bitwise-bit-set? #b1101 2))
    41         (test-assert #t (bitwise-bit-set? #b1101 3))
    42         (test-assert #f (bitwise-bit-set? #b1101 4))
     122        (test #t (bitwise-bit-set? #b1101 0))
     123        (test #f (bitwise-bit-set? #b1101 1))
     124        (test #t (bitwise-bit-set? #b1101 2))
     125        (test #t (bitwise-bit-set? #b1101 3))
     126        (test #f (bitwise-bit-set? #b1101 4))
    43127
    44   (test-assert 0 (bitwise-last-bit-set 0))
    45   (test-assert 8 (bitwise-last-bit-set #b10111100))
    46   (test-assert machine-word-bits (bitwise-last-bit-set -1))
     128  (test 0 (bitwise-last-bit-set 0))
     129  (test 8 (bitwise-last-bit-set #b10111100))
     130  (test machine-word-bits (bitwise-last-bit-set -1))
    47131
    48         (test-assert -1 (bitwise-first-bit-set 0))
    49         (test-assert 0 (bitwise-first-bit-set -1))
    50         (test-assert 0 (bitwise-first-bit-set 1))
    51         (test-assert 1 (bitwise-first-bit-set -2))
    52         (test-assert 1 (bitwise-first-bit-set 2))
    53         (test-assert 0 (bitwise-first-bit-set -3))
    54         (test-assert 0 (bitwise-first-bit-set 3))
    55         (test-assert 2 (bitwise-first-bit-set -4))
    56         (test-assert 2 (bitwise-first-bit-set 4))
    57         (test-assert 0 (bitwise-first-bit-set -5))
    58         (test-assert 0 (bitwise-first-bit-set 5))
    59         (test-assert 1 (bitwise-first-bit-set -6))
    60         (test-assert 1 (bitwise-first-bit-set 6))
    61         (test-assert 0 (bitwise-first-bit-set -7))
    62         (test-assert 0 (bitwise-first-bit-set 7))
    63         (test-assert 3 (bitwise-first-bit-set -8))
    64         (test-assert 3 (bitwise-first-bit-set 8))
    65         (test-assert 0 (bitwise-first-bit-set -9))
    66         (test-assert 0 (bitwise-first-bit-set 9))
    67         (test-assert 1 (bitwise-first-bit-set -10))
    68         (test-assert 1 (bitwise-first-bit-set 10))
    69         (test-assert 0 (bitwise-first-bit-set -11))
    70         (test-assert 0 (bitwise-first-bit-set 11))
    71         (test-assert 2 (bitwise-first-bit-set -12))
    72         (test-assert 2 (bitwise-first-bit-set 12))
    73         (test-assert 0 (bitwise-first-bit-set -13))
    74         (test-assert 0 (bitwise-first-bit-set 13))
    75         (test-assert 1 (bitwise-first-bit-set -14))
    76         (test-assert 1 (bitwise-first-bit-set 14))
    77         (test-assert 0 (bitwise-first-bit-set -15))
    78         (test-assert 0 (bitwise-first-bit-set 15))
    79         (test-assert 4 (bitwise-first-bit-set -16))
    80         (test-assert 4 (bitwise-first-bit-set 16))
     132        (test -1 (bitwise-first-bit-set 0))
     133        (test 0 (bitwise-first-bit-set -1))
     134        (test 0 (bitwise-first-bit-set 1))
     135        (test 1 (bitwise-first-bit-set -2))
     136        (test 1 (bitwise-first-bit-set 2))
     137        (test 0 (bitwise-first-bit-set -3))
     138        (test 0 (bitwise-first-bit-set 3))
     139        (test 2 (bitwise-first-bit-set -4))
     140        (test 2 (bitwise-first-bit-set 4))
     141        (test 0 (bitwise-first-bit-set -5))
     142        (test 0 (bitwise-first-bit-set 5))
     143        (test 1 (bitwise-first-bit-set -6))
     144        (test 1 (bitwise-first-bit-set 6))
     145        (test 0 (bitwise-first-bit-set -7))
     146        (test 0 (bitwise-first-bit-set 7))
     147        (test 3 (bitwise-first-bit-set -8))
     148        (test 3 (bitwise-first-bit-set 8))
     149        (test 0 (bitwise-first-bit-set -9))
     150        (test 0 (bitwise-first-bit-set 9))
     151        (test 1 (bitwise-first-bit-set -10))
     152        (test 1 (bitwise-first-bit-set 10))
     153        (test 0 (bitwise-first-bit-set -11))
     154        (test 0 (bitwise-first-bit-set 11))
     155        (test 2 (bitwise-first-bit-set -12))
     156        (test 2 (bitwise-first-bit-set 12))
     157        (test 0 (bitwise-first-bit-set -13))
     158        (test 0 (bitwise-first-bit-set 13))
     159        (test 1 (bitwise-first-bit-set -14))
     160        (test 1 (bitwise-first-bit-set 14))
     161        (test 0 (bitwise-first-bit-set -15))
     162        (test 0 (bitwise-first-bit-set 15))
     163        (test 4 (bitwise-first-bit-set -16))
     164        (test 4 (bitwise-first-bit-set 16))
    81165
    82         (test-assert #b1 (bitwise-copy-bit 0 0 1))
    83         (test-assert #b100 (bitwise-copy-bit 0 2 1))
    84         (test-assert #b1011 (bitwise-copy-bit #b1111 2 0))
     166        (test #b1 (bitwise-copy-bit 0 0 1))
     167        (test #b100 (bitwise-copy-bit 0 2 1))
     168        (test #b1011 (bitwise-copy-bit #b1111 2 0))
    85169
    86         (test-assert #b1 (bitwise-copy-bit 0 0 #t))
    87         (test-assert #b100 (bitwise-copy-bit 0 2 #t))
    88         (test-assert #b1011 (bitwise-copy-bit #b1111 2 #f))
     170        (test #b1 (bitwise-copy-bit 0 0 #t))
     171        (test #b100 (bitwise-copy-bit 0 2 #t))
     172        (test #b1011 (bitwise-copy-bit #b1111 2 #f))
    89173
    90         (test-assert #b1010 (bitwise-bit-field #b1101101010 0 4))
    91         (test-assert #b10110 (bitwise-bit-field #b1101101010 4 9))
     174        (test #b1010 (bitwise-bit-field #b1101101010 0 4))
     175        (test #b10110 (bitwise-bit-field #b1101101010 4 9))
    92176
    93         (test-assert #b1101100000 (bitwise-copy-bit-field #b1101101010 0 4 0))
    94         (test-assert #b1101101111 (bitwise-copy-bit-field #b1101101010 0 4 -1))
    95         (test-assert #b110100111110000 (bitwise-copy-bit-field #b110100100010000 5 9 -1))
     177        (test #b1101100000 (bitwise-copy-bit-field #b1101101010 0 4 0))
     178        (test #b1101101111 (bitwise-copy-bit-field #b1101101010 0 4 -1))
     179        (test #b110100111110000 (bitwise-copy-bit-field #b110100100010000 5 9 -1))
    96180
    97         (test-assert #b10 (bitwise-rotate-bit-field #b0100 0 4 3) )
    98         (test-assert #b10 (bitwise-rotate-bit-field #b0100 0 4 -1))
     181        (test #b10 (bitwise-rotate-bit-field #b0100 0 4 3) )
     182        (test #b10 (bitwise-rotate-bit-field #b0100 0 4 -1))
    99183        ;                    9   5
    100         (test-assert #b110100010010000 (bitwise-rotate-bit-field #b110100100010000 5 9 -1))
    101         (test-assert #b110100000110000 (bitwise-rotate-bit-field #b110100100010000 5 9 1) )
     184        (test #b110100010010000 (bitwise-rotate-bit-field #b110100100010000 5 9 -1))
     185        (test #b110100000110000 (bitwise-rotate-bit-field #b110100100010000 5 9 1) )
    102186
    103         (test-assert #b11100101 (bitwise-reverse-bit-field #b10100111 0 8))
    104         (test-assert #b1011000 (bitwise-reverse-bit-field #b1010010 1 4))
     187        (test #b11100101 (bitwise-reverse-bit-field #b10100111 0 8))
     188        (test #b1011000 (bitwise-reverse-bit-field #b1010010 1 4))
    105189
    106         (test-assert 0 (bitwise-list->integer '()))
    107         (test-assert #b101 (bitwise-list->integer '(#t #f #t)))
     190        (test 0 (bitwise-list->integer '()))
     191        (test #b101 (bitwise-list->integer '(#t #f #t)))
    108192
    109         (test-assert '() (bitwise-integer->list #b0 0))
    110         (test-assert (make-list machine-word-bits #f) (bitwise-integer->list #b0))
    111         (test-assert '(#t #f #t) (bitwise-integer->list #b101))
    112         (test-assert '(#t #t #f #t) (bitwise-integer->list #b11101 4))
     193        (test '() (bitwise-integer->list #b0 0))
     194        (test (make-list machine-word-bits #f) (bitwise-integer->list #b0))
     195        (test '(#t #f #t) (bitwise-integer->list #b101))
     196        (test '(#t #t #f #t) (bitwise-integer->list #b11101 4))
    113197)
Note: See TracChangeset for help on using the changeset viewer.