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   }
  12
  13 use Math::BigInt::Calc;
  14
  15 BEGIN
  16   {
  17   plan tests => 276;
  18   }
  19
  20 # testing of Math::BigInt::Calc
  21
  22 my $C = 'Math::BigInt::Calc';           # pass classname to sub's
  23
  24 # _new and _str
  25 my $x = $C->_new(\"123"); my $y = $C->_new(\"321");
  26 ok (ref($x),'ARRAY'); ok (${$C->_str($x)},123); ok (${$C->_str($y)},321);
  27
  28 ###############################################################################
  29 # _add, _sub, _mul, _div
  30 ok (${$C->_str($C->_add($x,$y))},444);
  31 ok (${$C->_str($C->_sub($x,$y))},123);
  32 ok (${$C->_str($C->_mul($x,$y))},39483);
  33 ok (${$C->_str($C->_div($x,$y))},123);
  34
  35 ###############################################################################
  36 # check that mul/div doesn't change $y
  37 # and returns the same reference, not something new
  38 ok (${$C->_str($C->_mul($x,$y))},39483);
  39 ok (${$C->_str($x)},39483); ok (${$C->_str($y)},321);
  40
  41 ok (${$C->_str($C->_div($x,$y))},123);
  42 ok (${$C->_str($x)},123); ok (${$C->_str($y)},321);
  43
  44 $x = $C->_new(\"39483");
  45 my ($x1,$r1) = $C->_div($x,$y);
  46 ok ("$x1","$x");
  47 $C->_inc($x1);
  48 ok ("$x1","$x");
  49 ok (${$C->_str($r1)},'0');
  50
  51 $x = $C->_new(\"39483");        # reset
  52
  53 ###############################################################################
  54 my $z = $C->_new(\"2");
  55 ok (${$C->_str($C->_add($x,$z))},39485);
  56 my ($re,$rr) = $C->_div($x,$y);
  57
  58 ok (${$C->_str($re)},123); ok (${$C->_str($rr)},2);
  59
  60 # is_zero, _is_one, _one, _zero
  61 ok ($C->_is_zero($x)||0,0);
  62 ok ($C->_is_one($x)||0,0);
  63
  64 ok (${$C->_str($C->_zero())},"0");
  65 ok (${$C->_str($C->_one())},"1");
  66
  67 # _two() (only used internally)
  68 ok (${$C->_str($C->_two())},"2");
  69
  70 ok ($C->_is_one($C->_one()),1);
  71
  72 ok ($C->_is_one($C->_zero()) || 0,0);
  73
  74 ok ($C->_is_zero($C->_zero()),1);
  75
  76 ok ($C->_is_zero($C->_one()) || 0,0);
  77
  78 # is_odd, is_even
  79 ok ($C->_is_odd($C->_one()),1); ok ($C->_is_odd($C->_zero())||0,0);
  80 ok ($C->_is_even($C->_one()) || 0,0); ok ($C->_is_even($C->_zero()),1);
  81
  82 # _len
  83 $x = $C->_new(\"1"); ok ($C->_len($x),1);
  84 $x = $C->_new(\"12"); ok ($C->_len($x),2);
  85 $x = $C->_new(\"123"); ok ($C->_len($x),3);
  86 $x = $C->_new(\"1234"); ok ($C->_len($x),4);
  87 $x = $C->_new(\"12345"); ok ($C->_len($x),5);
  88 $x = $C->_new(\"123456"); ok ($C->_len($x),6);
  89 $x = $C->_new(\"1234567"); ok ($C->_len($x),7);
  90 $x = $C->_new(\"12345678"); ok ($C->_len($x),8);
  91 $x = $C->_new(\"123456789"); ok ($C->_len($x),9);
  92
  93 $x = $C->_new(\"8"); ok ($C->_len($x),1);
  94 $x = $C->_new(\"21"); ok ($C->_len($x),2);
  95 $x = $C->_new(\"321"); ok ($C->_len($x),3);
  96 $x = $C->_new(\"4321"); ok ($C->_len($x),4);
  97 $x = $C->_new(\"54321"); ok ($C->_len($x),5);
  98 $x = $C->_new(\"654321"); ok ($C->_len($x),6);
  99 $x = $C->_new(\"7654321"); ok ($C->_len($x),7);
 100 $x = $C->_new(\"87654321"); ok ($C->_len($x),8);
 101 $x = $C->_new(\"987654321"); ok ($C->_len($x),9);
 102
 103 for (my $i = 1; $i < 9; $i++)
 104   {
 105   my $a = "$i" . '0' x ($i-1);
 106   $x = $C->_new(\$a);
 107   print "# Tried len '$a'\n" unless ok ($C->_len($x),$i);
 108   }
 109
 110 # _digit
 111 $x = $C->_new(\"123456789");
 112 ok ($C->_digit($x,0),9);
 113 ok ($C->_digit($x,1),8);
 114 ok ($C->_digit($x,2),7);
 115 ok ($C->_digit($x,-1),1);
 116 ok ($C->_digit($x,-2),2);
 117 ok ($C->_digit($x,-3),3);
 118
 119 # _copy
 120 foreach (qw/ 1 12 123 1234 12345 123456 1234567 12345678 123456789/)
 121   {
 122   $x = $C->_new(\"$_");
 123   ok (${$C->_str($C->_copy($x))},"$_");
 124   ok (${$C->_str($x)},"$_");            # did _copy destroy original x?
 125   }
 126
 127 # _zeros
 128 $x = $C->_new(\"1256000000"); ok ($C->_zeros($x),6);
 129 $x = $C->_new(\"152"); ok ($C->_zeros($x),0);
 130 $x = $C->_new(\"123000"); ok ($C->_zeros($x),3);
 131
 132 # _lsft, _rsft
 133 $x = $C->_new(\"10"); $y = $C->_new(\"3");
 134 ok (${$C->_str($C->_lsft($x,$y,10))},10000);
 135 $x = $C->_new(\"20"); $y = $C->_new(\"3");
 136 ok (${$C->_str($C->_lsft($x,$y,10))},20000);
 137
 138 $x = $C->_new(\"128"); $y = $C->_new(\"4");
 139 ok (${$C->_str($C->_lsft($x,$y,2))}, 128 << 4);
 140
 141 $x = $C->_new(\"1000"); $y = $C->_new(\"3");
 142 ok (${$C->_str($C->_rsft($x,$y,10))},1);
 143 $x = $C->_new(\"20000"); $y = $C->_new(\"3");
 144 ok (${$C->_str($C->_rsft($x,$y,10))},20);
 145 $x = $C->_new(\"256"); $y = $C->_new(\"4");
 146 ok (${$C->_str($C->_rsft($x,$y,2))},256 >> 4);
 147
 148 $x = $C->_new(\"6411906467305339182857313397200584952398");
 149 $y = $C->_new(\"45");
 150 ok (${$C->_str($C->_rsft($x,$y,10))},0);
 151
 152 # _acmp
 153 $x = $C->_new(\"123456789");
 154 $y = $C->_new(\"987654321");
 155 ok ($C->_acmp($x,$y),-1);
 156 ok ($C->_acmp($y,$x),1);
 157 ok ($C->_acmp($x,$x),0);
 158 ok ($C->_acmp($y,$y),0);
 159
 160 $x = $C->_new(\"1234567890123456789");
 161 $y = $C->_new(\"987654321012345678");
 162 ok ($C->_acmp($x,$y),1);
 163 ok ($C->_acmp($y,$x),-1);
 164 ok ($C->_acmp($x,$x),0);
 165 ok ($C->_acmp($y,$y),0);
 166
 167 $x = $C->_new(\"1234");
 168 $y = $C->_new(\"987654321012345678");
 169 ok ($C->_acmp($x,$y),-1);
 170 ok ($C->_acmp($y,$x),1);
 171 ok ($C->_acmp($x,$x),0);
 172 ok ($C->_acmp($y,$y),0);
 173
 174 # _modinv
 175 $x = $C->_new(\"8");
 176 $y = $C->_new(\"5033");
 177 my ($xmod,$sign) = $C->_modinv($x,$y);
 178 ok (${$C->_str($xmod)},'629');          # -629 % 5033 == 4404
 179 ok ($sign, '-');
 180
 181 # _div
 182 $x = $C->_new(\"3333"); $y = $C->_new(\"1111");
 183 ok (${$C->_str(scalar $C->_div($x,$y))},3);
 184 $x = $C->_new(\"33333"); $y = $C->_new(\"1111"); ($x,$y) = $C->_div($x,$y);
 185 ok (${$C->_str($x)},30); ok (${$C->_str($y)},3);
 186 $x = $C->_new(\"123"); $y = $C->_new(\"1111");
 187 ($x,$y) = $C->_div($x,$y); ok (${$C->_str($x)},0); ok (${$C->_str($y)},123);
 188
 189 # _num
 190 foreach (qw/1 12 123 1234 12345 1234567 12345678 123456789 1234567890/)
 191   {
 192   $x = $C->_new(\"$_");
 193   ok (ref($x)||'','ARRAY'); ok (${$C->_str($x)},"$_");
 194   $x = $C->_num($x); ok (ref($x)||'',''); ok ($x,$_);
 195   }
 196
 197 # _sqrt
 198 $x = $C->_new(\"144"); ok (${$C->_str($C->_sqrt($x))},'12');
 199
 200 # _fac
 201 $x = $C->_new(\"0"); ok (${$C->_str($C->_fac($x))},'1');
 202 $x = $C->_new(\"1"); ok (${$C->_str($C->_fac($x))},'1');
 203 $x = $C->_new(\"2"); ok (${$C->_str($C->_fac($x))},'2');
 204 $x = $C->_new(\"3"); ok (${$C->_str($C->_fac($x))},'6');
 205 $x = $C->_new(\"4"); ok (${$C->_str($C->_fac($x))},'24');
 206 $x = $C->_new(\"5"); ok (${$C->_str($C->_fac($x))},'120');
 207 $x = $C->_new(\"10"); ok (${$C->_str($C->_fac($x))},'3628800');
 208 $x = $C->_new(\"11"); ok (${$C->_str($C->_fac($x))},'39916800');
 209 $x = $C->_new(\"12"); ok (${$C->_str($C->_fac($x))},'479001600');
 210
 211 ##############################################################################
 212 # _inc and _dec
 213 foreach (qw/1 11 121 1231 12341 1234561 12345671 123456781 1234567891/)
 214   {
 215   $x = $C->_new(\"$_"); $C->_inc($x);
 216   print "# \$x = ",${$C->_str($x)},"\n"
 217    unless ok (${$C->_str($x)},substr($_,0,length($_)-1) . '2');
 218   $C->_dec($x); ok (${$C->_str($x)},$_);
 219   }
 220 foreach (qw/19 119 1219 12319 1234519 12345619 123456719 1234567819/)
 221   {
 222   $x = $C->_new(\"$_"); $C->_inc($x);
 223   print "# \$x = ",${$C->_str($x)},"\n"
 224    unless ok (${$C->_str($x)},substr($_,0,length($_)-2) . '20');
 225   $C->_dec($x); ok (${$C->_str($x)},$_);
 226   }
 227 foreach (qw/999 9999 99999 9999999 99999999 999999999 9999999999 99999999999/)
 228   {
 229   $x = $C->_new(\"$_"); $C->_inc($x);
 230   print "# \$x = ",${$C->_str($x)},"\n"
 231    unless ok (${$C->_str($x)}, '1' . '0' x (length($_)));
 232   $C->_dec($x); ok (${$C->_str($x)},$_);
 233   }
 234
 235 $x = $C->_new(\"1000"); $C->_inc($x); ok (${$C->_str($x)},'1001');
 236 $C->_dec($x); ok (${$C->_str($x)},'1000');
 237
 238 my $BL;
 239 {
 240   no strict 'refs';
 241   $BL = &{"$C"."::_base_len"}();
 242 }
 243
 244 $x = '1' . '0' x $BL;
 245 $z = '1' . '0' x ($BL-1); $z .= '1';
 246 $x = $C->_new(\$x); $C->_inc($x); ok (${$C->_str($x)},$z);
 247
 248 $x = '1' . '0' x $BL; $z = '9' x $BL;
 249 $x = $C->_new(\$x); $C->_dec($x); ok (${$C->_str($x)},$z);
 250
 251 # should not happen:
 252 # $x = $C->_new(\"-2"); $y = $C->_new(\"4"); ok ($C->_acmp($x,$y),-1);
 253
 254 ###############################################################################
 255 # _mod
 256 $x = $C->_new(\"1000"); $y = $C->_new(\"3");
 257 ok (${$C->_str(scalar $C->_mod($x,$y))},1);
 258 $x = $C->_new(\"1000"); $y = $C->_new(\"2");
 259 ok (${$C->_str(scalar $C->_mod($x,$y))},0);
 260
 261 # _and, _or, _xor
 262 $x = $C->_new(\"5"); $y = $C->_new(\"2");
 263 ok (${$C->_str(scalar $C->_xor($x,$y))},7);
 264 $x = $C->_new(\"5"); $y = $C->_new(\"2");
 265 ok (${$C->_str(scalar $C->_or($x,$y))},7);
 266 $x = $C->_new(\"5"); $y = $C->_new(\"3");
 267 ok (${$C->_str(scalar $C->_and($x,$y))},1);
 268
 269 # _from_hex, _from_bin
 270 ok (${$C->_str(scalar $C->_from_hex(\"0xFf"))},255);
 271 ok (${$C->_str(scalar $C->_from_bin(\"0b10101011"))},160+11);
 272
 273 # _as_hex, _as_bin
 274 ok (${$C->_str(scalar $C->_from_hex( $C->_as_hex( $C->_new(\"128"))))}, 128);
 275 ok (${$C->_str(scalar $C->_from_bin( $C->_as_bin( $C->_new(\"128"))))}, 128);
 276
 277 # _check
 278 $x = $C->_new(\"123456789");
 279 ok ($C->_check($x),0);
 280 ok ($C->_check(123),'123 is not a reference');
 281
 282 ###############################################################################
 283 # __strip_zeros
 284
 285 {
 286   no strict 'refs';
 287   # correct empty arrays
 288   $x = &{$C."::__strip_zeros"}([]); ok (@$x,1); ok ($x->[0],0);
 289   # don't strip single elements
 290   $x = &{$C."::__strip_zeros"}([0]); ok (@$x,1); ok ($x->[0],0);
 291   $x = &{$C."::__strip_zeros"}([1]); ok (@$x,1); ok ($x->[0],1);
 292   # don't strip non-zero elements
 293   $x = &{$C."::__strip_zeros"}([0,1]);
 294   ok (@$x,2); ok ($x->[0],0); ok ($x->[1],1);
 295   $x = &{$C."::__strip_zeros"}([0,1,2]);
 296   ok (@$x,3); ok ($x->[0],0); ok ($x->[1],1); ok ($x->[2],2);
 297
 298   # but strip leading zeros
 299   $x = &{$C."::__strip_zeros"}([0,1,2,0]);
 300   ok (@$x,3); ok ($x->[0],0); ok ($x->[1],1); ok ($x->[2],2);
 301
 302   $x = &{$C."::__strip_zeros"}([0,1,2,0,0]);
 303   ok (@$x,3); ok ($x->[0],0); ok ($x->[1],1); ok ($x->[2],2);
 304
 305   $x = &{$C."::__strip_zeros"}([0,1,2,0,0,0]);
 306   ok (@$x,3); ok ($x->[0],0); ok ($x->[1],1); ok ($x->[2],2);
 307
 308   # collapse multiple zeros
 309   $x = &{$C."::__strip_zeros"}([0,0,0,0]);
 310   ok (@$x,1); ok ($x->[0],0);
 311 }
 312
 313 ###############################################################################
 314 # _to_large and _to_small (last since they toy with BASE_LEN etc)
 315
 316 $C->_base_len(5,7); $x = [ qw/67890 12345 67890 12345/ ]; $C->_to_large($x);
 317 ok (@$x,3);
 318 ok ($x->[0], '4567890'); ok ($x->[1], '7890123'); ok ($x->[2], '123456');
 319
 320 $C->_base_len(5,7); $x = [ qw/54321 54321 54321 54321/ ]; $C->_to_large($x);
 321 ok (@$x,3);
 322 ok ($x->[0], '2154321'); ok ($x->[1], '4321543'); ok ($x->[2], '543215');
 323
 324 $C->_base_len(6,7); $x = [ qw/654321 654321 654321 654321/ ];
 325 $C->_to_large($x); ok (@$x,4);
 326 ok ($x->[0], '1654321'); ok ($x->[1], '2165432');
 327 ok ($x->[2], '3216543'); ok ($x->[3], '654');
 328
 329 $C->_base_len(5,7); $C->_to_small($x); ok (@$x,5);
 330 ok ($x->[0], '54321'); ok ($x->[1], '43216');
 331 ok ($x->[2], '32165'); ok ($x->[3], '21654');
 332 ok ($x->[4], '6543');
 333
 334 $C->_base_len(7,10); $x = [ qw/0000000 0000000 9999990 9999999/ ];
 335 $C->_to_large($x); ok (@$x,3);
 336 ok ($x->[0], '0000000000'); ok ($x->[1], '9999900000');
 337 ok ($x->[2], '99999999');
 338
 339 $C->_base_len(7,10); $x = [ qw/0000000 0000000 9999990 9999999 99/ ];
 340 $C->_to_large($x); ok (@$x,3);
 341 ok ($x->[0], '0000000000'); ok ($x->[1], '9999900000');
 342 ok ($x->[2], '9999999999');
 343
 344 # done
 345
 346 1;
 347