1# -*- mode: perl; -*- 2 3use strict; 4use warnings; 5 6use Test::More tests => 41301; 7 8use Math::BigInt; 9 10use Math::Complex (); 11 12my $inf = $Math::Complex::Inf; 13my $nan = $inf - $inf; 14 15my $scalar_util_ok = eval { require Scalar::Util; }; 16Scalar::Util -> import('refaddr') if $scalar_util_ok; 17 18diag "Skipping some tests since Scalar::Util is not installed." 19 unless $scalar_util_ok; 20 21# Return 1 if the input argument is +inf or -inf, and "" otherwise. 22 23sub isinf { 24 my $x = shift; 25 return $x == $inf || $x == -$inf; 26} 27 28# Return 1 if the input argument is a nan (Not-a-Number), and "" otherwise. 29 30sub isnan { 31 my $x = shift; 32 return $x != $x; 33} 34 35# Convert a Perl scalar to a Math::BigInt object. This function is used for 36# consistent comparisons. For instance, a Not-a-Number might be stringified to 37# 'nan', but Math::BigInt uses 'NaN'. 38 39sub pl2mbi { 40 my $x = shift; 41 return Math::BigInt -> binf('+') if $x == $inf; 42 return Math::BigInt -> binf('-') if $x == -$inf; 43 return Math::BigInt -> bnan() if isnan($x); 44 return Math::BigInt -> new($x); 45} 46 47# Does a truncated division (T-division). 48 49sub tdiv { 50 die "Usage: fdiv X Y\n" if @_ != 2; 51 52 #no integer; 53 54 my $x = shift; # numerator 55 my $y = shift; # denominator 56 57 # Convert Perl strings representing nan, +inf, and -inf into Perl numbers. 58 59 if ($x =~ /^\s*nan\s*$/i) { 60 $x = $nan; 61 } elsif ($x =~ /^\s*([+-]?)inf(inity)?\s*$/i) { 62 $x = $1 eq '-' ? -$inf : $inf; 63 } 64 65 if ($y =~ /^\s*nan\s*$/i) { 66 $y = $nan; 67 } elsif ($y =~ /^\s*([+-]?)inf(inity)?\s*$/i) { 68 $y = $1 eq '-' ? -$inf : $inf; 69 } 70 71 # If any input is nan, the output is nan. 72 73 if (isnan($x) || isnan($y)) { 74 return wantarray ? ($nan, $nan) : $nan; 75 } 76 77 # Divide by zero and modulo zero. 78 79 if ($y == 0) { 80 81 # Core Perl gives an "Illegal division by zero" error whenever the 82 # denominator is zero. Math::BigInt, however, has a different 83 # convention. 84 85 my $q = $x < 0 ? -$inf 86 : $x > 0 ? $inf 87 : $nan; 88 my $r = $x; 89 return wantarray ? ($q, $r) : $q; 90 } 91 92 # Numerator is +/-infinity, and denominator is finite and non-zero. 93 94 if (isinf($x)) { 95 my $q = int($x / $y); 96 my $r = $x - $y * $q; 97 return wantarray ? ($q, $r) : $q; 98 99 if (isinf($y)) { 100 return wantarray ? ($nan, $nan) : $nan; 101 } else { 102 if (($x <=> 0) == ($y <=> 0)) { 103 return wantarray ? ($inf, $nan) : $inf; 104 } else { 105 return wantarray ? (-$inf, $nan) : -$inf; 106 } 107 } 108 } 109 110 # Denominator is +/- infinity, and the numerator is finite. 111 # 112 # Core Perl: 5 % Inf = 5 113 # -5 % -Inf = -5 114 # -5 % Inf = -5 115 # 5 % -Inf = 5 116 117 if (isinf($y)) { 118 return wantarray ? (0, $x) : 0; 119 } 120 121 # Do a truncated division. 122 123 my $q = int($x / $y); 124 my $r = $x - $y * $q; 125 126 return wantarray ? ($q, $r) : $q; 127} 128 129# Tests where the invocand and the argument are two different objects. 130 131#for my $num (-20 .. 20) { 132# for my $den (-20 .. -1, 1 .. 20) { 133for my $num (-$inf, -20 .. 20, $inf, $nan) { 134 for my $den (-$inf, -20 .. 20, $inf, $nan) { 135 136 # Compute expected output values. 137 138 my ($quo, $rem) = tdiv($num, $den); 139 140 ####################################################################### 141 # btdiv() in list context. 142 ####################################################################### 143 144 { 145 note(qq|\n(\$quo, \$rem) = | . 146 qq|Math::BigInt -> new("$num") -> btdiv("$den")\n\n|); 147 148 # Input values as objects. 149 150 my $mbi_num = Math::BigInt -> new("$num"); 151 my $mbi_den = Math::BigInt -> new("$den"); 152 153 # Get addresses for later tests. 154 155 my ($mbi_num_addr, $mbi_den_addr); 156 $mbi_num_addr = refaddr($mbi_num) if $scalar_util_ok; 157 $mbi_den_addr = refaddr($mbi_den) if $scalar_util_ok; 158 159 # Compute actual output values. 160 161 my ($mbi_quo, $mbi_rem) = $mbi_num -> btdiv($mbi_den); 162 163 # Check classes. 164 165 is(ref($mbi_num), 'Math::BigInt', 166 "class of numerator is still Math::BigInt"); 167 is(ref($mbi_den), 'Math::BigInt', 168 "class of denominator is still Math::BigInt"); 169 170 is(ref($mbi_quo), 'Math::BigInt', 171 "class of quotient is Math::BigInt"); 172 is(ref($mbi_rem), 'Math::BigInt', 173 "class of remainder is Math::BigInt"); 174 175 # Check values. 176 177 is($mbi_quo, pl2mbi($quo), "$num / $den = $quo"); 178 is($mbi_rem, pl2mbi($rem), "$num % $den = $rem"); 179 180 is($mbi_den, pl2mbi($den), "value of denominator has not change"); 181 182 # Check addresses. 183 184 my ($mbi_quo_addr, $mbi_rem_addr); 185 $mbi_quo_addr = refaddr($mbi_quo) if $scalar_util_ok; 186 $mbi_rem_addr = refaddr($mbi_rem) if $scalar_util_ok; 187 188 SKIP: { 189 skip "Scalar::Util not available", 2 unless $scalar_util_ok; 190 191 is($mbi_quo_addr, $mbi_num_addr, 192 "the quotient object is the numerator object"); 193 194 ok($mbi_rem_addr != $mbi_num_addr && 195 $mbi_rem_addr != $mbi_den_addr && 196 $mbi_rem_addr != $mbi_quo_addr, 197 "the remainder object is neither the numerator," . 198 " denominator, nor quotient object"); 199 } 200 } 201 202 ####################################################################### 203 # btdiv() in scalar context. 204 ####################################################################### 205 206 { 207 note(qq|\n\$quo = | . 208 qq|Math::BigInt -> new("$num") -> btdiv("$den")\n\n|); 209 210 # Input values as objects. 211 212 my $mbi_num = Math::BigInt -> new("$num"); 213 my $mbi_den = Math::BigInt -> new("$den"); 214 215 # Get addresses for later tests. 216 217 my ($mbi_num_addr, $mbi_den_addr); 218 $mbi_num_addr = refaddr($mbi_num) if $scalar_util_ok; 219 $mbi_den_addr = refaddr($mbi_den) if $scalar_util_ok; 220 221 # Compute actual output values. 222 223 my $mbi_quo = $mbi_num -> btdiv($mbi_den); 224 225 # Check classes. 226 227 is(ref($mbi_num), 'Math::BigInt', 228 "class of numerator is still Math::BigInt"); 229 is(ref($mbi_den), 'Math::BigInt', 230 "class of denominator is still Math::BigInt"); 231 232 is(ref($mbi_quo), 'Math::BigInt', 233 "class of quotient is Math::BigInt"); 234 235 # Check values. 236 237 is($mbi_quo, pl2mbi($quo), "$num / $den = $quo"); 238 239 is($mbi_den, pl2mbi($den), "value of numerator has not change"); 240 241 # Check addresses. 242 243 my $mbi_quo_addr; 244 $mbi_quo_addr = refaddr($mbi_quo) if $scalar_util_ok;; 245 246 SKIP: { 247 skip "Scalar::Util not available", 1 unless $scalar_util_ok; 248 249 is($mbi_quo_addr, $mbi_num_addr, 250 "the quotient object is the numerator object"); 251 } 252 } 253 254 ####################################################################### 255 # btmod() (scalar context only). 256 ####################################################################### 257 258 { 259 note(qq|\n\$quo = | . 260 qq|Math::BigInt -> new("$num") -> btmod("$den")\n\n|); 261 262 # Input values as objects. 263 264 my $mbi_num = Math::BigInt -> new("$num"); 265 my $mbi_den = Math::BigInt -> new("$den"); 266 267 # Get addresses for later tests. 268 269 my ($mbi_num_addr, $mbi_den_addr); 270 $mbi_num_addr = refaddr($mbi_num) if $scalar_util_ok; 271 $mbi_den_addr = refaddr($mbi_den) if $scalar_util_ok; 272 273 # Compute actual output values. 274 275 my $mbi_rem = $mbi_num -> btmod($mbi_den); 276 277 # Check classes. 278 279 is(ref($mbi_num), 'Math::BigInt', 280 "class of numerator is still Math::BigInt"); 281 is(ref($mbi_den), 'Math::BigInt', 282 "class of denominator is still Math::BigInt"); 283 284 is(ref($mbi_rem), 'Math::BigInt', 285 "class of remainder is Math::BigInt"); 286 287 # Check values. 288 289 is($mbi_rem, pl2mbi($rem), "$num % $den = $rem"); 290 291 is($mbi_den, pl2mbi($den), "value of denominator has not change"); 292 293 # Check addresses. 294 295 my $mbi_rem_addr; 296 $mbi_rem_addr = refaddr($mbi_rem) if $scalar_util_ok; 297 298 SKIP: { 299 skip "Scalar::Util not available", 1 unless $scalar_util_ok; 300 301 is($mbi_rem_addr, $mbi_num_addr, 302 "the remainder object is the numerator object"); 303 } 304 } 305 } 306} 307 308# Tests where the invocand and the argument is the same object. 309 310for my $num (-$inf, -20 .. -1, 1 .. 20, $inf, $nan) { 311 312 # Compute expected output values. 313 314 my ($quo, $rem) = tdiv($num, $num); 315 316 ####################################################################### 317 # btdiv() in list context. 318 ####################################################################### 319 320 { 321 note(qq|\n\$x = Math::BigInt -> new("$num"); | . 322 qq|(\$quo, \$rem) = \$x -> btdiv("\$x")\n\n|); 323 324 # Input values as objects. 325 326 my $mbi_num = Math::BigInt -> new("$num"); 327 328 # Get addresses for later tests. 329 330 my $mbi_num_addr; 331 $mbi_num_addr = refaddr($mbi_num) if $scalar_util_ok; 332 333 # Compute actual output values. 334 335 my ($mbi_quo, $mbi_rem) = $mbi_num -> btdiv($mbi_num); 336 337 # Check classes. 338 339 is(ref($mbi_num), 'Math::BigInt', 340 "class of numerator is still Math::BigInt"); 341 342 is(ref($mbi_quo), 'Math::BigInt', 343 "class of quotient is Math::BigInt"); 344 is(ref($mbi_rem), 'Math::BigInt', 345 "class of remainder is Math::BigInt"); 346 347 # Check values. 348 349 is($mbi_quo, pl2mbi($quo), "$num / $num = $quo"); 350 is($mbi_rem, pl2mbi($rem), "$num % $num = $rem"); 351 352 # Check addresses. 353 354 my ($mbi_quo_addr, $mbi_rem_addr); 355 $mbi_quo_addr = refaddr($mbi_quo) if $scalar_util_ok; 356 $mbi_rem_addr = refaddr($mbi_rem) if $scalar_util_ok; 357 358 is($mbi_quo_addr, $mbi_num_addr, 359 "the quotient object is the numerator object"); 360 361 SKIP: { 362 skip "Scalar::Util not available", 1 unless $scalar_util_ok; 363 364 ok($mbi_rem_addr != $mbi_num_addr && 365 $mbi_rem_addr != $mbi_quo_addr, 366 "the remainder object is neither the numerator," . 367 " denominator, nor quotient object"); 368 } 369 } 370 371 ####################################################################### 372 # btdiv() in scalar context. 373 ####################################################################### 374 375 { 376 note(qq|\n\$x = Math::BigInt -> new("$num"); | . 377 qq|\$quo = \$x -> btdiv(\$x)\n\n|); 378 379 # Input values as objects. 380 381 my $mbi_num = Math::BigInt -> new("$num"); 382 383 # Get addresses for later tests. 384 385 my $mbi_num_addr; 386 $mbi_num_addr = refaddr($mbi_num) if $scalar_util_ok; 387 388 # Compute actual output values. 389 390 my $mbi_quo = $mbi_num -> btdiv($mbi_num); 391 392 # Check classes. 393 394 is(ref($mbi_num), 'Math::BigInt', 395 "class of numerator is still Math::BigInt"); 396 397 is(ref($mbi_quo), 'Math::BigInt', 398 "class of quotient is Math::BigInt"); 399 400 # Check values. 401 402 is($mbi_quo, pl2mbi($quo), "$num / $num = $quo"); 403 404 # Check addresses. 405 406 my $mbi_quo_addr; 407 $mbi_quo_addr = refaddr($mbi_quo) if $scalar_util_ok; 408 409 SKIP: { 410 skip "Scalar::Util not available", 1 unless $scalar_util_ok; 411 412 is($mbi_quo_addr, $mbi_num_addr, 413 "the quotient object is the numerator object"); 414 } 415 } 416 417 418 ####################################################################### 419 # btmod() (scalar context only). 420 ####################################################################### 421 422 { 423 note(qq|\n\$x = Math::BigInt -> new("$num") | . 424 qq|\$quo = \$x -> btmod(\$x)\n\n|); 425 426 # Input values as objects. 427 428 my $mbi_num = Math::BigInt -> new("$num"); 429 430 # Get addresses for later tests. 431 432 my $mbi_num_addr; 433 $mbi_num_addr = refaddr($mbi_num) if $scalar_util_ok; 434 435 # Compute actual output values. 436 437 my $mbi_rem = $mbi_num -> btmod($mbi_num); 438 439 # Check classes. 440 441 is(ref($mbi_num), 'Math::BigInt', 442 "class of numerator is still Math::BigInt"); 443 444 is(ref($mbi_rem), 'Math::BigInt', 445 "class of remainder is Math::BigInt"); 446 447 # Check values. 448 449 is($mbi_rem, pl2mbi($rem), "$num % $num = $rem"); 450 451 # Check addresses. 452 453 my $mbi_rem_addr; 454 $mbi_rem_addr = refaddr($mbi_rem) if $scalar_util_ok; 455 456 SKIP: { 457 skip "Scalar::Util not available", 1 unless $scalar_util_ok; 458 459 is($mbi_rem_addr, $mbi_num_addr, 460 "the remainder object is the numerator object"); 461 } 462 } 463} 464