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

Reply via email to