r46883 - in /branches/upstream/libdata-peek-perl/current: ChangeLog MANIFEST META.yml Peek.pm Peek.xs t/30_DDump-s.t t/52_DGrow.t
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Sat Nov 7 15:32:52 UTC 2009
Author: jawnsy-guest
Date: Sat Nov 7 15:32:28 2009
New Revision: 46883
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=46883
Log:
[svn-upgrade] Integrating new upstream version, libdata-peek-perl (0.28)
Added:
branches/upstream/libdata-peek-perl/current/t/52_DGrow.t
Modified:
branches/upstream/libdata-peek-perl/current/ChangeLog
branches/upstream/libdata-peek-perl/current/MANIFEST
branches/upstream/libdata-peek-perl/current/META.yml
branches/upstream/libdata-peek-perl/current/Peek.pm
branches/upstream/libdata-peek-perl/current/Peek.xs
branches/upstream/libdata-peek-perl/current/t/30_DDump-s.t
Modified: branches/upstream/libdata-peek-perl/current/ChangeLog
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdata-peek-perl/current/ChangeLog?rev=46883&op=diff
==============================================================================
--- branches/upstream/libdata-peek-perl/current/ChangeLog (original)
+++ branches/upstream/libdata-peek-perl/current/ChangeLog Sat Nov 7 15:32:28 2009
@@ -1,3 +1,8 @@
+2009-11-06 0.28 - H.Merijn Brand <h.m.brand at xs4all.nl>
+
+ * DDump () now dumps the variable itself, instead of a copy (Zefram)
+ * Add DGrow ()
+
2009-06-03 0.27 - H.Merijn Brand <h.m.brand at xs4all.nl>
* void context behaviour for DPeek ()
Modified: branches/upstream/libdata-peek-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdata-peek-perl/current/MANIFEST?rev=46883&op=diff
==============================================================================
--- branches/upstream/libdata-peek-perl/current/MANIFEST (original)
+++ branches/upstream/libdata-peek-perl/current/MANIFEST Sat Nov 7 15:32:28 2009
@@ -17,5 +17,6 @@
t/41_DDump-h.t Tests for DDump () returning hash using _IO
t/50_DDual.t Tests for DDual ()
t/51_triplevar.t Tests for triplevar ()
+t/52_DGrow.t Tests for DGrow ()
examples/ddumper.pl show the use
META.yml Module meta-data (added by MakeMaker)
Modified: branches/upstream/libdata-peek-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdata-peek-perl/current/META.yml?rev=46883&op=diff
==============================================================================
--- branches/upstream/libdata-peek-perl/current/META.yml (original)
+++ branches/upstream/libdata-peek-perl/current/META.yml Sat Nov 7 15:32:28 2009
@@ -1,6 +1,6 @@
--- #YAML:1.1
name: Data::Peek
-version: 0.27
+version: 0.28
abstract: Modified and extended debugging facilities
license: perl
author:
@@ -10,12 +10,12 @@
provides:
Data::Peek:
file: Peek.pm
- version: 0.27
+ version: 0.28
requires:
perl: 5.006
DynaLoader: 0
recommends:
- perl: 5.008005
+ perl: 5.010001
configure_requires:
ExtUtils::MakeMaker: 0
build_requires:
Modified: branches/upstream/libdata-peek-perl/current/Peek.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdata-peek-perl/current/Peek.pm?rev=46883&op=diff
==============================================================================
--- branches/upstream/libdata-peek-perl/current/Peek.pm (original)
+++ branches/upstream/libdata-peek-perl/current/Peek.pm Sat Nov 7 15:32:28 2009
@@ -6,9 +6,9 @@
use DynaLoader ();
use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK );
-$VERSION = "0.27";
+$VERSION = "0.28";
@ISA = qw( DynaLoader Exporter );
- at EXPORT = qw( DDumper DDsort DPeek DDisplay DDump DDual );
+ at EXPORT = qw( DDumper DDsort DPeek DDisplay DDump DDual DGrow );
@EXPORT_OK = qw( triplevar );
$] >= 5.007003 and push @EXPORT, "DDump_IO";
@@ -92,16 +92,16 @@
sub _DDump_ref
{
- my ($var, $down) = (@_, 0);
-
- my $ref = ref $var;
+ my (undef, $down) = (@_, 0);
+
+ my $ref = ref $_[0];
if ($ref eq "SCALAR" || $ref eq "REF") {
- my %hash = DDump ($$var, $down);
+ my %hash = DDump (${$_[0]}, $down);
return { %hash };
}
if ($ref eq "ARRAY") {
my @list;
- foreach my $list (@$var) {
+ foreach my $list (@{$_[0]}) {
my %hash = DDump ($list, $down);
push @list, { %hash };
}
@@ -109,8 +109,8 @@
}
if ($ref eq "HASH") {
my %hash;
- foreach my $key (sort keys %$var) {
- $hash{DPeek ($key)} = { DDump ($var->{$key}, $down) };
+ foreach my $key (sort keys %{$_[0]}) {
+ $hash{DPeek ($key)} = { DDump ($_[0]->{$key}, $down) };
}
return { %hash };
}
@@ -119,16 +119,16 @@
sub _DDump
{
- my ($var, $down, $dump, $fh) = (@_, "");
+ my (undef, $down, $dump, $fh) = (@_, "");
if ($has_perlio and open $fh, ">", \$dump) {
#print STDERR "Using DDump_IO\n";
- DDump_IO ($fh, $var, $down);
+ DDump_IO ($fh, $_[0], $down);
close $fh;
}
else {
#print STDERR "Using DDump_XS\n";
- $dump = DDump_XS ($var);
+ $dump = DDump_XS ($_[0]);
}
return $dump;
@@ -136,8 +136,8 @@
sub DDump ($;$)
{
- my ($var, $down) = (@_, 0);
- my @dump = split m/[\r\n]+/, _DDump ($var, wantarray || $down) or return;
+ my (undef, $down) = (@_, 0);
+ my @dump = split m/[\r\n]+/, _DDump ($_[0], wantarray || $down) or return;
if (wantarray) {
my %hash;
@@ -149,8 +149,8 @@
$hash{FLAGS} = { map { $_ => 1 } split m/,/ => $hash{FLAGS} };
}
- $down && ref $var and
- $hash{RV} = _DDump_ref ($var, $down - 1) || $var;
+ $down && ref $_[0] and
+ $hash{RV} = _DDump_ref ($_[0], $down - 1) || $_[0];
return %hash;
}
@@ -192,7 +192,8 @@
close $fh;
print $dump;
- use Data::Peek qw( triplevar );
+ use Data::Peek qw( DGrow triplevar );
+ my $x = ""; DGrow ($x, 10000);
my $tv = triplevar ("\N{GREEK SMALL LETTER PI}", 3, "3.1415");
=head1 DESCRIPTION
@@ -321,6 +322,24 @@
" RV: ", DPeek ($d[3]), "\n";
}
+=head2 my $LEN = DGrow ($pv, $size)
+
+Fastest way to preallocate space for a PV scalar. Returns the allocated
+length. If $size is smaller than the already allocated space, it will
+not shrink.
+
+ cmpthese (-2, {
+ pack => q{my $x = ""; $x = pack "x20000"; $x = "";},
+ op_x => q{my $x = ""; $x = "x" x 20000; $x = "";},
+ grow => q{my $x = ""; DGrow ($x, 20000); $x = "";},
+ });
+
+ Rate op_x pack grow
+ op_x 62127/s -- -59% -96%
+ pack 152046/s 145% -- -91%
+ grow 1622943/s 2512% 967% --
+
+
=head2 triplevar ($pv, $iv, $nv)
When making C<DDual ()> I wondered if it were possible to create triple-val
Modified: branches/upstream/libdata-peek-perl/current/Peek.xs
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdata-peek-perl/current/Peek.xs?rev=46883&op=diff
==============================================================================
--- branches/upstream/libdata-peek-perl/current/Peek.xs (original)
+++ branches/upstream/libdata-peek-perl/current/Peek.xs Sat Nov 7 15:32:28 2009
@@ -163,6 +163,21 @@
/* XS DDual */
void
+DGrow (sv, size)
+ SV *sv
+ IV size
+
+ PROTOTYPE: $$
+ PPCODE:
+ if (SvROK (sv))
+ sv = SvRV (sv);
+ if (!SvPOK (sv))
+ sv_setpvn (sv, "", 0);
+ SvGROW (sv, size);
+ mPUSHi (SvLEN (sv));
+ /* XS DGrow */
+
+void
DDump_XS (sv)
SV *sv
Modified: branches/upstream/libdata-peek-perl/current/t/30_DDump-s.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdata-peek-perl/current/t/30_DDump-s.t?rev=46883&op=diff
==============================================================================
--- branches/upstream/libdata-peek-perl/current/t/30_DDump-s.t (original)
+++ branches/upstream/libdata-peek-perl/current/t/30_DDump-s.t Sat Nov 7 15:32:28 2009
@@ -65,7 +65,9 @@
SV = PV(0x****) at 0x****
REFCNT = 1
FLAGS = (PADMY)
- PV = 0
+ PV = 0x**** ""\0
+ CUR = 0
+ LEN = 8
==
0
--
@@ -73,7 +75,9 @@
REFCNT = 1
FLAGS = (PADMY,IOK,pIOK)
IV = 0
- PV = 0
+ PV = 0x**** ""\0
+ CUR = 0
+ LEN = 8
==
1
--
@@ -81,7 +85,9 @@
REFCNT = 1
FLAGS = (PADMY,IOK,pIOK)
IV = 1
- PV = 0
+ PV = 0x**** ""\0
+ CUR = 0
+ LEN = 8
==
""
--
Added: branches/upstream/libdata-peek-perl/current/t/52_DGrow.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libdata-peek-perl/current/t/52_DGrow.t?rev=46883&op=file
==============================================================================
--- branches/upstream/libdata-peek-perl/current/t/52_DGrow.t (added)
+++ branches/upstream/libdata-peek-perl/current/t/52_DGrow.t Sat Nov 7 15:32:28 2009
@@ -1,0 +1,25 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 10;
+use Test::NoWarnings;
+
+use Data::Peek qw( DGrow DDump );
+
+my $x = "";
+is (length ($x), 0, "Initial length = 0");
+my %dd = DDump $x;
+ok ($dd{LEN} <= 16);
+ok (my $l = DGrow ($x, 10000), "Set to 10000");
+is (length ($x), 0, "Variable content");
+is ($l, 10000, "returned LEN");
+ %dd = DDump $x;
+is ($dd{LEN}, 10000, "LEN in variable");
+is (DGrow (\$x, 20000), 20000, "Set to 20000");
+ %dd = DDump $x;
+is ($dd{LEN}, 20000);
+is (DGrow ($x, 20), 20000, "Don't shrink");
+
+1;
More information about the Pkg-perl-cvs-commits
mailing list