Data-Peek

 view release on metacpan or  search on metacpan

Peek.pm  view on Meta::CPAN

    else {
	#print STDERR "Using DDump_XS\n";
	$dump = DDump_XS ($_[0]);
	}

    return $dump;
    } # _DDump

sub DDump {
    my $down = @_ > 1 ? $_[1] : 0;
    my @dump = split m/[\r\n]+/, _DDump (@_ ? $_[0] : $_, wantarray || $down) or return;

    if (wantarray) {
	my %hash;
	($hash{'sv'} = $dump[0]) =~ s/^SV\s*=\s*//;
	m/^\s+(\w+)\s*=\s*(.*)/ and $hash{$1} = $2 for @dump;

	if (exists $hash{'FLAGS'}) {
	    $hash{'FLAGS'} =~ tr/()//d;
	    $hash{'FLAGS'} = { map {( $_ => 1 )} split m/,/ => $hash{'FLAGS'} };
	    }

	$down && ref $_[0] and
	    $hash{'RV'} = _DDump_ref ($_[0], $down - 1) || $_[0];
	return %hash;
	}

    my $dump = join "\n", @dump, "";

    defined wantarray and return $dump;

t/10_DDumper.t  view on Meta::CPAN

use Test::Warnings;

BEGIN {
    use_ok "Data::Peek";
    die "Cannot load Data::Peek\n" if $@;	# BAIL_OUT not avail in old Test::More
    }

my ($dump, $var) = ("", "");
while (<DATA>) {
    chomp;
    my ($v, $exp, $re) = split m/\t+ */;

    if ($v eq "--") {
	ok (1, "** $exp");
	next;
	}

    $v =~ s/^S:([^:]*):// and DDsort ($1), $v =~ m/^()/; # And reset $1 for below

    unless ($v eq "") {
	eval "\$var = $v";

t/11_DDumper.t  view on Meta::CPAN

	done_testing;
	exit 0;
	}
    use_ok ("Data::Peek", ":tidy");
    die "Cannot load Data::Peek\n" if $@;
    }

my ($dump, $var) = ("", "");
while (<DATA>) {
    chomp;
    my ($v, $exp, $re) = split m/\t+ */;

    if ($v eq "--") {
	ok (1, "** $exp");
	next;
	}

    $v =~ s/^S:([^:]*):// and DDsort ($1), $v =~ m/^()/; # And reset $1 for below

    unless ($v eq "") {
	eval "\$var = $v";

t/22_DHexDump.t  view on Meta::CPAN

use Test::Warnings;

use Config;
use Data::Peek;

my $is_ebcdic = ($Config{ebcdic} || "undef") eq "define" ? 1 : 0;

is (DHexDump (undef),		undef,			'undef');
is (DHexDump (""),		"",			'""');

for (split m/##\n/ => test_data ()) {
    my ($desc, $in, @out) = split m/\n-\n/, $_, 4;
    my $out = $out[$is_ebcdic];
    $out =~ s/\n*\z/\n/;

    if ($in =~ s/\t(\d+)$//) {
	is (scalar DHexDump ($in, $1), $out,	"HexDump $desc");
	}
    else {
	is (scalar DHexDump ($in),     $out,	"HexDump $desc");
	}
    }

t/30_DDump-s.t  view on Meta::CPAN

{   local $/ = "==\n";
    chomp (@tests = <DATA>);
    }

# Determine what newlines this perl generates in sv_peek
my @nl = ("\\n") x 2;

my $var = "";

foreach my $test (@tests) {
    my ($in, $expect) = split m/\n--\n/ => $test;
    $in eq "" and next;
    SKIP: {
	my $dump;
	if ($in eq "DEFSV") {
	    $_ = undef;
	    $_ = "DEFSV";
	    $dump = DDump;
	    }
	else {
	    eval "\$var = $in;";

t/30_DDump-s.t  view on Meta::CPAN

	    $dump =~ s/"ab\Q$nl[0]\E(.*?)"ab\Q$nl[1]\E/"ab\\n$1"ab\\n/g;
	    }

	$dump =~ s/\b0x[0-9a-f]+\b/0x****/g;
	$dump =~ s/\b(REFCNT =) [0-9]{4,}/$1 -1/g;

	$dump =~ s/\bLEN = (?:[1-9]|1[0-6])\b/LEN = 8/g; # aligned at long long?

	$dump =~ s/\bPADBUSY\b,?//g	if $] < 5.010;

	my @expect = split m/(?<=\n)\|(?:\s*#.*)?\n+/ => $expect;

	$in   =~ s/[\s\n]+/ /g;

	if (my @match = grep { $dump eq $_ } @expect) {
	    is ($dump, $match[0], "DDump ($in)");
	    }
	else {
	    my $match = pop @expect;
	    is ($dump, $match, "DDump ($in)");
	    diag ("DDump ($in) neither matches\n$_") for @expect;

t/50_DDual.t  view on Meta::CPAN

sub neat
{
    my $neat = $_[0];
    defined $neat or return "undef";
    my $ref = ref $neat ? "\\" : "" and $neat = $$neat;
    join "", $ref, map {
	my $cp = ord $_;
	$cp >= 0x20 && $cp <= 0x7e
	    ? $_
	    : $special{$cp} || sprintf "\\x{%02x}", $cp
	} split m//, $neat;
    } # neat

foreach my $test (
	[ undef,	undef, undef, undef, undef, 0, undef	],
	[ 0,		undef, 0,     undef, undef, 0, undef	],
	[ 1,		undef, 1,     undef, undef, 0, undef	],
	[ 0.5,		undef, undef, 0.5,   undef, 0, 0	],
	[ "",		"",    undef, undef, undef, 0, 0	],
	[ \0,		undef, undef, undef, 0,     0, undef	],
	[ \"a",		undef, undef, undef, "a",   0, undef	],