view release on metacpan or  search on metacpan

t/dump.t  view on Meta::CPAN

            'A: $ARRAY1->[1]',
            [],
            'V: $ARRAY1->[3]',
            1
          ];
$ARRAY1->[0] = \$ARRAY1->[5];
alias_av(@$ARRAY1, 2, $ARRAY1->[1]);
$ARRAY1->[4] = $ARRAY1->[3];
EXPECT
}

# with eval testing
{
    my @a= ('a0' .. 'a9');
    unshift @a, \\$a[2];
    same("merlyns test", $o, <<'EXPECT', (\\@a));
$REF1 = \[
          \do { my $v = 'R: ${$REF1}->[3]' },
          'a0',
          'a1',
          'a2',
          'a3',
          'a4',
          'a5',
          'a6',
          'a7',
          'a8',
          'a9'
        ];
${${$REF1}->[0]} = \${$REF1}->[3];
EXPECT
}
{
    my @a= ('a0' .. 'a9');
    unshift @a, \\$a[2];
    test_dump({
            name    => "merlyns test 2",
            verbose => 1
        },
        $o,
        (\\@a),
        <<'EXPECT',);
$REF1 = \[
          \do { my $v = 'R: ${$REF1}->[3]' },
          'a0',
          'a1',
          'a2',
          'a3',
          'a4',
          'a5',
          'a6',
          'a7',
          'a8',
          'a9'
        ];
${${$REF1}->[0]} = \${$REF1}->[3];
EXPECT
}
{
    my $expect= $] >= 5.013_010 ? <<'U_FLAG' : <<'NO_U_FLAG';
$VAR1 = "This contains unicode: /\x{263a}/";
$Regexp1 = qr!This contains unicode: /\x{263a}/!u;
U_FLAG
$VAR1 = "This contains unicode: /\x{263a}/";
$Regexp1 = qr!This contains unicode: /\x{263a}/!;
NO_U_FLAG

    use utf8;
    my $r= "This contains unicode: /\x{263A}/";
    my $qr= qr/$r/;
    test_dump({
            name      => "Unicode qr// and string",
            no_dumper => 1,
            verbose   => 1
        },
        $o,
        ($r, $qr),
        $expect
    );
}
{
    use utf8;
    my $r= "\x{100}\x{101}\x{102}";
    test_dump({
            name      => "Unicode qr// and string",
            no_dumper => 1,
            verbose   => 1
        },
        $o,
        ($r),
        <<'EXPECT',);
$VAR1 = "\x{100}\x{101}\x{102}";
EXPECT
}
{
    use warnings FATAL => 'all';
    my $r= "Günter";
    test_dump({
            name    => "Non unicode, high char",
            verbose => 1
        },
        $o,
        ($r),
        <<'EXPECT',);
$VAR1 = "G\374nter";
EXPECT
}
{
    my $dv= dualvar(unpack('N', 'JAPH'), 'JAPH');
    test_dump({
            name    => "Dualvars(0) ",
            verbose => 1
        },
        $o->Dualvars(0),
        ($dv),
        <<'EXPECT',);
$VAR1 = 'JAPH';
EXPECT
    test_dump({
            name    => "Dualvars(1)",
            verbose => 1
        },
        $o->Dualvars(1),
        ($dv),
        <<'EXPECT',);
$VAR1 = dualvar( 1245794376, 'JAPH' );
EXPECT

}
{
    my ($x, %y, @z);
    $x= \@z;
    our $global= \@z;
    my $res1= Dump($x, \%y, \@z)->Names(qw(x *y *z))->Out();
    my $res3= DumpVars(x => $x, -y => \%y, -z => \@z)->Out();
    is($res1, $res3, 'DumpVars');
    SKIP: {
        skip "needs PadWalker 0.99 or later", 3
            if !eval "use PadWalker 0.99; 1";
        my $res2= DumpLex($x, \%y, \@z)->Out();
        is($res1,                            $res2,      'DumpLex');
        is($res2,                            $res3,      'DumpLex eq DumpVars');
        is("" . DumpLex($x, $global)->Out(), <<'EXPECT', 'DumpLex w/global');
$x = [];
$global = $x;
EXPECT
    }
}
SKIP: {
    skip "needs Compress::Zlib and MIME::Base64", 2
        if !eval "use Compress::Zlib; use MIME::Base64; 1";
    my $str= "a" x 1000;
    my $i= bless \$str, "Fnorble";
    my $rep= MIME::Base64::encode(Compress::Zlib::compress($str, 9), "");

    $o->Compress(-1);
    my $out= $o->Data($i)->Out();
    (my $expect= <<'EXPECT') =~ s/XXX/$rep/;
use Data::Dump::Streamer qw(usqz);