Changeset 26597 in project


Ignore:
Timestamp:
04/29/12 20:52:50 (8 years ago)
Author:
sjamaan
Message:

numbers: Various fixes for flonum overflow when comparing with ratnums or fixnums

Location:
release/4/numbers/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/numbers/trunk/numbers.scm

    r26595 r26597  
    553553     (switchq (%check-number y)
    554554       [FIX (fx= x y)]
    555        [FLO (fp= (%fix->flo x) y)]
     555       [FLO (%= x (%flo->rat '= y))]      ; Compare as ratnums (overflow)
    556556       [BIG #f] ;; Needs bignum representation?  Can't be equal to a fixnum!
    557557       [RAT #f] ;; Rats are never x/1, because those are normalised to just x
     
    560560    [FLO
    561561     (switchq (%check-number y)
    562        [FIX (fp= x (%fix->flo y))]
     562       [FIX (%= (%flo->rat '= x) y)]      ; Compare as ratnums (overflow)
    563563       [FLO (fp= x y)]
    564564       [BIG (and (%flo-integer? x) (= (%flo->integer x) y))]
     
    635635     (switchq (%check-number y)
    636636       (FIX (fx> x y))
    637        (FLO (fp> (%fix->flo x) y))
     637       ;; Compare as ratnum, to prevent overflows
     638       (FLO (or (fp= y -inf)
     639                (and (not (fp= y +inf)) (fp= y y)
     640                     (%> x (%flo->rat loc y) loc))))
    638641       ;;   x neg?   y neg?   x > y?   reason
    639642       ;;  ---------------------------------------------------------------
     
    652655    (FLO
    653656     (switchq (%check-number y)
    654        (FIX (fp> x (%fix->flo y)))
    655657       (FLO (fp> x y))
    656        (BIG (or (fp= x +inf)
    657                 (and (not (fp= x -inf))
    658                      (%> (%flo->rat loc x) y loc)))) ; Compare as ratnums
    659        ;; a/b > c/d  when  a*d > b*c  [with b = 1]
    660        (RAT (%> (%* x (rat-denominator y))
    661                 (rat-numerator y) loc))
    662658       (COMP (bad-complex/o loc y))
    663        (else (bad-number loc y)) ) )
     659       (NONE (bad-number loc y))
     660       ;; Compare as ratnums, to avoid errors when overflowing
     661       ;; (this can happen for bignums, but also for fixnums on 64-bit)
     662       (else (or (fp= x +inf)
     663                 (and (not (fp= x -inf)) (fp= x x)
     664                      (%> (%flo->rat loc x) y loc)))) ) )
    664665    (BIG
    665666     (switchq (%check-number y)
     
    674675       (FIX (not (%big-negative? x)))
    675676       (FLO (or (fp= y -inf)
    676                 (and (not (fp= y +inf))
     677                (and (not (fp= y +inf)) (fp= y y)
    677678                     (%> x (%flo->rat loc y) loc)))) ; Compare as ratnums
    678679       (BIG (fx> (%big-comp-big x y) 0))
     
    687688       (RAT (%> (%* (rat-numerator x) (rat-denominator y))
    688689                (%* (rat-denominator x) (rat-numerator y)) loc))
     690       (FLO (or (fp= y -inf)
     691                (and (not (fp= y +inf)) (fp= y y)
     692                     (%> x (%flo->rat loc y) loc)))) ; Compare as ratnums
    689693       (COMP (bad-complex/o loc y))
    690694       (NONE (bad-number loc y))
     
    711715     (switchq (%check-number y)
    712716       (FIX (fx< x y))
    713        (FLO (fp< (%fix->flo x) y))
     717       ;; Compare as ratnum, to prevent overflows
     718       (FLO (or (fp= y +inf)
     719                (and (not (fp= y -inf)) (fp= y y)
     720                     (%< x (%flo->rat loc y) loc))))
    714721       ;;   x neg?   y neg?   x < y?   reason
    715722       ;;  ---------------------------------------------------------------
     
    728735    (FLO
    729736     (switchq (%check-number y)
    730        (FIX (fp< x (%fix->flo y)))
    731737       (FLO (fp< x y))
    732        (BIG (or (fp= x -inf)
    733                 (and (not (fp= x +inf))
    734                      (%< (%flo->rat loc x) y loc)))) ; Compare as ratnums
    735        ;; a/b < c/d  when  a*d < b*c  [with b = 1]
    736        (RAT (%< (%* x (rat-denominator y))
    737                 (rat-numerator y) loc))
    738738       (COMP (bad-complex/o loc y))
    739        (else (bad-number loc y)) ) )
     739       (NONE (bad-number loc y))
     740       ;; Compare as ratnums, to avoid errors when overflowing
     741       ;; (this can happen for bignums, but also for fixnums on 64-bit)
     742       (else (or (fp= x -inf)
     743                (and (not (fp= x +inf)) (fp= x x)
     744                     (%< (%flo->rat loc x) y loc))))) )
    740745    (BIG
    741746     (switchq (%check-number y)
     
    750755       (FIX (%big-negative? x))
    751756       (FLO (or (fp= y +inf)
    752                 (and (not (fp= y -inf))
     757                (and (not (fp= y -inf)) (fp= y y)
    753758                     (%< x (%flo->rat loc y) loc)))) ; Compare as ratnums
    754759       (BIG (fx< (%big-comp-big x y) 0))
     
    764769                (%* (rat-denominator x) (rat-numerator y)) loc))
    765770       (COMP (bad-complex/o loc y))
     771       (FLO (or (fp= y +inf)
     772                (and (not (fp= y -inf)) (fp= y y)
     773                     (%< x (%flo->rat loc y) loc)))) ; Compare as ratnums
    766774       (NONE (bad-number loc y))
    767775       ;; a/b < c/d  when  a*d < b*c  [with d = 1]
  • release/4/numbers/trunk/tests/numbers-test.scm

    r26595 r26597  
    295295 (test "=: !fix/fix" #f (= 33 34))
    296296 (test "=: !fix/flo" #f (= 33 33.1))
     297 (test "=: !fix/flo (overflow)" #f (= 9007199254740993 9007199254740993.0))
    297298 (test "=: flo/fix" #t (= 33.0 33))
     299 (test "=: !flo/fix (overflow)" #f (= 9007199254740993.0 9007199254740993))
    298300 (test "=: flo/flo" #t (= 33.1 33.1))
    299301 (test "=: !flo/flo" #f (= 33.1 -33.1))
     
    354356 (test ">: !fix/flo" #f (> 33 33.0))
    355357 (test ">=: !fix/flo" #t (>= 33 33.0))
     358 (test ">: fix/flo (flo overflow), on 64 bits"
     359       #t (> 9007199254740993 9007199254740992.0)) ; 2^53
     360 (test ">=: fix/flo (flo overflow), on 64 bits"
     361       #t (>= 9007199254740993 9007199254740992.0))
     362 (test ">: fix/flo (flo underflow), on 64 bits"
     363       #f (> -9007199254740992 -9007199254740991.0))
     364 (test ">=: fix/flo (flo underflow), on 64 bits"
     365       #f (>= -9007199254740992 -9007199254740991.0))
    356366 (test ">: fix/big" #t (> 44 b2))
    357367 (test ">=: fix/big" #t (>= 44 b2))
     
    375385 (test ">: flo/big" #t (> 44.0 b2))
    376386 (test ">=: flo/big" #t (>= 44.0 b2))
     387 (test ">: flo/fix (flo overflow), on 64 bits"
     388       #f (> 9007199254740992.0 9007199254740993)) ; 2^53
     389 (test ">=: flo/fix (flo overflow), on 64 bits"
     390       #f (>= 9007199254740992.0 9007199254740993))
     391 (test ">: fix/flo (flo underflow), on 64 bits"
     392       #t (> -9007199254740991.0 -9007199254740992))
     393 (test ">=: fix/flo (flo underflow), on 64 bits"
     394       #t (>= -9007199254740991.0 -9007199254740992))
    377395 (test ">: flo/big (flo overflow)"
    378396       #f (> 1237940039285380274899124224.0 1237940039285380274899124225))
     
    429447 (test ">: !rat/rat" #f (> r1 r2))
    430448 (test ">=: !rat/rat" #f (>= r1 r2))
     449 (test ">: rat/flo (flo overflow)"
     450       #t (> 1237940039285380274899124224/1237940039285380274899124223 1.0))
     451 (test ">: rat/flo (flo overflow)"
     452       #f (> 1237940039285380274899124224/1237940039285380274899124223 1.5))
     453 (test ">=: rat/flo (flo overflow)"
     454       #t (>= 1237940039285380274899124224/1237940039285380274899124223 1.0))
     455 (test ">=: rat/flo (flo overflow)"
     456       #f (>= 1237940039285380274899124224/1237940039285380274899124223 1.5))
     457 (test ">: rat/flo (flo underflow)"
     458       #f (> -1237940039285380274899124224/1237940039285380274899124223 -1.0))
     459 (test ">: rat/flo (flo underflow)"
     460       #t (> -1237940039285380274899124224/1237940039285380274899124223 -1.5))
     461 (test ">=: rat/flo (flo underflow)"
     462       #f (>= -1237940039285380274899124224/1237940039285380274899124223 -1.0))
     463 (test ">=: rat/flo (flo underflow)"
     464       #t (>= -1237940039285380274899124224/1237940039285380274899124223 -1.5))
    431465)
    432466
     
    452486 (test "<: fix/flo" #t (< 33 44.0))
    453487 (test "<=: fix/flo" #t (<= 33 44.0))
     488 (test "<: fix/flo (flo overflow), on 64 bits"
     489       #f (< 9007199254740993 9007199254740992.0)) ; 2^53
     490 (test "<=: fix/flo (flo overflow), on 64 bits"
     491       #f (< 9007199254740993 9007199254740992.0))
     492 (test "<: fix/flo (flo underflow), on 64 bits"
     493       #t (< -9007199254740993 -9007199254740992.0))
     494 (test "<=: fix/flo (flo underflow), on 64 bits"
     495       #t (<= -9007199254740993 -9007199254740992.0))
    454496 (test "<: !fix/flo" #f (< 33.0 33.0))
    455497 (test "<=: fix/flo" #t (<= 33.0 33.0))
     
    477519 (test "<: flo/big" #t (< 33.0 b1))
    478520 (test "<=: flo/big" #t (<= 33.0 b1))
     521 (test "<: flo/fix (flo overflow), on 64 bits"
     522       #t (< 9007199254740992.0 9007199254740993)) ; 2^53
     523 (test "<=: flo/fix (flo overflow), on 64 bits"
     524       #t (< 9007199254740992.0 9007199254740993))
     525 (test "<: flo/fix (flo underflow), on 64 bits"
     526       #f (< -9007199254740992.0 -9007199254740993))
     527 (test "<=: flo/fix (flo underflow), on 64 bits"
     528       #f (<= -9007199254740992.0 -9007199254740993))
    479529 (test "<: flo/big (flo overflow)"
    480530       #t (< 1237940039285380274899124224.0 1237940039285380274899124225))
     
    531581 (test "<: rat/rat" #t (< r1 r2))
    532582 (test "<=: rat/rat" #t (<= r1 r2))
     583 (test "<: rat/flo (flo overflow)"
     584       #f (< 1237940039285380274899124224/1237940039285380274899124223 1.0))
     585 (test "<: rat/flo (flo overflow)"
     586       #t (< 1237940039285380274899124224/1237940039285380274899124223 1.5))
     587 (test "<=: rat/flo (flo overflow)"
     588       #f (<= 1237940039285380274899124224/1237940039285380274899124223 1.0))
     589 (test "<=: rat/flo (flo overflow)"
     590       #t (<= 1237940039285380274899124224/1237940039285380274899124223 1.5))
     591 (test "<: rat/flo (flo underflow)"
     592       #t (< -1237940039285380274899124224/1237940039285380274899124223 -1.0))
     593 (test "<: rat/flo (flo underflow)"
     594       #f (< -1237940039285380274899124224/1237940039285380274899124223 -1.5))
     595 (test "<=: rat/flo (flo underflow)"
     596       #t (<= -1237940039285380274899124224/1237940039285380274899124223 -1.0))
     597 (test "<=: rat/flo (flo underflow)"
     598       #f (<= -1237940039285380274899124224/1237940039285380274899124223 -1.5))
    533599)
    534600
Note: See TracChangeset for help on using the changeset viewer.