X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMath%2FBigInt%2Ft%2Fbigintpm.inc;h=ad55d68ff59b3993b68b09420ecea55f8571bcc2;hb=394e6ffb59de984c27a7dce4842d9c594c141888;hp=0b4147c98cd0d19f91c91277ff13d4dde577b58f;hpb=6854fd014bcd11d8e351cefaf673f1f131454d45;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/lib/Math/BigInt/t/bigintpm.inc b/lib/Math/BigInt/t/bigintpm.inc
index 0b4147c..ad55d68 100644
--- a/lib/Math/BigInt/t/bigintpm.inc
+++ b/lib/Math/BigInt/t/bigintpm.inc
@@ -35,7 +35,7 @@ sub _swap
 ##############################################################################
 package main;
 
-my $CALC = $class->_core_lib(); ok ($CALC,'Math::BigInt::Calc');
+my $CALC = $class->_core_lib(); ok ($CALC,$CL);
 
 my ($f,$z,$a,$exp,@a,$m,$e,$round_mode);
 
@@ -60,18 +60,9 @@ while (<DATA>)
     $try = "\$x = $class->new(\"$args[0]\");";
     if ($f eq "bnorm"){
       $try = "\$x = $class->bnorm(\"$args[0]\");";
-    } elsif ($f eq "is_zero") {
-      $try .= '$x->is_zero();';
-    } elsif ($f eq "is_one") {
-      $try .= '$x->is_one();';
-    } elsif ($f eq "is_odd") {
-      $try .= '$x->is_odd();';
-    } elsif ($f eq "is_even") {
-      $try .= '$x->is_even();';
-    } elsif ($f eq "is_negative") {
-      $try .= '$x->is_negative();';
-    } elsif ($f eq "is_positive") {
-      $try .= '$x->is_positive();';
+    # some is_xxx tests
+    } elsif ($f =~ /^is_(zero|one|odd|even|negative|positive|nan)$/) {
+      $try .= "\$x->$f();";
     } elsif ($f eq "as_hex") {
       $try .= '$x->as_hex();';
     } elsif ($f eq "as_bin") {
@@ -82,26 +73,9 @@ while (<DATA>)
       $try .= "\$x->binf('$args[1]');";
     } elsif ($f eq "bone") {
       $try .= "\$x->bone('$args[1]');";
-    } elsif ($f eq "bnan") {
-      $try .= "\$x->bnan();";
-    } elsif ($f eq "bfloor") {
-      $try .= '$x->bfloor();';
-    } elsif ($f eq "bceil") {
-      $try .= '$x->bceil();';
-    } elsif ($f eq "bsstr") {
-      $try .= '$x->bsstr();';
-    } elsif ($f eq "bneg") {
-      $try .= '$x->bneg();';
-    } elsif ($f eq "babs") {
-      $try .= '$x->babs();';
-    } elsif ($f eq "binc") {
-      $try .= '++$x;'; 
-    } elsif ($f eq "bdec") {
-      $try .= '--$x;'; 
-    }elsif ($f eq "bnot") {
-      $try .= '~$x;';
-    }elsif ($f eq "bsqrt") {
-      $try .= '$x->bsqrt();';
+    # some unary ops
+    } elsif ($f =~ /^b(nan|floor|ceil|sstr|neg|abs|inc|dec|not|sqrt)$/) {
+      $try .= "\$x->$f();";
     }elsif ($f eq "length") {
       $try .= '$x->length();';
     }elsif ($f eq "exponent"){
@@ -134,6 +108,12 @@ while (<DATA>)
         $try .= '$x / $y;';
       }elsif ($f eq "bdiv-list"){
         $try .= 'join (",",$x->bdiv($y));';
+      # overload via x=
+      }elsif ($f =~ /^.=$/){
+        $try .= "\$x $f \$y;";
+      # overload via x
+      }elsif ($f =~ /^.$/){
+        $try .= "\$x $f \$y;";
       }elsif ($f eq "bmod"){
         $try .= '$x % $y;';
       }elsif ($f eq "bgcd")
@@ -185,9 +165,16 @@ while (<DATA>)
         $try = "\$x = $class->new(\"$args[0]\"); \$x->digit($args[1]);";
       } else { warn "Unknown op '$f'"; }
     }
-    # print "trying $try\n";
+   #  print "trying $try\n";
     $ans1 = eval $try;
-    $ans =~ s/^[+]([0-9])/$1/; 		# remove leading '+' 
+    # remove leading '+' from target
+    $ans =~ s/^[+]([0-9])/$1/; 		
+    # convert hex/binary targets to decimal	
+    if ($ans =~ /^(0x0x|0b0b)/)
+      {
+      $ans =~ s/^0[xb]//;
+      $ans = Math::BigInt->new($ans)->bstr();
+      }
     if ($ans eq "")
       {
       ok_undef ($ans1); 
@@ -265,29 +252,8 @@ print "# For '$try'\n" if (!ok "$ans" , "false" );
 # object with stringify overload for this. see Math::String tests as example
 
 ###############################################################################
-# check shortcuts
-$try = "\$x = $class->new(1); \$x += 9;";
-$try .= "'ok' if \$x == 10;";
-$ans = eval $try;
-print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
-
-$try = "\$x = $class->new(1); \$x -= 9;";
-$try .= "'ok' if \$x == -8;";
-$ans = eval $try;
-print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
-
-$try = "\$x = $class->new(1); \$x *= 9;";
-$try .= "'ok' if \$x == 9;";
-$ans = eval $try;
-print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
-
-$try = "\$x = $class->new(10); \$x /= 2;";
-$try .= "'ok' if \$x == 5;";
-$ans = eval $try;
-print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
-
-###############################################################################
 # check reversed order of arguments
+
 $try = "\$x = $class->new(10); \$x = 2 ** \$x;";
 $try .= "'ok' if \$x == 1024;"; $ans = eval $try;
 print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
@@ -308,6 +274,22 @@ $try = "\$x = $class\->new(10); \$x = 20 / \$x;";
 $try .= "'ok' if \$x == 2;"; $ans = eval $try;
 print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
 
+$try = "\$x = $class\->new(3); \$x = 20 % \$x;";
+$try .= "'ok' if \$x == 2;"; $ans = eval $try;
+print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
+
+$try = "\$x = $class\->new(7); \$x = 20 & \$x;";
+$try .= "'ok' if \$x == 4;"; $ans = eval $try;
+print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
+
+$try = "\$x = $class\->new(7); \$x = 0x20 | \$x;";
+$try .= "'ok' if \$x == 0x27;"; $ans = eval $try;
+print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
+
+$try = "\$x = $class\->new(7); \$x = 0x20 ^ \$x;";
+$try .= "'ok' if \$x == 0x27;"; $ans = eval $try;
+print "# For '$try'\n" if (!ok "$ans" , "ok" ); 
+
 ###############################################################################
 # check badd(4,5) form
 
@@ -424,14 +406,14 @@ $x = $class->new('+inf'); ok ($x,'inf');
 
 ###############################################################################
 ###############################################################################
-# the followin tests only make sense with Math::BigInt::Calc
+# the followin tests only make sense with Math::BigInt::Calc or BareCalc
 
-exit if $CALC ne 'Math::BigInt::Calc'; # for Pari et al.
+exit if $CALC !~ /^Math::BigInt::(Calc|BareCalc)$/; # for Pari et al.
 
 ###############################################################################
 # check proper length of internal arrays
 
-my $bl = Math::BigInt::Calc::_base_len();
+my $bl = $CL->_base_len();
 my $BASE = '9' x $bl;
 my $MAX = $BASE;
 $BASE++;
@@ -453,18 +435,19 @@ ok($x->numify(),-($BASE*$BASE*1+$BASE*1+1));
 ###############################################################################
 # test bug in _digits with length($c[-1]) where $c[-1] was "00001" instead of 1
 
-$x = Math::BigInt->new(99998); $x++; $x++; $x++; $x++;
-if ($x > 100000) { ok (1,1) } else { ok ("$x < 100000","$x > 100000"); }
+$x = $class->new($BASE-2); $x++; $x++; $x++; $x++;
+if ($x > $BASE) { ok (1,1) } else { ok ("$x < $BASE","$x > $BASE"); }
 
-$x = Math::BigInt->new(100003); $x++;
-$y = Math::BigInt->new(1000000);
-if ($x < 1000000) { ok (1,1) } else { ok ("$x > 1000000","$x < 1000000"); }
+$x = $class->new($BASE+3); $x++;
+if ($x > $BASE) { ok (1,1) } else { ok ("$x > $BASE","$x < $BASE"); }
+
+# test for +0 instead of int(): 
+$x = $class->new($MAX); ok ($x->length(), length($MAX));
 
 ###############################################################################
 # bug in sub where number with at least 6 trailing zeros after any op failed
 
-$x = Math::BigInt->new(123456); $z = Math::BigInt->new(10000); $z *= 10;
-$x -= $z;
+$x = $class->new(123456); $z = $class->new(10000); $z *= 10; $x -= $z;
 ok ($z, 100000);
 ok ($x, 23456);
 
@@ -474,26 +457,45 @@ ok ($x, 23456);
 # construct a number with a zero-hole of BASE_LEN
 $x = '1' x $bl . '0' x $bl . '1' x $bl . '0' x $bl;
 $y = '1' x (2*$bl);
-#print "$x * $y\n";
-$x = Math::BigInt->new($x)->bmul($y);
+$x = $class->new($x)->bmul($y);
 # result is 123..$bl .  $bl x (3*bl-1) . $bl...321 . '0' x $bl
 $y = ''; my $d = '';
 for (my $i = 1; $i <= $bl; $i++)
   {
   $y .= $i; $d = $i.$d;
   }
-#print "$y $d\n";
 $y .= $bl x (3*$bl-1) . $d . '0' x $bl;
 ok ($x,$y);
 
 ###############################################################################
+# see if mul shortcut for small numbers works
+
+$x = '9' x $bl;
+$x = $class->new($x); 
+# 999 * 999 => 998 . 001, 9999*9999 => 9998 . 0001
+ok ($x*$x, '9' x ($bl-1) . '8' . '0' x ($bl-1) . '1');
+
+###############################################################################
 # bug with rest "-0" in div, causing further div()s to fail
 
-$x = Math::BigInt->new('-322056000'); ($x,$y) = $x->bdiv('-12882240');
+$x = $class->new('-322056000'); ($x,$y) = $x->bdiv('-12882240');
 
 ok ($y,'0','not -0');	# not '-0'
 is_valid($y);
 
+###############################################################################
+# test whether bone/bzero take additional A & P, or reset it etc
+
+$x = $class->new(2); $x->bzero(); ok_undef ($x->{_a}); ok_undef ($x->{_p});
+$x = $class->new(2); $x->binf();  ok_undef ($x->{_a}); ok_undef ($x->{_p});
+$x = $class->new(2); $x->bone();  ok_undef ($x->{_a}); ok_undef ($x->{_p});
+$x = $class->new(2); $x->bnan();  ok_undef ($x->{_a}); ok_undef ($x->{_p});
+
+$x = $class->new(2); $x->{_a} = 1; $x->{_p} = 2; $x->bnan();
+ok_undef ($x->{_a}); ok_undef ($x->{_p});
+$x = $class->new(2); $x->{_a} = 1; $x->{_p} = 2; $x->binf();
+ok_undef ($x->{_a}); ok_undef ($x->{_p});
+
 ### all tests done ############################################################
 
 1;
@@ -531,10 +533,33 @@ sub is_valid
   # test done, see if error did crop up
   ok (1,1), return if ($e eq '0');
 
-  ok (1,$e." op '$f'");
+  ok (1,$e." after op '$f'");
   }
 
 __DATA__
+&.=
+1234:-345:1234-345
+&+=
+1:2:3
+-1:-2:-3
+&-=
+1:2:-1
+-1:-2:1
+&*=
+2:3:6
+-1:5:-5
+&%=
+100:3:1
+8:9:8
+&/=
+100:3:33
+-8:2:-4
+&|=
+2:1:3
+&&=
+5:7:5
+&^=
+5:7:2
 &is_negative
 0:0
 -1:1
@@ -614,6 +639,7 @@ NaN:-inf:
 0b1000000000000000000000000000000:1073741824
 0b_101:NaN
 0b1_0_1:5
+0b0_0_0_1:1
 # hex input
 -0x0:0
 0xabcdefgh:NaN
@@ -623,13 +649,14 @@ NaN:-inf:
 -0x1234:-4660
 0x12345678:305419896
 0x1_2_3_4_56_78:305419896
+0xa_b_c_d_e_f:11259375
 0x_123:NaN
 # inf input
 inf:inf
 +inf:inf
 -inf:-inf
 0inf:NaN
-# normal input
+# abnormal input
 :NaN
 abc:NaN
    1 a:NaN
@@ -637,6 +664,29 @@ abc:NaN
 11111b:NaN
 +1z:NaN
 -1z:NaN
+# only one underscore between two digits
+_123:NaN
+_123_:NaN
+123_:NaN
+1__23:NaN
+1E1__2:NaN
+1_E12:NaN
+1E_12:NaN
+1_E_12:NaN
++_1E12:NaN
++0_1E2:100
++0_0_1E2:100
+-0_0_1E2:-100
+-0_0_1E+0_0_2:-100
+E1:NaN
+E23:NaN
+1.23E1:NaN
+1.23E-1:NaN
+# bug with two E's in number beeing valid
+1e2e3:NaN
+1e2r:NaN
+1e2.0:NaN
+# normal input
 0:0
 +0:0
 +00:0
@@ -655,29 +705,24 @@ abc:NaN
 -123456789:-123456789
 -00000100000:-100000
 1_2_3:123
-_123:NaN
-_123_:NaN
-_123_:NaN
-1__23:NaN
 10000000000E-1_0:1
 1E2:100
 1E1:10
 1E0:1
-E1:NaN
-E23:NaN
 1.23E2:123
-1.23E1:NaN
-1.23E-1:NaN
 100E-1:10
 # floating point input
+# .2e2:20
+1.E3:1000
 1.01E2:101
 1010E-1:101
 -1010E0:-1010
 -1010E1:-10100
+1234.00:1234
+# non-integer numbers
 -1010E-2:NaN
 -1.01E+1:NaN
 -1.01E-1:NaN
-1234.00:1234
 &bnan
 1:NaN
 2:NaN
@@ -693,6 +738,11 @@ boneNaN:+:+1
 1:+:inf
 2:-:-inf
 3:abc:inf
+&is_nan
+123:0
+abc:1
+NaN:1
+-123:0
 &is_inf
 +inf::1
 -inf::1
@@ -1156,6 +1206,8 @@ abc:+1:abc:NaN
 4:-3:-2
 1:-3:-2
 4095:4095:0
+100041000510123:3:0
+152403346:12345:4321
 &bgcd
 abc:abc:NaN
 abc:+0:NaN
@@ -1197,6 +1249,23 @@ abc:0:NaN
 -7:-4:-8
 -7:4:0
 -4:7:4
+# equal arguments are treated special, so also do some test with unequal ones
+0xFFFF:0xFFFF:0x0xFFFF
+0xFFFFFF:0xFFFFFF:0x0xFFFFFF
+0xFFFFFFFF:0xFFFFFFFF:0x0xFFFFFFFF
+0xFFFFFFFFFF:0xFFFFFFFFFF:0x0xFFFFFFFFFF
+0xFFFFFFFFFFFF:0xFFFFFFFFFFFF:0x0xFFFFFFFFFFFF
+0xF0F0:0xF0F0:0x0xF0F0
+0x0F0F:0x0F0F:0x0x0F0F
+0xF0F0F0:0xF0F0F0:0x0xF0F0F0
+0x0F0F0F:0x0F0F0F:0x0x0F0F0F
+0xF0F0F0F0:0xF0F0F0F0:0x0xF0F0F0F0
+0x0F0F0F0F:0x0F0F0F0F:0x0x0F0F0F0F
+0xF0F0F0F0F0:0xF0F0F0F0F0:0x0xF0F0F0F0F0
+0x0F0F0F0F0F:0x0F0F0F0F0F:0x0x0F0F0F0F0F
+0xF0F0F0F0F0F0:0xF0F0F0F0F0F0:0x0xF0F0F0F0F0F0
+0x0F0F0F0F0F0F:0x0F0F0F0F0F0F:0x0x0F0F0F0F0F0F
+0x1F0F0F0F0F0F:0x3F0F0F0F0F0F:0x0x1F0F0F0F0F0F
 &bior
 abc:abc:NaN
 abc:0:NaN
@@ -1211,6 +1280,38 @@ abc:0:NaN
 -6:-6:-6
 -7:4:-3
 -4:7:-1
+# equal arguments are treated special, so also do some test with unequal ones
+0xFFFF:0xFFFF:0x0xFFFF
+0xFFFFFF:0xFFFFFF:0x0xFFFFFF
+0xFFFFFFFF:0xFFFFFFFF:0x0xFFFFFFFF
+0xFFFFFFFFFF:0xFFFFFFFFFF:0x0xFFFFFFFFFF
+0xFFFFFFFFFFFF:0xFFFFFFFFFFFF:0x0xFFFFFFFFFFFF
+0:0xFFFF:0x0xFFFF
+0:0xFFFFFF:0x0xFFFFFF
+0:0xFFFFFFFF:0x0xFFFFFFFF
+0:0xFFFFFFFFFF:0x0xFFFFFFFFFF
+0:0xFFFFFFFFFFFF:0x0xFFFFFFFFFFFF
+0xFFFF:0:0x0xFFFF
+0xFFFFFF:0:0x0xFFFFFF
+0xFFFFFFFF:0:0x0xFFFFFFFF
+0xFFFFFFFFFF:0:0x0xFFFFFFFFFF
+0xFFFFFFFFFFFF:0:0x0xFFFFFFFFFFFF
+0xF0F0:0xF0F0:0x0xF0F0
+0x0F0F:0x0F0F:0x0x0F0F
+0xF0F0:0x0F0F:0x0xFFFF
+0xF0F0F0:0xF0F0F0:0x0xF0F0F0
+0x0F0F0F:0x0F0F0F:0x0x0F0F0F
+0x0F0F0F:0xF0F0F0:0x0xFFFFFF
+0xF0F0F0F0:0xF0F0F0F0:0x0xF0F0F0F0
+0x0F0F0F0F:0x0F0F0F0F:0x0x0F0F0F0F
+0x0F0F0F0F:0xF0F0F0F0:0x0xFFFFFFFF
+0xF0F0F0F0F0:0xF0F0F0F0F0:0x0xF0F0F0F0F0
+0x0F0F0F0F0F:0x0F0F0F0F0F:0x0x0F0F0F0F0F
+0x0F0F0F0F0F:0xF0F0F0F0F0:0x0xFFFFFFFFFF
+0xF0F0F0F0F0F0:0xF0F0F0F0F0F0:0x0xF0F0F0F0F0F0
+0x0F0F0F0F0F0F:0x0F0F0F0F0F0F:0x0x0F0F0F0F0F0F
+0x0F0F0F0F0F0F:0xF0F0F0F0F0F0:0x0xFFFFFFFFFFFF
+0x1F0F0F0F0F0F:0xF0F0F0F0F0F0:0x0xFFFFFFFFFFFF
 &bxor
 abc:abc:NaN
 abc:0:NaN
@@ -1227,6 +1328,37 @@ abc:0:NaN
 -4:7:-5
 4:-7:-3
 -4:-7:5
+# equal arguments are treated special, so also do some test with unequal ones
+0xFFFF:0xFFFF:0
+0xFFFFFF:0xFFFFFF:0
+0xFFFFFFFF:0xFFFFFFFF:0
+0xFFFFFFFFFF:0xFFFFFFFFFF:0
+0xFFFFFFFFFFFF:0xFFFFFFFFFFFF:0
+0:0xFFFF:0x0xFFFF
+0:0xFFFFFF:0x0xFFFFFF
+0:0xFFFFFFFF:0x0xFFFFFFFF
+0:0xFFFFFFFFFF:0x0xFFFFFFFFFF
+0:0xFFFFFFFFFFFF:0x0xFFFFFFFFFFFF
+0xFFFF:0:0x0xFFFF
+0xFFFFFF:0:0x0xFFFFFF
+0xFFFFFFFF:0:0x0xFFFFFFFF
+0xFFFFFFFFFF:0:0x0xFFFFFFFFFF
+0xFFFFFFFFFFFF:0:0x0xFFFFFFFFFFFF
+0xF0F0:0xF0F0:0
+0x0F0F:0x0F0F:0
+0xF0F0:0x0F0F:0x0xFFFF
+0xF0F0F0:0xF0F0F0:0
+0x0F0F0F:0x0F0F0F:0
+0x0F0F0F:0xF0F0F0:0x0xFFFFFF
+0xF0F0F0F0:0xF0F0F0F0:0
+0x0F0F0F0F:0x0F0F0F0F:0
+0x0F0F0F0F:0xF0F0F0F0:0x0xFFFFFFFF
+0xF0F0F0F0F0:0xF0F0F0F0F0:0
+0x0F0F0F0F0F:0x0F0F0F0F0F:0
+0x0F0F0F0F0F:0xF0F0F0F0F0:0x0xFFFFFFFFFF
+0xF0F0F0F0F0F0:0xF0F0F0F0F0F0:0
+0x0F0F0F0F0F0F:0x0F0F0F0F0F0F:0
+0x0F0F0F0F0F0F:0xF0F0F0F0F0F0:0x0xFFFFFFFFFFFF
 &bnot
 abc:NaN
 +0:-1
@@ -1346,18 +1478,30 @@ abc:12:NaN
 -123:3
 215960156869840440586892398248:30
 &bsqrt
+145:12
 144:12
+143:11
 16:4
+170:13
+169:13
+168:12
 4:2
+3:1
 2:1
+9:3
 12:3
 256:16
 100000000:10000
 4000000000000:2000000
+152399026:12345
+152399025:12345
+152399024:12344
 1:1
 0:0
 -2:NaN
+-123:NaN
 Nan:NaN
++inf:NaN
 &bround
 $round_mode('trunc')
 0:12:0