From a607cc98a882f2680c6fb6b98c535c5c8a323d6c Mon Sep 17 00:00:00 2001 From: "H.Merijn Brand" Date: Fri, 6 Nov 2009 23:08:24 +0100 Subject: [PATCH] Add DGrow () The problem is that DDump passes *a copy of* the scalar to DDump_XS or DDump_IO. The copying process doesn't preserve the allocated space. The attached patch fixes this, making t/52_DGrow.t pass (apart from the incorrect test count), but also makes most of t/30_DDump-s.t fail, because it was relying on a similar side-effect of the copying. --- ChangeLog | 5 +++++ Peek.pm | 39 +++++++++++++++++++++++---------------- Peek.xs | 15 +++++++++++++++ sandbox/genMETA.pl | 2 +- t/30_DDump-s.t | 12 +++++++++--- t/52_DGrow.t | 25 +++++++++++++++++++++++++ 6 files changed, 78 insertions(+), 20 deletions(-) create mode 100644 t/52_DGrow.t diff --git a/ChangeLog b/ChangeLog index e1ba44b..ccb54b1 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2009-11-06 0.28 - H.Merijn Brand + + * DDump () now dumps the variable itself, instead of a copy (Zefram) + * Add DGrow () + 2009-06-03 0.27 - H.Merijn Brand * void context behaviour for DPeek () diff --git a/Peek.pm b/Peek.pm index 764cf5e..a523b1d 100644 --- a/Peek.pm +++ b/Peek.pm @@ -6,9 +6,9 @@ use warnings; use DynaLoader (); use vars qw( $VERSION @ISA @EXPORT @EXPORT_OK ); -$VERSION = "0.27"; +$VERSION = "0.28"; @ISA = qw( DynaLoader Exporter ); -@EXPORT = qw( DDumper DDsort DPeek DDisplay DDump DDual ); +@EXPORT = qw( DDumper DDsort DPeek DDisplay DDump DDual DGrow ); @EXPORT_OK = qw( triplevar ); $] >= 5.007003 and push @EXPORT, "DDump_IO"; @@ -92,16 +92,16 @@ BEGIN { sub _DDump_ref { - my ($var, $down) = (@_, 0); + my (undef, $down) = (@_, 0); - my $ref = ref $var; + 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 @@ sub _DDump_ref } 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_ref 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 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 @@ sub DDump ($;$) $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 @@ Data::Peek - A collection of low-level debug facilities 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,12 @@ In void context, DDual does the equivalent of " 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. + =head2 triplevar ($pv, $iv, $nv) When making C I wondered if it were possible to create triple-val diff --git a/Peek.xs b/Peek.xs index 20f7740..d9d6063 100644 --- a/Peek.xs +++ b/Peek.xs @@ -163,6 +163,21 @@ DDual (sv, ...) /* 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 diff --git a/sandbox/genMETA.pl b/sandbox/genMETA.pl index 79d88b3..f8bb3e3 100755 --- a/sandbox/genMETA.pl +++ b/sandbox/genMETA.pl @@ -75,7 +75,7 @@ requires: perl: 5.006 DynaLoader: 0 recommends: - perl: 5.008005 + perl: 5.010001 configure_requires: ExtUtils::MakeMaker: 0 build_requires: diff --git a/t/30_DDump-s.t b/t/30_DDump-s.t index 7856465..ae468d5 100644 --- a/t/30_DDump-s.t +++ b/t/30_DDump-s.t @@ -65,7 +65,9 @@ undef SV = PV(0x****) at 0x**** REFCNT = 1 FLAGS = (PADMY) - PV = 0 + PV = 0x**** ""\0 + CUR = 0 + LEN = 8 == 0 -- @@ -73,7 +75,9 @@ SV = PVIV(0x****) at 0x**** REFCNT = 1 FLAGS = (PADMY,IOK,pIOK) IV = 0 - PV = 0 + PV = 0x**** ""\0 + CUR = 0 + LEN = 8 == 1 -- @@ -81,7 +85,9 @@ SV = PVIV(0x****) at 0x**** REFCNT = 1 FLAGS = (PADMY,IOK,pIOK) IV = 1 - PV = 0 + PV = 0x**** ""\0 + CUR = 0 + LEN = 8 == "" -- diff --git a/t/52_DGrow.t b/t/52_DGrow.t new file mode 100644 index 0000000..43bec96 --- /dev/null +++ b/t/52_DGrow.t @@ -0,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; -- 2.11.4.GIT