In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/d3e7e09755575a097017ac49465f768c29d59c7c?hp=074ededac3b0d3c126e0affff0c86afc1257e665>
- Log ----------------------------------------------------------------- commit d3e7e09755575a097017ac49465f768c29d59c7c Author: Father Chrysostomos <spr...@cpan.org> Date: Sat Jun 11 13:22:45 2011 -0700 Remove x bit from rt-16221.t M dist/Math-BigInt/t/rt-16221.t commit c879bdf7a8b9ca3f1e6c888225d5bbaa9b5dcce6 Author: Father Chrysostomos <spr...@cpan.org> Date: Sat Jun 11 13:21:49 2011 -0700 Increase Math::BigIntâs version M dist/Math-BigInt/lib/Math/BigInt.pm commit 0d6f1df03ba8fe28075f0feeffedd56066d16f72 Author: Father Chrysostomos <spr...@cpan.org> Date: Sat Jun 11 13:20:39 2011 -0700 Increase Math::BigFloatâs version M dist/Math-BigInt/lib/Math/BigFloat.pm commit b56985536ef770e44bf6493dc7da7eed7e5c61b2 Author: Ton Hospel <me...@ton.iguana.be> Date: Sat Jun 11 12:28:00 2011 -0700 [perl #85026] Iterate hashes by hand during do_sv_dump A further note: while debugging this issue it was annoying that Devel::Peek::Dump doesb't actually dump the HASH elements when an iterator is active. Also added is a patch that does the iteration to dump the HASH contents by iterating over it by hand (not disturbing any active iterator). With that it also doesn't activate hash magic during iteration, which I think is a feature M dump.c commit cbab3169ecbf1e0e61d0f4d55bd0034da1331d90 Author: Father Chrysostomos <spr...@cpan.org> Date: Sat Jun 11 12:22:52 2011 -0700 Revert "Perl_do_sv_dump: alert when skipping elements" This reverts commit 002beaef76a1595af2e39ffd4cd55c595bd6c271. I am about to apply the manual-iteration patch from ticket #85026. It conflicts with 002beaef, but it also renders 002beaef unnecessary. M dump.c commit e56c1e8df64af1aeccf399e2ac6fb3ac25abbc55 Author: Salvador Fandino <sfand...@yahoo.com> Date: Sat Jun 11 12:20:56 2011 -0700 allow features inside interactive debugger M lib/perl5db.pl commit 4436972887b888cbbfa91665a760f2b730ba3f27 Author: Father Chrysostomos <spr...@cpan.org> Date: Sat Jun 11 12:26:35 2011 -0700 Add dist/Math-BigInt/t/rt-16221.t to MANIFEST M MANIFEST commit fc3993133139f2c4cdcfb845ec86abc53fafa050 Author: Peter John Acklam <pjack...@online.no> Date: Mon Mar 7 11:45:38 2011 +0100 Fix Math::BigFloat->numify(). Math::BigFloat->numify() shall, according to the documentation and to be consistent with Math::BigInt->numify() and Math::BigRat->numify(), return a Perl scalar number, not a string. - dist/Math-BigInt/lib/Math/BigFloat.pm: - Fix objectify(). - dist/Math-BigInt/t/bigfltpm.inc: - Remove no longer relevant tests. - Modify existing tests and add new tests to verify correct behaviour. This fix closes RT #66732. M dist/Math-BigInt/lib/Math/BigFloat.pm M dist/Math-BigInt/t/bigfltpm.inc commit 66a0495875e8130c45cac4fabd5f8d05f2f4c372 Author: Peter John Acklam <pjack...@online.no> Date: Mon Mar 7 11:45:38 2011 +0100 Fix objectify()'s handling of "foreign objects". - Fix handling of "foreign objects" so they are converted to the appropriate class (Math::BigInt or Math::BigFloat). - Avoid code duplication by using only one loop. - Loop over indexes rather than array elements to make code cleaner. - Fix incorrect code comments, add more code comments and clearify existing ones. - Correct handling of undefs to make the code consistent. objectify() gave different output when the initial "shortcut" was removed. - Add test file verifying that RT#16221 is fixed. This fix closes RT #16221 and RT #52124. This patch supersedes Perl #86146. M dist/Math-BigInt/lib/Math/BigInt.pm A dist/Math-BigInt/t/rt-16221.t commit 7833bfdd94cb7b5afbbc1b18e75e664482f529d5 Author: Peter John Acklam <pjack...@online.no> Date: Mon Mar 7 11:45:38 2011 +0100 Add sign function bsgn() as a complement to babs(). This is the standard mathematical signum function. It sets the invocand to -1, 0, or 1, if it is real, and NaN otherwise. Documentation and tests are included. M dist/Math-BigInt/lib/Math/BigInt.pm M dist/Math-BigInt/t/bare_mbi.t M dist/Math-BigInt/t/bigintpm.inc M dist/Math-BigInt/t/bigintpm.t M dist/Math-BigInt/t/sub_mbi.t ----------------------------------------------------------------------- Summary of changes: MANIFEST | 1 + dist/Math-BigInt/lib/Math/BigFloat.pm | 8 +- dist/Math-BigInt/lib/Math/BigInt.pm | 224 ++++++++++++++++++++------------- dist/Math-BigInt/t/bare_mbi.t | 2 +- dist/Math-BigInt/t/bigfltpm.inc | 23 ++-- dist/Math-BigInt/t/bigintpm.inc | 9 ++- dist/Math-BigInt/t/bigintpm.t | 2 +- dist/Math-BigInt/t/rt-16221.t | 77 +++++++++++ dist/Math-BigInt/t/sub_mbi.t | 2 +- dump.c | 55 +++++---- lib/perl5db.pl | 6 + 11 files changed, 280 insertions(+), 129 deletions(-) create mode 100644 dist/Math-BigInt/t/rt-16221.t diff --git a/MANIFEST b/MANIFEST index d3ceb5d..0808830 100644 --- a/MANIFEST +++ b/MANIFEST @@ -3104,6 +3104,7 @@ dist/Math-BigInt/t/req_mbfn.t test: require Math::BigFloat; ->new(); dist/Math-BigInt/t/req_mbfw.t require Math::BigFloat; import ( with => ); dist/Math-BigInt/t/require.t Test if require Math::BigInt works dist/Math-BigInt/t/round.t Test rounding with non-integer A and P +dist/Math-BigInt/t/rt-16221.t Tests for objectify() w/foreign objs dist/Math-BigInt/t/sub_ali.t Tests for aliases in BigInt subclasses dist/Math-BigInt/t/sub_mbf.t Empty subclass test of BigFloat dist/Math-BigInt/t/sub_mbi.t Empty subclass test of BigInt diff --git a/dist/Math-BigInt/lib/Math/BigFloat.pm b/dist/Math-BigInt/lib/Math/BigFloat.pm index 06a6e48..c992f97 100644 --- a/dist/Math-BigInt/lib/Math/BigFloat.pm +++ b/dist/Math-BigInt/lib/Math/BigFloat.pm @@ -12,7 +12,7 @@ package Math::BigFloat; # _a : accuracy # _p : precision -$VERSION = '1.993'; +$VERSION = '1.994'; require 5.006002; require Exporter; @@ -437,10 +437,10 @@ sub bsstr sub numify { - # Make a number from a BigFloat object - # simple return a string and let Perl's atoi()/atof() handle the rest + # Convert a Perl scalar number from a BigFloat object. + # Create a string and let Perl's atoi()/atof() handle the rest. my ($self,$x) = ref($_[0]) ? (undef,$_[0]) : objectify(1,@_); - $x->bsstr(); + return 0 + $x->bsstr(); } ############################################################################## diff --git a/dist/Math-BigInt/lib/Math/BigInt.pm b/dist/Math-BigInt/lib/Math/BigInt.pm index 62c021e..36b1049 100644 --- a/dist/Math-BigInt/lib/Math/BigInt.pm +++ b/dist/Math-BigInt/lib/Math/BigInt.pm @@ -18,7 +18,7 @@ package Math::BigInt; my $class = "Math::BigInt"; use 5.006002; -$VERSION = '1.994'; +$VERSION = '1.995'; @ISA = qw(Exporter); @EXPORT_OK = qw(objectify bgcd blcm); @@ -1013,6 +1013,18 @@ sub babs $x; } +sub bsgn { + # Signum function. + + my $self = shift; + + return $self if $self->modify('bsgn'); + + return $self -> bone("+") if $self -> is_pos(); + return $self -> bone("-") if $self -> is_neg(); + return $self; # zero or NaN +} + sub bneg { # (BINT or num_str) return BINT @@ -2577,102 +2589,137 @@ sub as_oct ############################################################################## # private stuff (internal use only) -sub objectify - { - # check for strings, if yes, return objects instead - - # the first argument is number of args objectify() should look at it will - # return $count+1 elements, the first will be a classname. This is because - # overloaded '""' calls bstr($object,undef,undef) and this would result in - # useless objects being created and thrown away. So we cannot simple loop - # over @_. If the given count is 0, all arguments will be used. - - # If the second arg is a ref, use it as class. - # If not, try to use it as classname, unless undef, then use $class - # (aka Math::BigInt). The latter shouldn't happen,though. - - # caller: gives us: - # $x->badd(1); => ref x, scalar y - # Class->badd(1,2); => classname x (scalar), scalar x, scalar y - # Class->badd( Class->(1),2); => classname x (scalar), ref x, scalar y - # Math::BigInt::badd(1,2); => scalar x, scalar y - # In the last case we check number of arguments to turn it silently into - # $class,1,2. (We can not take '1' as class ;o) - # badd($class,1) is not supported (it should, eventually, try to add undef) - # currently it tries 'Math::BigInt' + 1, which will not work. - - # some shortcut for the common cases - # $x->unary_op(); - return (ref($_[1]),$_[1]) if (@_ == 2) && ($_[0]||0 == 1) && ref($_[1]); - - my $count = abs(shift || 0); - - my (@a,$k,$d); # resulting array, temp, and downgrade - if (ref $_[0]) - { - # okay, got object as first - $a[0] = ref $_[0]; +sub objectify { + # Convert strings and "foreign objects" to the objects we want. + + # The first argument, $count, is the number of following arguments that + # objectify() looks at and converts to objects. The first is a classname. + # If the given count is 0, all arguments will be used. + + # After the count is read, objectify obtains the name of the class to which + # the following arguments are converted. If the second argument is a + # reference, use the reference type as the class name. Otherwise, if it is + # a string that looks like a class name, use that. Otherwise, use $class. + + # Caller: Gives us: + # + # $x->badd(1); => ref x, scalar y + # Class->badd(1,2); => classname x (scalar), scalar x, scalar y + # Class->badd(Class->(1),2); => classname x (scalar), ref x, scalar y + # Math::BigInt::badd(1,2); => scalar x, scalar y + + # A shortcut for the common case $x->unary_op(): + + return (ref($_[1]), $_[1]) if (@_ == 2) && ($_[0]||0 == 1) && ref($_[1]); + + # Check the context. + + unless (wantarray) { + require Carp; + Carp::croak ("${class}::objectify() needs list context"); } - else + + # Get the number of arguments to objectify. + + my $count = shift; + $count ||= @_; + + # Initialize the output array. + + my @a = @_; + + # If the first argument is a reference, use that reference type as our + # class name. Otherwise, if the first argument looks like a class name, + # then use that as our class name. Otherwise, use the default class name. + { - # nope, got 1,2 (Class->xxx(1) => Class,1 and not supported) - $a[0] = $class; - $a[0] = shift if $_[0] =~ /^[A-Z].*::/; # classname as first? + if (ref($a[0])) { # reference? + unshift @a, ref($a[0]); + last; + } + if ($a[0] =~ /^[A-Z].*::/) { # string with class name? + last; + } + unshift @a, $class; # default class name } - no strict 'refs'; - # disable downgrading, because Math::BigFLoat->foo('1.0','2.0') needs floats - if (defined ${"$a[0]::downgrade"}) - { - $d = ${"$a[0]::downgrade"}; - ${"$a[0]::downgrade"} = undef; + no strict 'refs'; + + # What we upgrade to, if anything. + + my $up = ${"$a[0]::upgrade"}; + + # Disable downgrading, because Math::BigFloat -> foo('1.0','2.0') needs + # floats. + + my $down; + if (defined ${"$a[0]::downgrade"}) { + $down = ${"$a[0]::downgrade"}; + ${"$a[0]::downgrade"} = undef; } - my $up = ${"$a[0]::upgrade"}; - # print STDERR "# Now in objectify, my class is today $a[0], count = $count\n"; - if ($count == 0) - { - while (@_) - { - $k = shift; - if (!ref($k)) - { - $k = $a[0]->new($k); + for my $i (1 .. $count) { + my $ref = ref $a[$i]; + + # If it is an object of the right class, all is fine. + + if ($ref eq $a[0]) { + next; } - elsif (!defined $up && ref($k) ne $a[0]) - { - # foreign object, try to convert to integer - $k->can('as_number') ? $k = $k->as_number() : $k = $a[0]->new($k); - } - push @a,$k; - } - } - else - { - while ($count > 0) - { - $count--; - $k = shift; - if (!ref($k)) - { - $k = $a[0]->new($k); + + # Don't do anything with undefs. + + unless (defined($a[$i])) { + next; } - elsif (ref($k) ne $a[0] and !defined $up || ref $k ne $up) - { - # foreign object, try to convert to integer - $k->can('as_number') ? $k = $k->as_number() : $k = $a[0]->new($k); - } - push @a,$k; - } - push @a,@_; # return other params, too - } - if (! wantarray) - { - require Carp; Carp::croak ("$class objectify needs list context"); + + # Perl scalars are fed to the appropriate constructor. + + unless ($ref) { + $a[$i] = $a[0] -> new($a[$i]); + next; + } + + # Upgrading is OK, so skip further tests if the argument is upgraded. + + if (defined $up && $ref eq $up) { + next; + } + + # If we want a Math::BigInt, see if the object can become one. + # Support the old misnomer as_number(). + + if ($a[0] eq 'Math::BigInt') { + if ($a[$i] -> can('as_int')) { + $a[$i] = $a[$i] -> as_int(); + next; + } + if ($a[$i] -> can('as_number')) { + $a[$i] = $a[$i] -> as_number(); + next; + } + } + + # If we want a Math::BigFloat, see if the object can become one. + + if ($a[0] eq 'Math::BigFloat') { + if ($a[$i] -> can('as_float')) { + $a[$i] = $a[$i] -> as_float(); + next; + } + } + + # Last resort. + + $a[$i] = $a[0] -> new($a[$i]); } - ${"$a[0]::downgrade"} = $d; - @a; - } + + # Reset the downgrading. + + ${"$a[0]::downgrade"} = $down; + + return @a; +} sub _register_callback { @@ -3310,6 +3357,7 @@ Math::BigInt - Arbitrary size integer/float math package $x->bneg(); # negation $x->babs(); # absolute value + $x->bsgn(); # sign function (-1, 0, 1, or NaN) $x->bnorm(); # normalize (no-op in BigInt) $x->bnot(); # two's complement (bit wise not) $x->binc(); # increment $x by 1 diff --git a/dist/Math-BigInt/t/bare_mbi.t b/dist/Math-BigInt/t/bare_mbi.t index d7139dd..9f2198b 100644 --- a/dist/Math-BigInt/t/bare_mbi.t +++ b/dist/Math-BigInt/t/bare_mbi.t @@ -1,7 +1,7 @@ #!/usr/bin/perl -w use strict; -use Test::More tests => 3623; +use Test::More tests => 3635; BEGIN { unshift @INC, 't'; } diff --git a/dist/Math-BigInt/t/bigfltpm.inc b/dist/Math-BigInt/t/bigfltpm.inc index 743752e..d6885ac 100644 --- a/dist/Math-BigInt/t/bigfltpm.inc +++ b/dist/Math-BigInt/t/bigfltpm.inc @@ -258,6 +258,14 @@ $x->bdiv(3,$y); is ($x,'0.0027'); ############################################################################### +# Verify that numify() returns a normalized value, and underflows and +# overflows when given "extreme" values. + +like($class->new("12345e67")->numify(), qr/^1\.2345e\+?0*71$/); +like($class->new("1e-9999")->numify(), qr/^\+?0$/); # underflow +unlike($class->new("1e9999")->numify(), qr/^1(\.0*)?e\+?9+$/); # overflow + +############################################################################### # fsqrt() with set global A/P or A/P enabled on $x, also a test whether fsqrt() # correctly modifies $x @@ -637,15 +645,12 @@ hexNaN:NaN -5:-0b101 &numify # uses bsstr() so 5 => 5e+0 to be compatible w/ Perls output -0:0e+1 -+1:1e+0 -1234:1234e+0 -NaN:NaN -+inf:inf --inf:-inf --5:-5e+0 -100:1e+2 --100:-1e+2 +0:0 ++1:1 +1234:1234 +-5:-5 +100:100 +-100:-100 &fnan abc:NaN 2:NaN diff --git a/dist/Math-BigInt/t/bigintpm.inc b/dist/Math-BigInt/t/bigintpm.inc index e52a271..478584b 100644 --- a/dist/Math-BigInt/t/bigintpm.inc +++ b/dist/Math-BigInt/t/bigintpm.inc @@ -73,7 +73,7 @@ while (<DATA>) } elsif ($f eq "bone") { $try .= "\$x->bone('$args[1]');"; # some unary ops - } elsif ($f =~ /^b(nan|floor|ceil|sstr|neg|abs|inc|dec|not|sqrt|fac)$/) { + } elsif ($f =~ /^b(nan|floor|ceil|sstr|neg|abs|sgn|inc|dec|not|sqrt|fac)$/) { $try .= "\$x->$f();"; } elsif ($f =~ /^(numify|length|stringify|as_hex|as_bin)$/) { $try .= "\$x->$f();"; @@ -1222,6 +1222,13 @@ babsNaN:NaN -1:1 +123456789:123456789 -123456789:123456789 +&bsgn +NaN:NaN ++inf:1 +-inf:-1 +0:0 ++123456789:1 +-123456789:-1 &bcmp bcmpNaN:bcmpNaN: bcmpNaN:0: diff --git a/dist/Math-BigInt/t/bigintpm.t b/dist/Math-BigInt/t/bigintpm.t index cacdb8e..6ee3eff 100644 --- a/dist/Math-BigInt/t/bigintpm.t +++ b/dist/Math-BigInt/t/bigintpm.t @@ -1,7 +1,7 @@ #!/usr/bin/perl -w use strict; -use Test::More tests => 3623 + 6; +use Test::More tests => 3635 + 6; use Math::BigInt lib => 'Calc'; diff --git a/dist/Math-BigInt/t/rt-16221.t b/dist/Math-BigInt/t/rt-16221.t new file mode 100644 index 0000000..a1dc2c6 --- /dev/null +++ b/dist/Math-BigInt/t/rt-16221.t @@ -0,0 +1,77 @@ +#!/usr/bin/perl +# +# Verify that +# - Math::BigInt::objectify() calls as_int() (or as_number(), as a fallback) +# if the target object class is Math::BigInt. +# - Math::BigInt::objectify() calls as_float() if the target object class is +# Math::BigFloat. +# +# See RT #16221 and RT #52124. + +use strict; +use warnings; + +package main; + +use Test::More tests => 2; +use Math::BigInt; +use Math::BigFloat; + +############################################################################ + +my $int = Math::BigInt->new(10); +my $int_percent = My::Percent::Float->new(100); + +is($int * $int_percent, 10); + +############################################################################ + +my $float = Math::BigFloat->new(10); +my $float_percent = My::Percent::Float->new(100); + +is($float * $float_percent, 10); + +############################################################################ + +package My::Percent::Int; + +sub new { + my $class = shift; + my $num = shift; + return bless \$num, $class; +} + +sub as_number { + my $self = shift; + return Math::BigInt->new($$self / 100); +} + +sub as_string { + my $self = shift; + return $$self; +} + +############################################################################ + +package My::Percent::Float; + +sub new { + my $class = shift; + my $num = shift; + return bless \$num, $class; +} + +sub as_int { + my $self = shift; + return Math::BigInt->new($$self / 100); +} + +sub as_float { + my $self = shift; + return Math::BigFloat->new($$self / 100); +} + +sub as_string { + my $self = shift; + return $$self; +} diff --git a/dist/Math-BigInt/t/sub_mbi.t b/dist/Math-BigInt/t/sub_mbi.t index 668fd19..6a3cecc 100644 --- a/dist/Math-BigInt/t/sub_mbi.t +++ b/dist/Math-BigInt/t/sub_mbi.t @@ -1,7 +1,7 @@ #!/usr/bin/perl -w use strict; -use Test::More tests => 3623 +use Test::More tests => 3635 + 5; # +5 own tests BEGIN { unshift @INC, 't'; } diff --git a/dump.c b/dump.c index f9556c3..c32807c 100644 --- a/dump.c +++ b/dump.c @@ -1919,32 +1919,39 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo } } if (nest < maxnest) { - if (HvEITER_get(sv)) /* preserve iterator */ - Perl_dump_indent(aTHX_ level, file, - " (*** Active iterator; skipping element dump ***)\n"); - else { - HE *he; - HV * const hv = MUTABLE_HV(sv); - int count = maxnest - nest; + HV * const hv = MUTABLE_HV(sv); + STRLEN i; + HE *he; - hv_iterinit(hv); - while ((he = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS)) - && count--) { - STRLEN len; - const U32 hash = HeHASH(he); - SV * const keysv = hv_iterkeysv(he); - const char * const keypv = SvPV_const(keysv, len); - SV * const elt = hv_iterval(hv, he); - - Perl_dump_indent(aTHX_ level+1, file, "Elt %s ", pv_display(d, keypv, len, 0, pvlim)); - if (SvUTF8(keysv)) - PerlIO_printf(file, "[UTF8 \"%s\"] ", sv_uni_display(d, keysv, 6 * SvCUR(keysv), UNI_DISPLAY_QQ)); - if (HeKREHASH(he)) - PerlIO_printf(file, "[REHASH] "); - PerlIO_printf(file, "HASH = 0x%"UVxf"\n", (UV)hash); - do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim); + if (HvARRAY(hv)) { + int count = maxnest - nest; + for (i=0; i <= HvMAX(hv); i++) { + for (he = HvARRAY(hv)[i]; he; he = HeNEXT(he)) { + U32 hash; + SV * keysv; + const char * keypv; + SV * elt; + STRLEN len; + + if (count-- <= 0) goto DONEHV; + + hash = HeHASH(he); + keysv = hv_iterkeysv(he); + keypv = SvPV_const(keysv, len); + elt = HeVAL(he); + + Perl_dump_indent(aTHX_ level+1, file, "Elt %s ", pv_display(d, keypv, len, 0, pvlim)); + if (SvUTF8(keysv)) + PerlIO_printf(file, "[UTF8 \"%s\"] ", sv_uni_display(d, keysv, 6 * SvCUR(keysv), UNI_DISPLAY_QQ)); + if (HvEITER_get(hv) == he) + PerlIO_printf(file, "[CURRENT] "); + if (HeKREHASH(he)) + PerlIO_printf(file, "[REHASH] "); + PerlIO_printf(file, "HASH = 0x%"UVxf"\n", (UV) hash); + do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim); + } } - hv_iterinit(hv); /* Return to status quo */ + DONEHV:; } } break; diff --git a/lib/perl5db.pl b/lib/perl5db.pl index 77a5f35..fcc111e 100644 --- a/lib/perl5db.pl +++ b/lib/perl5db.pl @@ -512,6 +512,12 @@ package DB; BEGIN {eval 'use IO::Handle'}; # Needed for flush only? breaks under miniperl +BEGIN { + require feature; + $^V =~ /^v(\d+\.\d+)/; + feature->import(":$1"); +} + # Debugger for Perl 5.00x; perl5db.pl patch level: $VERSION = '1.34'; -- Perl5 Master Repository