Author: rgrjr
Date: Sun May 6 08:11:30 2007
New Revision: 18435
Modified:
trunk/src/pmc/bigint.pmc
trunk/t/pmc/bigint.t
Log:
* src/pmc/bigint.pmc:
+ (bigint_bitwise_shl_bigint_int, bigint_bitwise_shr_bigint_int):
Handle negative shift values by shifting in the other direction.
This fixes a bug where GMP would run out of memory; the arg for the
shift amount is unsigned.
* t/pmc/bigint.t:
+ Four new tests for negative BigInt shifts.
Modified: trunk/src/pmc/bigint.pmc
==============================================================================
--- trunk/src/pmc/bigint.pmc (original)
+++ trunk/src/pmc/bigint.pmc Sun May 6 08:11:30 2007
@@ -267,13 +267,23 @@
bigint_bitwise_shl_bigint_int(Interp *interp, PMC* self,
INTVAL value, PMC *dest)
{
- mpz_mul_2exp(BN(dest), BN(self), value);
+ /* The third args to mpz_mul_2exp and mpz_tdiv_q_2exp are unsigned, so we
+ need to do something sensible with negative values. */
+ if (value >= 0)
+ mpz_mul_2exp(BN(dest), BN(self), value);
+ else
+ mpz_tdiv_q_2exp(BN(dest), BN(self), -value);
}
static void
bigint_bitwise_shr_bigint_int(Interp *interp, PMC* self,
INTVAL value, PMC *dest)
{
- mpz_tdiv_q_2exp(BN(dest), BN(self), value);
+ /* The third args to mpz_mul_2exp and mpz_tdiv_q_2exp are unsigned, so we
+ need to do something sensible with negative values. */
+ if (value >= 0)
+ mpz_tdiv_q_2exp(BN(dest), BN(self), value);
+ else
+ mpz_mul_2exp(BN(dest), BN(self), -value);
}
#else /* ifdef PARROT_HAS_GMP */
Modified: trunk/t/pmc/bigint.t
==============================================================================
--- trunk/t/pmc/bigint.t (original)
+++ trunk/t/pmc/bigint.t Sun May 6 08:11:30 2007
@@ -25,7 +25,7 @@
=cut
if ( $PConfig{gmp} ) {
- plan tests => 36;
+ plan tests => 40;
}
else {
plan skip_all => "No BigInt Lib configured";
@@ -759,6 +759,26 @@
102400000000000
OUT
+pir_output_is( <<'CODE', <<'OUT', "shl_bigint with a negative shift" );
+## cf the shr_bigint case.
+.sub main :main
+ new $P0, .BigInt
+ set $P0, 8
+ new $P1, .BigInt
+ set $P1, -2
+ new $P2, .BigInt
+ shl $P2, $P0, $P1
+ say $P2
+ set $P0, "102400000000000"
+ set $P1, -10
+ shl $P2, $P0, $P1
+ say $P2
+.end
+CODE
+2
+100000000000
+OUT
+
pasm_output_is( <<'CODE', <<'OUT', "shl_int" );
new P0, .BigInt
set P0, 2
@@ -788,6 +808,31 @@
102400000000000
OUT
+pir_output_is( <<'CODE', <<'OUT', "shl_int with a negative shift" );
+## cf the shr_int case.
+.sub main :main
+ new $P0, .BigInt
+ set $P0, 4
+ new $P1, .Integer
+ set $P1, -1
+ new $P2, .BigInt
+ shl $P2, $P0, $P1
+ say $P2
+ set $P0, "200000000000"
+ set $P1, -1
+ shl $P2, $P0, $P1
+ say $P2
+ set $P0, "102400000000000"
+ set $P1, -10
+ shl $P2, $P0, $P1
+ say $P2
+.end
+CODE
+2
+100000000000
+100000000000
+OUT
+
pasm_output_is( <<'CODE', <<'OUT', "shr_bigint" );
new P0, .BigInt
set P0, 8
@@ -810,6 +855,26 @@
100000000000
OUT
+pir_output_is( <<'CODE', <<'OUT', "shr_bigint with a negative shift" );
+## cf the shl_bigint case.
+.sub main :main
+ new $P0, .BigInt
+ set $P0, 2
+ new $P1, .BigInt
+ set $P1, -2
+ new $P2, .BigInt
+ shr $P2, $P0, $P1
+ say $P2
+ set $P0, "100000000000"
+ set $P1, -10
+ shr $P2, $P0, $P1
+ say $P2
+.end
+CODE
+8
+102400000000000
+OUT
+
pasm_output_is( <<'CODE', <<'OUT', "shr_int" );
new P0, .BigInt
set P0, 4
@@ -839,6 +904,30 @@
100000000000
OUT
+pir_output_is( <<'CODE', <<'OUT', "shr_int with a negative shift" );
+## cf the shl_int case.
+.sub main :main
+ new $P0, .BigInt
+ set $P0, 2
+ new $P1, .Integer
+ set $P1, -1
+ new $P2, .BigInt
+ shr $P2, $P0, $P1
+ say $P2
+ set $P0, "100000000000"
+ set $P1, -1
+ shr $P2, $P0, $P1
+ say $P2
+ set $P1, -10
+ shr $P2, $P0, $P1
+ say $P2
+.end
+CODE
+4
+200000000000
+102400000000000
+OUT
+
pir_output_is( <<'CODE', <<'OUT', "BUG #34949 gt" );
.sub main :main
.local pmc b
