1#!/usr/bin/perl -w 2 3use strict; 4use Test; 5 6BEGIN 7 { 8 $| = 1; 9 chdir 't' if -d 't'; 10 unshift @INC, '../lib'; # for running manually 11 if ($^O eq 'unicos') # the tests hang under "unicos" 12 { 13 print "1..0\n"; 14 exit(0); 15 } 16 plan tests => 375; 17 } 18 19use Math::BigInt::Calc; 20 21my ($BASE_LEN, $AND_BITS, $XOR_BITS, $OR_BITS, $BASE_LEN_SMALL, $MAX_VAL) = 22 Math::BigInt::Calc->_base_len(); 23 24print "# BASE_LEN = $BASE_LEN\n"; 25print "# MAX_VAL = $MAX_VAL\n"; 26print "# AND_BITS = $AND_BITS\n"; 27print "# XOR_BITS = $XOR_BITS\n"; 28print "# IOR_BITS = $OR_BITS\n"; 29 30# testing of Math::BigInt::Calc 31 32my $C = 'Math::BigInt::Calc'; # pass classname to sub's 33 34# _new and _str 35my $x = $C->_new("123"); my $y = $C->_new("321"); 36ok (ref($x),'ARRAY'); ok ($C->_str($x),123); ok ($C->_str($y),321); 37 38############################################################################### 39# _add, _sub, _mul, _div 40ok ($C->_str($C->_add($x,$y)),444); 41ok ($C->_str($C->_sub($x,$y)),123); 42ok ($C->_str($C->_mul($x,$y)),39483); 43ok ($C->_str($C->_div($x,$y)),123); 44 45############################################################################### 46# check that mul/div doesn't change $y 47# and returns the same reference, not something new 48ok ($C->_str($C->_mul($x,$y)),39483); 49ok ($C->_str($x),39483); ok ($C->_str($y),321); 50 51ok ($C->_str($C->_div($x,$y)),123); 52ok ($C->_str($x),123); ok ($C->_str($y),321); 53 54$x = $C->_new("39483"); 55my ($x1,$r1) = $C->_div($x,$y); 56ok ("$x1","$x"); 57$C->_inc($x1); 58ok ("$x1","$x"); 59ok ($C->_str($r1),'0'); 60 61$x = $C->_new("39483"); # reset 62 63############################################################################### 64my $z = $C->_new("2"); 65ok ($C->_str($C->_add($x,$z)),39485); 66my ($re,$rr) = $C->_div($x,$y); 67 68ok ($C->_str($re),123); ok ($C->_str($rr),2); 69 70# is_zero, _is_one, _one, _zero 71ok ($C->_is_zero($x)||0,0); 72ok ($C->_is_one($x)||0,0); 73 74ok ($C->_str($C->_zero()),"0"); 75ok ($C->_str($C->_one()),"1"); 76 77# _two() and _ten() 78ok ($C->_str($C->_two()),"2"); 79ok ($C->_str($C->_ten()),"10"); 80ok ($C->_is_ten($C->_two()),0); 81ok ($C->_is_two($C->_two()),1); 82ok ($C->_is_ten($C->_ten()),1); 83ok ($C->_is_two($C->_ten()),0); 84 85ok ($C->_is_one($C->_one()),1); 86ok ($C->_is_one($C->_two()),0); 87ok ($C->_is_one($C->_ten()),0); 88 89ok ($C->_is_one($C->_zero()) || 0,0); 90 91ok ($C->_is_zero($C->_zero()),1); 92 93ok ($C->_is_zero($C->_one()) || 0,0); 94 95# is_odd, is_even 96ok ($C->_is_odd($C->_one()),1); ok ($C->_is_odd($C->_zero())||0,0); 97ok ($C->_is_even($C->_one()) || 0,0); ok ($C->_is_even($C->_zero()),1); 98 99# _len 100for my $method (qw/_alen _len/) 101 { 102 $x = $C->_new("1"); ok ($C->$method($x),1); 103 $x = $C->_new("12"); ok ($C->$method($x),2); 104 $x = $C->_new("123"); ok ($C->$method($x),3); 105 $x = $C->_new("1234"); ok ($C->$method($x),4); 106 $x = $C->_new("12345"); ok ($C->$method($x),5); 107 $x = $C->_new("123456"); ok ($C->$method($x),6); 108 $x = $C->_new("1234567"); ok ($C->$method($x),7); 109 $x = $C->_new("12345678"); ok ($C->$method($x),8); 110 $x = $C->_new("123456789"); ok ($C->$method($x),9); 111 112 $x = $C->_new("8"); ok ($C->$method($x),1); 113 $x = $C->_new("21"); ok ($C->$method($x),2); 114 $x = $C->_new("321"); ok ($C->$method($x),3); 115 $x = $C->_new("4321"); ok ($C->$method($x),4); 116 $x = $C->_new("54321"); ok ($C->$method($x),5); 117 $x = $C->_new("654321"); ok ($C->$method($x),6); 118 $x = $C->_new("7654321"); ok ($C->$method($x),7); 119 $x = $C->_new("87654321"); ok ($C->$method($x),8); 120 $x = $C->_new("987654321"); ok ($C->$method($x),9); 121 122 $x = $C->_new("0"); ok ($C->$method($x),1); 123 $x = $C->_new("20"); ok ($C->$method($x),2); 124 $x = $C->_new("320"); ok ($C->$method($x),3); 125 $x = $C->_new("4320"); ok ($C->$method($x),4); 126 $x = $C->_new("54320"); ok ($C->$method($x),5); 127 $x = $C->_new("654320"); ok ($C->$method($x),6); 128 $x = $C->_new("7654320"); ok ($C->$method($x),7); 129 $x = $C->_new("87654320"); ok ($C->$method($x),8); 130 $x = $C->_new("987654320"); ok ($C->$method($x),9); 131 132 for (my $i = 1; $i < 9; $i++) 133 { 134 my $a = "$i" . '0' x ($i-1); 135 $x = $C->_new($a); 136 print "# Tried len '$a'\n" unless ok ($C->_len($x),$i); 137 } 138 } 139 140# _digit 141$x = $C->_new("123456789"); 142ok ($C->_digit($x,0),9); 143ok ($C->_digit($x,1),8); 144ok ($C->_digit($x,2),7); 145ok ($C->_digit($x,-1),1); 146ok ($C->_digit($x,-2),2); 147ok ($C->_digit($x,-3),3); 148 149# _copy 150foreach (qw/ 1 12 123 1234 12345 123456 1234567 12345678 123456789/) 151 { 152 $x = $C->_new("$_"); 153 ok ($C->_str($C->_copy($x)),"$_"); 154 ok ($C->_str($x),"$_"); # did _copy destroy original x? 155 } 156 157# _zeros 158$x = $C->_new("1256000000"); ok ($C->_zeros($x),6); 159$x = $C->_new("152"); ok ($C->_zeros($x),0); 160$x = $C->_new("123000"); ok ($C->_zeros($x),3); 161$x = $C->_new("0"); ok ($C->_zeros($x),0); 162 163# _lsft, _rsft 164$x = $C->_new("10"); $y = $C->_new("3"); 165ok ($C->_str($C->_lsft($x,$y,10)),10000); 166$x = $C->_new("20"); $y = $C->_new("3"); 167ok ($C->_str($C->_lsft($x,$y,10)),20000); 168 169$x = $C->_new("128"); $y = $C->_new("4"); 170ok ($C->_str($C->_lsft($x,$y,2)), 128 << 4); 171 172$x = $C->_new("1000"); $y = $C->_new("3"); 173ok ($C->_str($C->_rsft($x,$y,10)),1); 174$x = $C->_new("20000"); $y = $C->_new("3"); 175ok ($C->_str($C->_rsft($x,$y,10)),20); 176$x = $C->_new("256"); $y = $C->_new("4"); 177ok ($C->_str($C->_rsft($x,$y,2)),256 >> 4); 178 179$x = $C->_new("6411906467305339182857313397200584952398"); 180$y = $C->_new("45"); 181ok ($C->_str($C->_rsft($x,$y,10)),0); 182 183# _acmp 184$x = $C->_new("123456789"); 185$y = $C->_new("987654321"); 186ok ($C->_acmp($x,$y),-1); 187ok ($C->_acmp($y,$x),1); 188ok ($C->_acmp($x,$x),0); 189ok ($C->_acmp($y,$y),0); 190$x = $C->_new("12"); 191$y = $C->_new("12"); 192ok ($C->_acmp($x,$y),0); 193$x = $C->_new("21"); 194ok ($C->_acmp($x,$y),1); 195ok ($C->_acmp($y,$x),-1); 196$x = $C->_new("123456789"); 197$y = $C->_new("1987654321"); 198ok ($C->_acmp($x,$y),-1); 199ok ($C->_acmp($y,$x),+1); 200 201$x = $C->_new("1234567890123456789"); 202$y = $C->_new("987654321012345678"); 203ok ($C->_acmp($x,$y),1); 204ok ($C->_acmp($y,$x),-1); 205ok ($C->_acmp($x,$x),0); 206ok ($C->_acmp($y,$y),0); 207 208$x = $C->_new("1234"); 209$y = $C->_new("987654321012345678"); 210ok ($C->_acmp($x,$y),-1); 211ok ($C->_acmp($y,$x),1); 212ok ($C->_acmp($x,$x),0); 213ok ($C->_acmp($y,$y),0); 214 215# _modinv 216$x = $C->_new("8"); 217$y = $C->_new("5033"); 218my ($xmod,$sign) = $C->_modinv($x,$y); 219ok ($C->_str($xmod),'629'); # -629 % 5033 == 4404 220ok ($sign, '-'); 221 222# _div 223$x = $C->_new("3333"); $y = $C->_new("1111"); 224ok ($C->_str(scalar $C->_div($x,$y)),3); 225$x = $C->_new("33333"); $y = $C->_new("1111"); ($x,$y) = $C->_div($x,$y); 226ok ($C->_str($x),30); ok ($C->_str($y),3); 227$x = $C->_new("123"); $y = $C->_new("1111"); 228($x,$y) = $C->_div($x,$y); ok ($C->_str($x),0); ok ($C->_str($y),123); 229 230# _num 231foreach (qw/1 12 123 1234 12345 1234567 12345678 123456789 1234567890/) 232 { 233 $x = $C->_new("$_"); 234 ok (ref($x)||'','ARRAY'); ok ($C->_str($x),"$_"); 235 $x = $C->_num($x); ok (ref($x)||'',''); ok ($x,$_); 236 } 237 238# _sqrt 239$x = $C->_new("144"); ok ($C->_str($C->_sqrt($x)),'12'); 240$x = $C->_new("144000000000000"); ok ($C->_str($C->_sqrt($x)),'12000000'); 241 242# _root 243$x = $C->_new("81"); my $n = $C->_new("3"); # 4*4*4 = 64, 5*5*5 = 125 244ok ($C->_str($C->_root($x,$n)),'4'); # 4.xx => 4.0 245$x = $C->_new("81"); $n = $C->_new("4"); # 3*3*3*3 == 81 246ok ($C->_str($C->_root($x,$n)),'3'); 247 248# _pow (and _root) 249$x = $C->_new("0"); $n = $C->_new("3"); # 0 ** y => 0 250ok ($C->_str($C->_pow($x,$n)), 0); 251$x = $C->_new("3"); $n = $C->_new("0"); # x ** 0 => 1 252ok ($C->_str($C->_pow($x,$n)), 1); 253$x = $C->_new("1"); $n = $C->_new("3"); # 1 ** y => 1 254ok ($C->_str($C->_pow($x,$n)), 1); 255$x = $C->_new("5"); $n = $C->_new("1"); # x ** 1 => x 256ok ($C->_str($C->_pow($x,$n)), 5); 257 258$x = $C->_new("81"); $n = $C->_new("3"); # 81 ** 3 == 531441 259ok ($C->_str($C->_pow($x,$n)),81 ** 3); 260 261ok ($C->_str($C->_root($x,$n)),81); 262 263$x = $C->_new("81"); 264ok ($C->_str($C->_pow($x,$n)),81 ** 3); 265ok ($C->_str($C->_pow($x,$n)),'150094635296999121'); # 531441 ** 3 == 266 267ok ($C->_str($C->_root($x,$n)),'531441'); 268ok ($C->_str($C->_root($x,$n)),'81'); 269 270$x = $C->_new("81"); $n = $C->_new("14"); 271ok ($C->_str($C->_pow($x,$n)),'523347633027360537213511521'); 272ok ($C->_str($C->_root($x,$n)),'81'); 273 274$x = $C->_new("523347633027360537213511520"); 275ok ($C->_str($C->_root($x,$n)),'80'); 276 277$x = $C->_new("523347633027360537213511522"); 278ok ($C->_str($C->_root($x,$n)),'81'); 279 280my $res = [ qw/9 31 99 316 999 3162 9999 31622 99999/ ]; 281 282# 99 ** 2 = 9801, 999 ** 2 = 998001 etc 283for my $i (2 .. 9) 284 { 285 $x = '9' x $i; $x = $C->_new($x); 286 $n = $C->_new("2"); 287 my $rc = '9' x ($i-1). '8' . '0' x ($i-1) . '1'; 288 print "# _pow( ", '9' x $i, ", 2) \n" unless 289 ok ($C->_str($C->_pow($x,$n)),$rc); 290 291 # if $i > $BASE_LEN, the test takes a really long time: 292 if ($i <= $BASE_LEN) 293 { 294 $x = '9' x $i; $x = $C->_new($x); 295 $n = '9' x $i; $n = $C->_new($n); 296 print "# _root( ", '9' x $i, ", ", 9 x $i, ") \n"; 297 print "# _root( ", '9' x $i, ", ", 9 x $i, ") \n" unless 298 ok ($C->_str($C->_root($x,$n)),'1'); 299 300 $x = '9' x $i; $x = $C->_new($x); 301 $n = $C->_new("2"); 302 print "# BASE_LEN $BASE_LEN _root( ", '9' x $i, ", ", 9 x $i, ") \n" unless 303 ok ($C->_str($C->_root($x,$n)), $res->[$i-2]); 304 } 305 else 306 { 307 ok ("skipped $i", "skipped $i"); 308 ok ("skipped $i", "skipped $i"); 309 } 310 } 311 312############################################################################## 313# _fac 314$x = $C->_new("0"); ok ($C->_str($C->_fac($x)),'1'); 315$x = $C->_new("1"); ok ($C->_str($C->_fac($x)),'1'); 316$x = $C->_new("2"); ok ($C->_str($C->_fac($x)),'2'); 317$x = $C->_new("3"); ok ($C->_str($C->_fac($x)),'6'); 318$x = $C->_new("4"); ok ($C->_str($C->_fac($x)),'24'); 319$x = $C->_new("5"); ok ($C->_str($C->_fac($x)),'120'); 320$x = $C->_new("10"); ok ($C->_str($C->_fac($x)),'3628800'); 321$x = $C->_new("11"); ok ($C->_str($C->_fac($x)),'39916800'); 322$x = $C->_new("12"); ok ($C->_str($C->_fac($x)),'479001600'); 323$x = $C->_new("13"); ok ($C->_str($C->_fac($x)),'6227020800'); 324 325# test that _fac modifes $x in place for small arguments 326$x = $C->_new("3"); $C->_fac($x); ok ($C->_str($x),'6'); 327$x = $C->_new("13"); $C->_fac($x); ok ($C->_str($x),'6227020800'); 328 329############################################################################## 330# _inc and _dec 331foreach (qw/1 11 121 1231 12341 1234561 12345671 123456781 1234567891/) 332 { 333 $x = $C->_new("$_"); $C->_inc($x); 334 print "# \$x = ",$C->_str($x),"\n" 335 unless ok ($C->_str($x),substr($_,0,length($_)-1) . '2'); 336 $C->_dec($x); ok ($C->_str($x),$_); 337 } 338foreach (qw/19 119 1219 12319 1234519 12345619 123456719 1234567819/) 339 { 340 $x = $C->_new("$_"); $C->_inc($x); 341 print "# \$x = ",$C->_str($x),"\n" 342 unless ok ($C->_str($x),substr($_,0,length($_)-2) . '20'); 343 $C->_dec($x); ok ($C->_str($x),$_); 344 } 345foreach (qw/999 9999 99999 9999999 99999999 999999999 9999999999 99999999999/) 346 { 347 $x = $C->_new("$_"); $C->_inc($x); 348 print "# \$x = ",$C->_str($x),"\n" 349 unless ok ($C->_str($x), '1' . '0' x (length($_))); 350 $C->_dec($x); ok ($C->_str($x),$_); 351 } 352 353$x = $C->_new("1000"); $C->_inc($x); ok ($C->_str($x),'1001'); 354$C->_dec($x); ok ($C->_str($x),'1000'); 355 356my $BL; 357{ 358 no strict 'refs'; 359 $BL = &{"$C"."::_base_len"}(); 360} 361 362$x = '1' . '0' x $BL; 363$z = '1' . '0' x ($BL-1); $z .= '1'; 364$x = $C->_new($x); $C->_inc($x); ok ($C->_str($x),$z); 365 366$x = '1' . '0' x $BL; $z = '9' x $BL; 367$x = $C->_new($x); $C->_dec($x); ok ($C->_str($x),$z); 368 369# should not happen: 370# $x = $C->_new("-2"); $y = $C->_new("4"); ok ($C->_acmp($x,$y),-1); 371 372############################################################################### 373# _mod 374$x = $C->_new("1000"); $y = $C->_new("3"); 375ok ($C->_str(scalar $C->_mod($x,$y)),1); 376$x = $C->_new("1000"); $y = $C->_new("2"); 377ok ($C->_str(scalar $C->_mod($x,$y)),0); 378 379# _and, _or, _xor 380$x = $C->_new("5"); $y = $C->_new("2"); 381ok ($C->_str(scalar $C->_xor($x,$y)),7); 382$x = $C->_new("5"); $y = $C->_new("2"); 383ok ($C->_str(scalar $C->_or($x,$y)),7); 384$x = $C->_new("5"); $y = $C->_new("3"); 385ok ($C->_str(scalar $C->_and($x,$y)),1); 386 387# _from_hex, _from_bin, _from_oct 388ok ($C->_str( $C->_from_hex("0xFf")),255); 389ok ($C->_str( $C->_from_bin("0b10101011")),160+11); 390ok ($C->_str( $C->_from_oct("0100")), 8*8); 391ok ($C->_str( $C->_from_oct("01000")), 8*8*8); 392ok ($C->_str( $C->_from_oct("010001")), 8*8*8*8+1); 393ok ($C->_str( $C->_from_oct("010007")), 8*8*8*8+7); 394 395# _as_hex, _as_bin, as_oct 396ok ($C->_str( $C->_from_hex( $C->_as_hex( $C->_new("128")))), 128); 397ok ($C->_str( $C->_from_bin( $C->_as_bin( $C->_new("128")))), 128); 398ok ($C->_str( $C->_from_oct( $C->_as_oct( $C->_new("128")))), 128); 399 400ok ($C->_str( $C->_from_oct( $C->_as_oct( $C->_new("123456")))), 123456); 401ok ($C->_str( $C->_from_oct( $C->_as_oct( $C->_new("123456789")))), "123456789"); 402ok ($C->_str( $C->_from_oct( $C->_as_oct( $C->_new("1234567890123")))), "1234567890123"); 403 404my $long = '123456789012345678901234567890'; 405ok ($C->_str( $C->_from_hex( $C->_as_hex( $C->_new($long)))), $long); 406ok ($C->_str( $C->_from_bin( $C->_as_bin( $C->_new($long)))), $long); 407ok ($C->_str( $C->_from_oct( $C->_as_oct( $C->_new($long)))), $long); 408ok ($C->_str( $C->_from_hex( $C->_as_hex( $C->_new("0")))), 0); 409ok ($C->_str( $C->_from_bin( $C->_as_bin( $C->_new("0")))), 0); 410ok ($C->_str( $C->_from_oct( $C->_as_oct( $C->_new("0")))), 0); 411ok ($C->_as_hex( $C->_new("0")), '0x0'); 412ok ($C->_as_bin( $C->_new("0")), '0b0'); 413ok ($C->_as_oct( $C->_new("0")), '00'); 414ok ($C->_as_hex( $C->_new("12")), '0xc'); 415ok ($C->_as_bin( $C->_new("12")), '0b1100'); 416ok ($C->_as_oct( $C->_new("64")), '0100'); 417 418# _1ex 419ok ($C->_str($C->_1ex(0)), "1"); 420ok ($C->_str($C->_1ex(1)), "10"); 421ok ($C->_str($C->_1ex(2)), "100"); 422ok ($C->_str($C->_1ex(12)), "1000000000000"); 423ok ($C->_str($C->_1ex(16)), "10000000000000000"); 424 425# _check 426$x = $C->_new("123456789"); 427ok ($C->_check($x),0); 428ok ($C->_check(123),'123 is not a reference'); 429 430############################################################################### 431# __strip_zeros 432 433{ 434 no strict 'refs'; 435 # correct empty arrays 436 $x = &{$C."::__strip_zeros"}([]); ok (@$x,1); ok ($x->[0],0); 437 # don't strip single elements 438 $x = &{$C."::__strip_zeros"}([0]); ok (@$x,1); ok ($x->[0],0); 439 $x = &{$C."::__strip_zeros"}([1]); ok (@$x,1); ok ($x->[0],1); 440 # don't strip non-zero elements 441 $x = &{$C."::__strip_zeros"}([0,1]); 442 ok (@$x,2); ok ($x->[0],0); ok ($x->[1],1); 443 $x = &{$C."::__strip_zeros"}([0,1,2]); 444 ok (@$x,3); ok ($x->[0],0); ok ($x->[1],1); ok ($x->[2],2); 445 446 # but strip leading zeros 447 $x = &{$C."::__strip_zeros"}([0,1,2,0]); 448 ok (@$x,3); ok ($x->[0],0); ok ($x->[1],1); ok ($x->[2],2); 449 450 $x = &{$C."::__strip_zeros"}([0,1,2,0,0]); 451 ok (@$x,3); ok ($x->[0],0); ok ($x->[1],1); ok ($x->[2],2); 452 453 $x = &{$C."::__strip_zeros"}([0,1,2,0,0,0]); 454 ok (@$x,3); ok ($x->[0],0); ok ($x->[1],1); ok ($x->[2],2); 455 456 # collapse multiple zeros 457 $x = &{$C."::__strip_zeros"}([0,0,0,0]); 458 ok (@$x,1); ok ($x->[0],0); 459} 460 461# done 462 4631; 464 465