lib/Math/BigInt/t/bigintc.t

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