fp-test.sps

#!r6rs
(import 
  (rnrs)
  (ironscheme clr))

(define-syntax test
  (syntax-rules ()
    [(_ i o)
      (let* ((bp (get-bits i))
             (n (string->number i))
             (r (Double::ToString n)))
        (unless (string=? o bp)
          (display "Input:      ")
          (display i)
          (newline)
          (display "ToString:   ")
          (display r)
          (newline)          
          (display "Output:     ")
          (display n)
          (newline)
          (display "RoundTrip:  ")
          (display (fl=? n (string->number r)))
          (newline)
          (display "Expected:   ")
          (display (print64 o))
          (newline)
          (display "Actual:     ")
          (display (print64 bp))
          (newline)
          (newline)))]))
          
(define (print64 s)
  (clr-call String PadLeft s 64 #\0))          
          
(define (Double::ToString d)
  (clr-call Double ToString d "R" (clr-static-prop-get System.Globalization.CultureInfo InvariantCulture)))          

(define (get-bits fps)
  (define fp (string->number fps))
  (define bv (make-bytevector 8)) 
  (bytevector-ieee-double-native-set! bv 0 fp)
  (number->string (bytevector-u64-native-ref bv 0) 2))

;; generated from Petite Chez 8.4
(test "2.225073858507201e-308" "1111111111111111111111111111111111111111111111111111")
(test "2.2250738585072012e-308" "10000000000000000000000000000000000000000000000000000")
(test "1.3694713649464322631e-11" "11110110101110000111010111000000111011101101010111010010011101")
(test "9.3170532238714134438e+16" "100001101110100101100000010000110101111110110011111011001010001")
(test "0.84551240822557006" "11111111101011000011100111000000001001101101100001110011100000")
(test "1.8254370818746402660437411213933955878019332885742187" "11111111111101001101001111110110000011011110001110101010000011")
(test "7.8459735791271921e+65" "100110110011101110011010000000010001001110000010011000101001110")
(test "3.571e+266" "111011101000110001001100100010011000110000111010100000110101010")
(test "3.08984926168550152811e-32" "11100101100100000011011110010010000110011101100110010100111011")
(test "0.6822871999174000000" "11111111100101110101010100101111110111010000111111110100011011")
(test "0.6822871999174000001" "11111111100101110101010100101111110111010000111111110100011011")
(test "5e+125" "101101000000111101000101110110011000100000101001010000000111111")
(test "69e+267" "111011111000000101101111100101101100000110010011001010011011010")
(test "999e-026" "11101100101000001001111000001010101111111000011000011010011110")
(test "7861e-034" "11100110101111111000110101010001000001010001011110100111011000")
(test "75569e-254" "110000110101101001000110001011011001000111000110101010110011")
(test "928609e-261" "101011111011111000101101110101100110001000000000101111101111")
(test "9210917e+080" "101000111111101101000100011001000110100011111100110000000110010")
(test "84863171e+114" "101100101000000011011101001100011110101111011001000111100110111")
(test "653777767e+273" "111101001110010000000100010001111110010101100111010100010000001")
(test "5232604057e-298" "10000010100011001011011100010010110110000100100010100100000")
(test "27235667517e-109" "10101101110111110101000001100000100100110101100100111110110010")
(test "653532977297e-123" "10100011011001001001011010000010101010101111001101110001101000")
(test "3142213164987e-294" "10101111101001101000000100111011111101111001010001001101111")
(test "46202199371337e-072" "11001111010010100011111001111011011111101111010011010000011111")
(test "231010996856685e-073" "11001111000010100011111001111011011111101111010011010000011111")
(test "9324754620109615e+212" "110111101000011101011100110000001110101001110101111011011001010")
(test "78459735791271921e+049" "100110110011101110011010000000010001001110000010011000101001110")
(test "272104041512242479e+200" "110110100010011101110111011010010111111000001011111000010000111")
(test "6802601037806061975e+198" "110110011110011101110111011010010111111000001011111000010000111")
(test "20505426358836677347e-221" "1011000010000000100101001010101001011011010101010101110111010")
(test "836168422905420598437e-234" "1001110110010000001000000001110100110001010001010100111001010")
(test "4891559871276714924261e+222" "111001010000110111011001010111101110110100101001010001111000111")
(test "9e-265" "100100011101000001010010010001001111111001010000011001101010")
(test "85e-037" "11100010100110100110001100110011011100011000000000000101011010")
(test "623e+100" "101010101000110010000001010011000101111001110101000001111011111")
(test "3571e+263" "111011101000110001001100100010011000110000111010100000110101010")
(test "81661e+153" "110000010110111110010101000111000111101011010000101011110001110")
(test "920657e-023" "11110001100101001110101001100110000101110110111101111001101100")
(test "4603285e-024" "11110001010101001110101001100110000101110110111101111001101100")
(test "87575437e-309" "101101110000001110011001000000110000000100000010101101100")
(test "245540327e+122" "101101100000001101101100010001100011110000110001100010111001011")
(test "6138508175e+120" "101101011100001101101100010001100011110000110001100010111001011")
(test "83356057653e+193" "110101001000101010001001110011011011010111011100010101000011000")
(test "619534293513e+124" "101110000100001000011000010000000110000001111111110000011110001")
(test "2335141086879e+218" "110111111000011010000001010000111001001001100101100000111101110")
(test "36167929443327e-159" "10000110111100111001110111110000101011001100110010100011111100")
(test "609610927149051e-255" "111000010000010000100111001110110001100010010001100010110001")
(test "3743626360493413e-165" "10000011101000100000100011101001010111101011011011111011111001")
(test "94080055902682397e-242" "1000100110110010010011000000111100011100111100110011011001010")
(test "899810892172646163e+283" "111111001101010110111110101000111111010000001010101111000000011")
(test "7120190517612959703e+120" "101110011000011001000100000110111001101010110001001100111111101")
(test "25188282901709339043e-252" "111110100100000001011001101011110011110110110010101010000100")
(test "308984926168550152811e-052" "11100101100100000011011110010010000110011101100110010100111011")
(test "6372891218502368041059e+064" "101000111000000011001110000010001111101101110110011100011111110")