| 1 | #!./perl |
| 2 | |
| 3 | print "1..56\n"; |
| 4 | |
| 5 | # First test whether the number stringification works okay. |
| 6 | # (Testing with == would exercise the IV/NV part, not the PV.) |
| 7 | |
| 8 | $a = 1; "$a"; |
| 9 | print $a eq "1" ? "ok 1\n" : "not ok 1 # $a\n"; |
| 10 | |
| 11 | $a = -1; "$a"; |
| 12 | print $a eq "-1" ? "ok 2\n" : "not ok 2 # $a\n"; |
| 13 | |
| 14 | $a = 1.; "$a"; |
| 15 | print $a eq "1" ? "ok 3\n" : "not ok 3 # $a\n"; |
| 16 | |
| 17 | $a = -1.; "$a"; |
| 18 | print $a eq "-1" ? "ok 4\n" : "not ok 4 # $a\n"; |
| 19 | |
| 20 | $a = 0.1; "$a"; |
| 21 | print $a eq "0.1" ? "ok 5\n" : "not ok 5 # $a\n"; |
| 22 | |
| 23 | $a = -0.1; "$a"; |
| 24 | print $a eq "-0.1" ? "ok 6\n" : "not ok 6 # $a\n"; |
| 25 | |
| 26 | $a = .1; "$a"; |
| 27 | print $a eq "0.1" ? "ok 7\n" : "not ok 7 # $a\n"; |
| 28 | |
| 29 | $a = -.1; "$a"; |
| 30 | print $a eq "-0.1" ? "ok 8\n" : "not ok 8 # $a\n"; |
| 31 | |
| 32 | $a = 10.01; "$a"; |
| 33 | print $a eq "10.01" ? "ok 9\n" : "not ok 9 # $a\n"; |
| 34 | |
| 35 | $a = 1e3; "$a"; |
| 36 | print $a eq "1000" ? "ok 10\n" : "not ok 10 # $a\n"; |
| 37 | |
| 38 | $a = 10.01e3; "$a"; |
| 39 | print $a eq "10010" ? "ok 11\n" : "not ok 11 # $a\n"; |
| 40 | |
| 41 | $a = 0b100; "$a"; |
| 42 | print $a eq "4" ? "ok 12\n" : "not ok 12 # $a\n"; |
| 43 | |
| 44 | $a = 0100; "$a"; |
| 45 | print $a eq "64" ? "ok 13\n" : "not ok 13 # $a\n"; |
| 46 | |
| 47 | $a = 0x100; "$a"; |
| 48 | print $a eq "256" ? "ok 14\n" : "not ok 14 # $a\n"; |
| 49 | |
| 50 | $a = 1000; "$a"; |
| 51 | print $a eq "1000" ? "ok 15\n" : "not ok 15 # $a\n"; |
| 52 | |
| 53 | # more hex and binary tests below starting at 51 |
| 54 | |
| 55 | # Okay, now test the numerics. |
| 56 | # We may be assuming too much, given the painfully well-known floating |
| 57 | # point sloppiness, but the following are still quite reasonable |
| 58 | # assumptions which if not working would confuse people quite badly. |
| 59 | |
| 60 | $a = 1; "$a"; # Keep the stringification as a potential troublemaker. |
| 61 | print $a + 1 == 2 ? "ok 16\n" : "not ok 16 #" . $a + 1 . "\n"; |
| 62 | # Don't know how useful printing the stringification of $a + 1 really is. |
| 63 | |
| 64 | $a = -1; "$a"; |
| 65 | print $a + 1 == 0 ? "ok 17\n" : "not ok 17 #" . $a + 1 . "\n"; |
| 66 | |
| 67 | $a = 1.; "$a"; |
| 68 | print $a + 1 == 2 ? "ok 18\n" : "not ok 18 #" . $a + 1 . "\n"; |
| 69 | |
| 70 | $a = -1.; "$a"; |
| 71 | print $a + 1 == 0 ? "ok 19\n" : "not ok 19 #" . $a + 1 . "\n"; |
| 72 | |
| 73 | sub ok { # Can't assume too much of floating point numbers. |
| 74 | my ($a, $b, $c) = @_; |
| 75 | abs($a - $b) <= $c; |
| 76 | } |
| 77 | |
| 78 | $a = 0.1; "$a"; |
| 79 | print ok($a + 1, 1.1, 0.05) ? "ok 20\n" : "not ok 20 #" . $a + 1 . "\n"; |
| 80 | |
| 81 | $a = -0.1; "$a"; |
| 82 | print ok($a + 1, 0.9, 0.05) ? "ok 21\n" : "not ok 21 #" . $a + 1 . "\n"; |
| 83 | |
| 84 | $a = .1; "$a"; |
| 85 | print ok($a + 1, 1.1, 0.005) ? "ok 22\n" : "not ok 22 #" . $a + 1 . "\n"; |
| 86 | |
| 87 | $a = -.1; "$a"; |
| 88 | print ok($a + 1, 0.9, 0.05) ? "ok 23\n" : "not ok 23 #" . $a + 1 . "\n"; |
| 89 | |
| 90 | $a = 10.01; "$a"; |
| 91 | print ok($a + 1, 11.01, 0.005) ? "ok 24\n" : "not ok 24 #" . $a + 1 . "\n"; |
| 92 | |
| 93 | $a = 1e3; "$a"; |
| 94 | print $a + 1 == 1001 ? "ok 25\n" : "not ok 25 #" . $a + 1 . "\n"; |
| 95 | |
| 96 | $a = 10.01e3; "$a"; |
| 97 | print $a + 1 == 10011 ? "ok 26\n" : "not ok 26 #" . $a + 1 . "\n"; |
| 98 | |
| 99 | $a = 0b100; "$a"; |
| 100 | print $a + 1 == 0b101 ? "ok 27\n" : "not ok 27 #" . $a + 1 . "\n"; |
| 101 | |
| 102 | $a = 0100; "$a"; |
| 103 | print $a + 1 == 0101 ? "ok 28\n" : "not ok 28 #" . $a + 1 . "\n"; |
| 104 | |
| 105 | $a = 0x100; "$a"; |
| 106 | print $a + 1 == 0x101 ? "ok 29\n" : "not ok 29 #" . $a + 1 . "\n"; |
| 107 | |
| 108 | $a = 1000; "$a"; |
| 109 | print $a + 1 == 1001 ? "ok 30\n" : "not ok 30 #" . $a + 1 . "\n"; |
| 110 | |
| 111 | # back to some basic stringify tests |
| 112 | # we expect NV stringification to work according to C sprintf %.*g rules |
| 113 | |
| 114 | if ($^O eq 'os2') { # In the long run, fix this. For 5.8.0, deal. |
| 115 | $a = 0.01; "$a"; |
| 116 | print $a eq "0.01" || $a eq '1e-02' ? "ok 31\n" : "not ok 31 # $a\n"; |
| 117 | |
| 118 | $a = 0.001; "$a"; |
| 119 | print $a eq "0.001" || $a eq '1e-03' ? "ok 32\n" : "not ok 32 # $a\n"; |
| 120 | |
| 121 | $a = 0.0001; "$a"; |
| 122 | print $a eq "0.0001" || $a eq '1e-04' ? "ok 33\n" : "not ok 33 # $a\n"; |
| 123 | } else { |
| 124 | $a = 0.01; "$a"; |
| 125 | print $a eq "0.01" ? "ok 31\n" : "not ok 31 # $a\n"; |
| 126 | |
| 127 | $a = 0.001; "$a"; |
| 128 | print $a eq "0.001" ? "ok 32\n" : "not ok 32 # $a\n"; |
| 129 | |
| 130 | $a = 0.0001; "$a"; |
| 131 | print $a eq "0.0001" ? "ok 33\n" : "not ok 33 # $a\n"; |
| 132 | } |
| 133 | |
| 134 | $a = 0.00009; "$a"; |
| 135 | print $a eq "9e-05" || $a eq "9e-005" ? "ok 34\n" : "not ok 34 # $a\n"; |
| 136 | |
| 137 | $a = 1.1; "$a"; |
| 138 | print $a eq "1.1" ? "ok 35\n" : "not ok 35 # $a\n"; |
| 139 | |
| 140 | $a = 1.01; "$a"; |
| 141 | print $a eq "1.01" ? "ok 36\n" : "not ok 36 # $a\n"; |
| 142 | |
| 143 | $a = 1.001; "$a"; |
| 144 | print $a eq "1.001" ? "ok 37\n" : "not ok 37 # $a\n"; |
| 145 | |
| 146 | $a = 1.0001; "$a"; |
| 147 | print $a eq "1.0001" ? "ok 38\n" : "not ok 38 # $a\n"; |
| 148 | |
| 149 | $a = 1.00001; "$a"; |
| 150 | print $a eq "1.00001" ? "ok 39\n" : "not ok 39 # $a\n"; |
| 151 | |
| 152 | $a = 1.000001; "$a"; |
| 153 | print $a eq "1.000001" ? "ok 40\n" : "not ok 40 # $a\n"; |
| 154 | |
| 155 | $a = 0.; "$a"; |
| 156 | print $a eq "0" ? "ok 41\n" : "not ok 41 # $a\n"; |
| 157 | |
| 158 | $a = 100000.; "$a"; |
| 159 | print $a eq "100000" ? "ok 42\n" : "not ok 42 # $a\n"; |
| 160 | |
| 161 | $a = -100000.; "$a"; |
| 162 | print $a eq "-100000" ? "ok 43\n" : "not ok 43 # $a\n"; |
| 163 | |
| 164 | $a = 123.456; "$a"; |
| 165 | print $a eq "123.456" ? "ok 44\n" : "not ok 44 # $a\n"; |
| 166 | |
| 167 | $a = 1e34; "$a"; |
| 168 | unless ($^O eq 'posix-bc') |
| 169 | { print $a eq "1e+34" || $a eq "1e+034" ? "ok 45\n" : "not ok 45 # $a\n"; } |
| 170 | else |
| 171 | { print "ok 45 # skipped on $^O\n"; } |
| 172 | |
| 173 | # see bug #15073 |
| 174 | |
| 175 | $a = 0.00049999999999999999999999999999999999999; |
| 176 | $b = 0.0005000000000000000104; |
| 177 | print $a <= $b ? "ok 46\n" : "not ok 46\n"; |
| 178 | |
| 179 | if ($^O eq 'VMS' || |
| 180 | (pack("d", 1) =~ /^[\x80\x10]\x40/) # VAX D_FLOAT, G_FLOAT. |
| 181 | ) { |
| 182 | # VMS blows up when configured with D_FLOAT (but with G_FLOAT or IEEE works |
| 183 | # fine). The test should probably make the number of 0's a function of |
| 184 | # NV_DIG, but that's not in Config and we probably don't want to suck Config |
| 185 | # into a base test anyway. |
| 186 | print "ok 47 # skipped on $^O\n"; |
| 187 | } else { |
| 188 | $a = 0.00000000000000000000000000000000000000000000000000000000000000000001; |
| 189 | print $a > 0 ? "ok 47\n" : "not ok 47\n"; |
| 190 | } |
| 191 | |
| 192 | $a = 80000.0000000000000000000000000; |
| 193 | print $a == 80000.0 ? "ok 48\n" : "not ok 48\n"; |
| 194 | |
| 195 | $a = 1.0000000000000000000000000000000000000000000000000000000000000000000e1; |
| 196 | print $a == 10.0 ? "ok 49\n" : "not ok 49\n"; |
| 197 | |
| 198 | # From Math/Trig - number has to be long enough to exceed at least DBL_DIG |
| 199 | |
| 200 | $a = 57.295779513082320876798154814169; |
| 201 | print ok($a*10,572.95779513082320876798154814169,1e-10) ? "ok 50\n" : |
| 202 | "not ok 50 # $a\n"; |
| 203 | |
| 204 | # Allow uppercase base markers (#76296) |
| 205 | |
| 206 | $a = 0Xabcdef; "$a"; |
| 207 | print $a eq "11259375" ? "ok 51\n" : "not ok 51 # $a\n"; |
| 208 | |
| 209 | $a = 0XFEDCBA; "$a"; |
| 210 | print $a eq "16702650" ? "ok 52\n" : "not ok 52 # $a\n"; |
| 211 | |
| 212 | $a = 0B1101; "$a"; |
| 213 | print $a eq "13" ? "ok 53\n" : "not ok 53 # $a\n"; |
| 214 | |
| 215 | # 0odddd octal constants |
| 216 | |
| 217 | $a = 0o100; "$a"; |
| 218 | print $a eq "64" ? "ok 54\n" : "not ok 54 # $a\n"; |
| 219 | |
| 220 | $a = 0o100; "$a"; |
| 221 | print $a + 1 == 0o101 ? "ok 55\n" : "not ok 55 #" . $a + 1 . "\n"; |
| 222 | |
| 223 | $a = 0O1703; "$a"; |
| 224 | print $a eq "963" ? "ok 56\n" : "not ok 56 # $a\n"; |