316 lines
5.3 KiB
Perl
316 lines
5.3 KiB
Perl
#!./perl -- -*- mode: cperl; cperl-indent-level: 4 -*-
|
|
|
|
BEGIN {
|
|
chdir 't' if -d 't';
|
|
@INC = '../lib';
|
|
require Config;
|
|
if ((%Config::Config{'extensions'} !~ m!\bList/Util\b!) ){
|
|
print "1..0 # Skip -- Perl configured without List::Util module\n";
|
|
exit 0;
|
|
}
|
|
}
|
|
|
|
use strict;
|
|
|
|
$|=1;
|
|
|
|
my @prgs;
|
|
{
|
|
local $/;
|
|
@prgs = split "########\n", ~< *DATA;
|
|
close DATA;
|
|
}
|
|
|
|
use Test::More;
|
|
|
|
plan tests => scalar @prgs;
|
|
|
|
require "dumpvar.pl";
|
|
|
|
sub unctrl { print dumpvar::unctrl(@_[0]), "\n" }
|
|
sub uniescape { print dumpvar::uniescape(@_[0]), "\n" }
|
|
sub stringify { print dumpvar::stringify(@_[0]), "\n" }
|
|
sub dumpvalue {
|
|
# Call main::dumpValue exactly as the perl5db.pl calls it.
|
|
local $\ = '';
|
|
local $, = '';
|
|
local $" = ' ';
|
|
my @params = @_;
|
|
&main::dumpValue(\@params,-1);
|
|
}
|
|
|
|
package Foo;
|
|
|
|
sub new { my $class = shift; bless \@( @_ ), $class }
|
|
|
|
package Bar;
|
|
|
|
sub new { my $class = shift; bless \@( @_ ), $class }
|
|
|
|
use overload '""' => sub { "Bar<@{@_[0]}>" };
|
|
|
|
package main;
|
|
|
|
my $foo = Foo->new(1..5);
|
|
my $bar = Bar->new(1..5);
|
|
|
|
for (@prgs) {
|
|
my($prog, $expected) = split(m/\nEXPECT\n?/, $_);
|
|
# TODO: dumpvar::stringify() is controlled by a pile of package
|
|
# dumpvar variables: $printUndef, $unctrl, $quoteHighBit, $bareStringify,
|
|
# and so forth. We need to test with various settings of those.
|
|
my $out = tie *STDOUT, 'TieOut';
|
|
eval $prog;
|
|
my $ERR = $@;
|
|
untie $out;
|
|
if ($ERR) {
|
|
ok(0, "$prog - {$ERR->message}");
|
|
} else {
|
|
if ($expected =~ m:^/:) {
|
|
like($$out, $expected, $prog);
|
|
} else {
|
|
is($$out, $expected, $prog);
|
|
}
|
|
}
|
|
}
|
|
|
|
package TieOut;
|
|
|
|
sub TIEHANDLE {
|
|
bless( \(my $self), @_[0] );
|
|
}
|
|
|
|
sub PRINT {
|
|
my $self = shift;
|
|
$$self .= join('', @_);
|
|
}
|
|
|
|
sub read {
|
|
my $self = shift;
|
|
substr( $$self, 0, length($$self), '' );
|
|
}
|
|
|
|
__END__
|
|
unctrl("A");
|
|
EXPECT
|
|
A
|
|
########
|
|
unctrl("\cA");
|
|
EXPECT
|
|
^A
|
|
########
|
|
uniescape("A");
|
|
EXPECT
|
|
A
|
|
########
|
|
uniescape("\x{100}");
|
|
EXPECT
|
|
\x{0100}
|
|
########
|
|
stringify(undef);
|
|
EXPECT
|
|
undef
|
|
########
|
|
stringify("foo");
|
|
EXPECT
|
|
'foo'
|
|
########
|
|
stringify("\cA");
|
|
EXPECT
|
|
"\cA"
|
|
########
|
|
stringify(*a);
|
|
EXPECT
|
|
*main::a
|
|
########
|
|
stringify(\undef);
|
|
EXPECT
|
|
/^'SCALAR\(0x[0-9a-f]+\)'$/i
|
|
########
|
|
stringify(\@());
|
|
EXPECT
|
|
/^'ARRAY\(0x[0-9a-f]+\)'$/i
|
|
########
|
|
stringify(\%());
|
|
EXPECT
|
|
/^'HASH\(0x[0-9a-f]+\)'$/i
|
|
########
|
|
stringify(sub{});
|
|
EXPECT
|
|
/^'CODE\(0x[0-9a-f]+\)'$/i
|
|
########
|
|
stringify(\*a);
|
|
EXPECT
|
|
/^'GLOB\(0x[0-9a-f]+\)'$/i
|
|
########
|
|
stringify($foo);
|
|
EXPECT
|
|
/^'Foo=ARRAY\(0x[0-9a-f]+\)'$/i
|
|
########
|
|
stringify($bar);
|
|
EXPECT
|
|
/^'Bar=ARRAY\(0x[0-9a-f]+\)'$/i
|
|
########
|
|
dumpValue(undef);
|
|
EXPECT
|
|
undef
|
|
########
|
|
dumpValue(1);
|
|
EXPECT
|
|
1
|
|
########
|
|
dumpValue("\cA");
|
|
EXPECT
|
|
"\cA"
|
|
########
|
|
dumpValue("\x{100}");
|
|
EXPECT
|
|
'\x{0100}'
|
|
########
|
|
dumpValue("1\n2\n3");
|
|
EXPECT
|
|
'1
|
|
2
|
|
3'
|
|
########
|
|
dumpValue(\@(1..3),1);
|
|
EXPECT
|
|
0 1
|
|
1 2
|
|
2 3
|
|
########
|
|
dumpValue(\@(1..3));
|
|
EXPECT
|
|
0 1
|
|
1 2
|
|
2 3
|
|
########
|
|
dumpValue(\%(1..4),1);
|
|
EXPECT
|
|
1 => 2
|
|
3 => 4
|
|
########
|
|
dumpValue(\%(1..4));
|
|
EXPECT
|
|
1 => 2
|
|
3 => 4
|
|
########
|
|
dumpValue($foo,1);
|
|
EXPECT
|
|
0 1
|
|
1 2
|
|
2 3
|
|
3 4
|
|
4 5
|
|
########
|
|
dumpValue($foo);
|
|
EXPECT
|
|
0 1
|
|
1 2
|
|
2 3
|
|
3 4
|
|
4 5
|
|
########
|
|
dumpValue($bar,1);
|
|
EXPECT
|
|
0 1
|
|
1 2
|
|
2 3
|
|
3 4
|
|
4 5
|
|
########
|
|
dumpValue($bar);
|
|
EXPECT
|
|
0 1
|
|
1 2
|
|
2 3
|
|
3 4
|
|
4 5
|
|
########
|
|
dumpvalue("a");
|
|
EXPECT
|
|
0 'a'
|
|
########
|
|
dumpvalue("\cA");
|
|
EXPECT
|
|
0 "\cA"
|
|
########
|
|
dumpvalue("\x{100}");
|
|
EXPECT
|
|
0 '\x{0100}'
|
|
########
|
|
dumpvalue(undef);
|
|
EXPECT
|
|
0 undef
|
|
########
|
|
dumpvalue("foo");
|
|
EXPECT
|
|
0 'foo'
|
|
########
|
|
dumpvalue(\undef);
|
|
EXPECT
|
|
/0 SCALAR\(0x[0-9a-f]+\)\n -> undef\n/i
|
|
########
|
|
dumpvalue(\\undef);
|
|
EXPECT
|
|
/0 REF\(0x[0-9a-f]+\)\n -> SCALAR\(0x[0-9a-f]+\)\n -> undef\n/i
|
|
########
|
|
dumpvalue(\@());
|
|
EXPECT
|
|
/0 ARRAY\(0x[0-9a-f]+\)\n empty array/i
|
|
########
|
|
dumpvalue(\%());
|
|
EXPECT
|
|
/0 HASH\(0x[0-9a-f]+\)\n\s+empty hash/i
|
|
########
|
|
dumpvalue(sub{});
|
|
EXPECT
|
|
/0 CODE\(0x[0-9a-f]+\)\n -> &CODE\(0x[0-9a-f]+\) in /i
|
|
########
|
|
dumpvalue(\*a);
|
|
EXPECT
|
|
/0 GLOB\(0x[0-9a-f]+\)\n -> \*main::a\n/i
|
|
########
|
|
dumpvalue($foo);
|
|
EXPECT
|
|
/0 Foo=ARRAY\(0x[0-9a-f]+\)\n 0 1\n 1 2\n 2 3\n 3 4\n 4 5\n/i
|
|
########
|
|
dumpvalue($bar);
|
|
EXPECT
|
|
/0 Bar=ARRAY\(0x[0-9a-f]+\)\n 0 1\n 1 2\n 2 3\n 3 4\n 4 5\n/i
|
|
########
|
|
dumpvalue("1\n2\n3")
|
|
EXPECT
|
|
/0 '1\n2\n3'\n/i
|
|
########
|
|
dumpvalue(\@(1..4));
|
|
EXPECT
|
|
/0 ARRAY\(0x[0-9a-f]+\)\n 0 1\n 1 2\n 2 3\n 3 4\n/i
|
|
########
|
|
dumpvalue(\%(1..4));
|
|
EXPECT
|
|
/0 HASH\(0x[0-9a-f]+\)\n 1 => 2\n 3 => 4\n/i
|
|
########
|
|
dumpvalue(\%(1=>2,3=>4));
|
|
EXPECT
|
|
/0 HASH\(0x[0-9a-f]+\)\n 1 => 2\n 3 => 4\n/i
|
|
########
|
|
dumpvalue(\%(a=>1,b=>2));
|
|
EXPECT
|
|
/0 HASH\(0x[0-9a-f]+\)\n 'a' => 1\n 'b' => 2\n/i
|
|
########
|
|
dumpvalue(\@(\%(a=>\@(1,2,3),b=>\%(c=>1,d=>2)),\%(e=>\%(f=>1,g=>2),h=>\@(qw(i j k)))));
|
|
EXPECT
|
|
/0 ARRAY\(0x[0-9a-f]+\)\n 0 HASH\(0x[0-9a-f]+\)\n 'a' => ARRAY\(0x[0-9a-f]+\)\n 0 1\n 1 2\n 2 3\n 'b' => HASH\(0x[0-9a-f]+\)\n 'c' => 1\n 'd' => 2\n 1 HASH\(0x[0-9a-f]+\)\n 'e' => HASH\(0x[0-9a-f]+\)\n 'f' => 1\n 'g' => 2\n 'h' => ARRAY\(0x[0-9a-f]+\)\n 0 'i'\n 1 'j'\n 2 'k'/i
|
|
########
|
|
dumpvalue(\%(reverse map {$_=>1} sort qw(the quick brown fox)))
|
|
EXPECT
|
|
/0 HASH\(0x[0-9a-f]+\)\n 1 => 'brown'\n/i
|
|
########
|
|
my @x=qw(a b c); dumpvalue(\@x);
|
|
EXPECT
|
|
/0 ARRAY\(0x[0-9a-f]+\)\n 0 'a'\n 1 'b'\n 2 'c'\n/i
|
|
########
|
|
my %x=(a=>1, b=>2); dumpvalue(\%x);
|
|
EXPECT
|
|
/0 HASH\(0x[0-9a-f]+\)\n 'a' => 1\n 'b' => 2\n/i
|