home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / forth / pfe-0.000 / pfe-0 / pfe-0.9.13 / test / float.4th < prev    next >
Encoding:
Text File  |  1994-11-23  |  3.7 KB  |  132 lines

  1. \
  2. \ test/float.4th ---    Does a few tests of the floating point word set.
  3. \            Only the most basic things.
  4. \ (duz 05Aug93)
  5. \
  6.  
  7. CR .( floating point word set)
  8. CR .( =======================)
  9. CR
  10.  
  11. MARKER FORGET-FLOAT-TESTS
  12.  
  13. DECIMAL
  14.  
  15. CR .( testing F~) CR .(    )
  16.  
  17.  1.0E0         1.0E0         0E        F~ Y
  18.  1.0E0         1.1E0         0E        F~ N SPACE
  19.  
  20.  1.000000E0     1.000001E0     0.0000011E0    F~ Y
  21. -1.000000E0    -1.000001E0     0.0000011E0    F~ Y
  22.  1.000000E0     1.000001E0     0.0000009E0    F~ N
  23.  1.000000E0    -1.000001E0     0.0000011E0    F~ N
  24. -1.000000E0     1.000001E0     0.0000011E0    F~ N SPACE
  25.  
  26.  1.000000E10     1.000001E10    -0.0000006E0    F~ Y
  27. -1.000000E10    -1.000001E10    -0.0000006E0    F~ Y
  28.  1.000000E10     1.000001E10    -0.0000004E0    F~ N
  29. -1.000000E10     1.000001E10    -0.0000006E0    F~ N
  30.  1.000000E10    -1.000001E10    -0.0000006E0    F~ N SPACE D FD
  31.  
  32. : F=    0E F~ ;            \ identity
  33. : FEX    F= Y ;            \ 0 if two floats identical
  34. : FEQ    -1E-15 F~ Y ;        \ 0 if two floats have same value
  35.  
  36. CR .( floating point number input) CR .(    )
  37. 1E0    FDEPTH 1 = Y        \ interpreted floating number
  38. 1. D>F    FDEPTH 2 = Y        \ converted floating number from double
  39. FEX    D FD            \ should be exactly identical
  40.  
  41. : TEST>FLOAT    S" "        >FLOAT Y 0E0        FEX
  42.         S"      "    >FLOAT Y 0E0        FEX
  43.         S" 0E "        >FLOAT Y 0E0        FEX
  44.         S"  0E0   "    >FLOAT Y 0E0        FEX
  45.         S"  +0D  "    >FLOAT Y 0E0        FEX
  46.         S"  0E+0  "    >FLOAT Y 0E0        FEX
  47.         S"  1-1   "    >FLOAT Y 1E-1        FEX
  48.         S"  1+1   "    >FLOAT Y 1E1        FEX
  49.         S"  1      "    >FLOAT Y 1E0        FEX
  50.         S"  1.E+1  "    >FLOAT Y 1E1        FEX
  51.         S"  .1E+1  "    >FLOAT Y 1E0        FEX
  52.         S" 10.E-1"    >FLOAT Y 1E0        FEX
  53.         S"  -1.E+0"    >FLOAT Y -1E0        FEQ
  54.         S"  -.1E+1"    >FLOAT Y -1E0        FEQ
  55.         S" -10.E-1"    >FLOAT Y -1E0        FEQ
  56.         S" +1234.56E-9"    >FLOAT Y +1234.56E-9    FEQ
  57.         S" -1234.56E+9"    >FLOAT Y -1234.56E+9    FEQ ;
  58.  
  59. CR .(    ) TEST>FLOAT SPACE D FD
  60.  
  61. CR .( floating point constants and variables) CR .(    )
  62. +.1234567E+09 FCONSTANT FC1 FD    FC1 123456700. D>F FEX    FD
  63. -.7654321E-34 FCONSTANT FC2 FD    FC2 -.7654321E-34 FEX    FD    SPACE
  64.  
  65. \ constant name of different length to detect alignment problems
  66. +.1234567E+09 FCONSTANT FCONST1 FD  FCONST1 123456700. D>F FEX    FD
  67. -.7654321E-34 FCONSTANT FCONST2 FD  FCONST2 -.7654321E-34 FEX    FD    SPACE
  68.  
  69. FVARIABLE FV1        FC1 FV1     F! FD
  70. FVARIABLE FVARIA2    FC2 FVARIA2 F! FD    SPACE FD
  71.  
  72. FV1     F@ FC1 FEX
  73. FVARIA2 F@ FC2 FEX
  74.  
  75. FC2 FV1     F!  FV1     F@ FC2 FEX
  76. FC1 FVARIA2 F!  FVARIA2 F@ FC1 FEX    SPACE D FD
  77.  
  78. CR .( floating point stack operations) CR .(    )
  79. FC1 FC2        FDROP    FC1 F=                  Y FD    D SPACE
  80. FC1 FC2        FDUP    FC2 F=  FC2 F=  AND  FC1 F=  AND  Y FD    D SPACE
  81. FC1 FC2        FSWAP    FC1 F=  FC2 F=  AND          Y FD    D SPACE
  82. FC1 FC2        FOVER    FC1 F=  FC2 F=  AND  FC1 F=  AND  Y FD  D SPACE
  83. FC1 FC2    1E0    FROT    FC1 F=  1E0 F=  AND  FC2 F=  AND  Y FD    D SPACE
  84.  
  85.  
  86. CR .( testing REPRESENT) CR .(    )
  87. : TEST-REPRESENT
  88.     \ width --- ; F: r -- ;
  89.     FDUP F0< >R
  90.     PAD OVER REPRESENT  DROP
  91.     R> = Y  .
  92.     [CHAR] " EMIT PAD SWAP TYPE [CHAR] " EMIT SPACE SPACE ;
  93.  
  94.           0E0  1 TEST-REPRESENT
  95.           0E0  3 TEST-REPRESENT
  96.           0E0  7 TEST-REPRESENT
  97.           0E0 11 TEST-REPRESENT        CR .(    )
  98.  
  99.           1E0  1 TEST-REPRESENT
  100.          -1E0  3 TEST-REPRESENT
  101.           1E0  7 TEST-REPRESENT
  102.          -1E0 11 TEST-REPRESENT        CR .(    )
  103.  
  104.           1E1   1 TEST-REPRESENT
  105.          -1E3   3 TEST-REPRESENT
  106.           1E5   7 TEST-REPRESENT
  107.          -1E11 11 TEST-REPRESENT    CR .(    )
  108.  
  109. 0.950000001E1   1 TEST-REPRESENT
  110.     -0.9994E3   3 TEST-REPRESENT
  111. .9999999501E5   7 TEST-REPRESENT
  112.  -.99999999E30  9 TEST-REPRESENT    CR .(    )
  113.  
  114. 0.950000001E-1  1 TEST-REPRESENT
  115.     -0.9994E-3  3 TEST-REPRESENT
  116.   .99999995E-5  7 TEST-REPRESENT
  117.  -.99999999E-30 9 TEST-REPRESENT    CR .(    )
  118.  
  119.   123456789E1   1 TEST-REPRESENT
  120.  -123456789E3   3 TEST-REPRESENT
  121.   123456789E5   7 TEST-REPRESENT
  122.  -123456789E30  9 TEST-REPRESENT    CR .(    )
  123.  
  124.   123456789E-1  1 TEST-REPRESENT
  125.  -123456789E-3  3 TEST-REPRESENT
  126.   123456789E-5  7 TEST-REPRESENT
  127.  -123456789E-30 9 TEST-REPRESENT    CR .(    )
  128.  
  129. D FD
  130.  
  131. FORGET-FLOAT-TESTS
  132.