extra code in pp_concat, Take 2
[p5sagit/p5-mst-13.2.git] / lib / dumpvar.t
CommitLineData
fafebdf5 1#!./perl -- -*- mode: cperl; cperl-indent-level: 4 -*-
2
3BEGIN {
4 chdir 't' if -d 't';
5 @INC = '../lib';
78cd8b71 6 require Config;
98641f60 7 if (($Config::Config{'extensions'} !~ m!\bList/Util\b!) ){
78cd8b71 8 print "1..0 # Skip -- Perl configured without List::Util module\n";
9 exit 0;
10 }
fafebdf5 11}
12
13use strict;
14
15$|=1;
96b31d9e 16
17my @prgs;
18{
19 local $/;
20 @prgs = split "########\n", <DATA>;
21 close DATA;
22}
23
24use Test::More;
25
26plan tests => scalar @prgs;
27
fafebdf5 28require "dumpvar.pl";
29
f97a9a4b 30sub unctrl { print dumpvar::unctrl($_[0]), "\n" }
31sub uniescape { print dumpvar::uniescape($_[0]), "\n" }
32sub stringify { print dumpvar::stringify($_[0]), "\n" }
9bcb75ad 33sub dumpvalue {
2c227d66 34 # Call main::dumpValue exactly as the perl5db.pl calls it.
9bcb75ad 35 local $\ = '';
36 local $, = '';
37 local $" = ' ';
38 my @params = @_;
2c227d66 39 &main::dumpValue(\@params,-1);
9bcb75ad 40}
f97a9a4b 41
42package Foo;
43
44sub new { my $class = shift; bless [ @_ ], $class }
45
46package Bar;
47
48sub new { my $class = shift; bless [ @_ ], $class }
49
50use overload '""' => sub { "Bar<@{$_[0]}>" };
51
52package main;
53
54my $foo = Foo->new(1..5);
55my $bar = Bar->new(1..5);
56
96b31d9e 57for (@prgs) {
58 my($prog, $expected) = split(/\nEXPECT\n?/, $_);
f97a9a4b 59 # TODO: dumpvar::stringify() is controlled by a pile of package
60 # dumpvar variables: $printUndef, $unctrl, $quoteHighBit, $bareStringify,
61 # and so forth. We need to test with various settings of those.
1d8663a3 62 my $out = tie *STDOUT, 'TieOut';
fafebdf5 63 eval $prog;
96b31d9e 64 my $ERR = $@;
1d8663a3 65 untie $out;
96b31d9e 66 if ($ERR) {
67 ok(0, "$prog - $ERR");
68 } else {
f97a9a4b 69 if ($expected =~ m:^/:) {
1d8663a3 70 like($$out, $expected, $prog);
f97a9a4b 71 } else {
1d8663a3 72 is($$out, $expected, $prog);
f97a9a4b 73 }
96b31d9e 74 }
fafebdf5 75}
76
1d8663a3 77package TieOut;
78
79sub TIEHANDLE {
80 bless( \(my $self), $_[0] );
81}
82
83sub PRINT {
84 my $self = shift;
85 $$self .= join('', @_);
86}
87
88sub read {
89 my $self = shift;
90 substr( $$self, 0, length($$self), '' );
91}
92
fafebdf5 93__END__
f97a9a4b 94unctrl("A");
95EXPECT
96A
97########
98unctrl("\cA");
99EXPECT
100^A
101########
102uniescape("A");
103EXPECT
104A
105########
106uniescape("\x{100}");
107EXPECT
108\x{0100}
109########
110stringify(undef);
111EXPECT
112undef
113########
114stringify("foo");
115EXPECT
116'foo'
117########
118stringify("\cA");
119EXPECT
120"\cA"
121########
122stringify(*a);
123EXPECT
124*main::a
125########
126stringify(\undef);
127EXPECT
128/^'SCALAR\(0x[0-9a-f]+\)'$/i
129########
130stringify([]);
131EXPECT
132/^'ARRAY\(0x[0-9a-f]+\)'$/i
133########
134stringify({});
135EXPECT
136/^'HASH\(0x[0-9a-f]+\)'$/i
137########
138stringify(sub{});
139EXPECT
140/^'CODE\(0x[0-9a-f]+\)'$/i
141########
142stringify(\*a);
143EXPECT
144/^'GLOB\(0x[0-9a-f]+\)'$/i
145########
146stringify($foo);
147EXPECT
148/^'Foo=ARRAY\(0x[0-9a-f]+\)'$/i
149########
150stringify($bar);
151EXPECT
152/^'Bar=ARRAY\(0x[0-9a-f]+\)'$/i
153########
154dumpValue(undef);
155EXPECT
156undef
157########
fafebdf5 158dumpValue(1);
159EXPECT
1601
161########
f97a9a4b 162dumpValue("\cA");
163EXPECT
164"\cA"
165########
166dumpValue("\x{100}");
167EXPECT
168'\x{0100}'
169########
fafebdf5 170dumpValue("1\n2\n3");
171EXPECT
172'1
1732
1743'
175########
176dumpValue([1..3],1);
177EXPECT
1780 1
1791 2
1802 3
181########
2c227d66 182dumpValue([1..3]);
183EXPECT
1840 1
1851 2
1862 3
187########
fafebdf5 188dumpValue({1..4},1);
189EXPECT
1901 => 2
1913 => 4
192########
2c227d66 193dumpValue({1..4});
194EXPECT
1951 => 2
1963 => 4
197########
f97a9a4b 198dumpValue($foo,1);
199EXPECT
2000 1
2011 2
2022 3
2033 4
2044 5
205########
2c227d66 206dumpValue($foo);
207EXPECT
2080 1
2091 2
2102 3
2113 4
2124 5
213########
f97a9a4b 214dumpValue($bar,1);
215EXPECT
2160 1
2171 2
2182 3
2193 4
2204 5
221########
2c227d66 222dumpValue($bar);
223EXPECT
2240 1
2251 2
2262 3
2273 4
2284 5
229########
9bcb75ad 230dumpvalue("a");
231EXPECT
2320 'a'
233########
234dumpvalue("\cA");
235EXPECT
2360 "\cA"
237########
238dumpvalue("\x{100}");
239EXPECT
2400 '\x{0100}'
241########
242dumpvalue(undef);
243EXPECT
2440 undef
245########
246dumpvalue("foo");
247EXPECT
2480 'foo'
249########
250dumpvalue(\undef);
251EXPECT
252/0 SCALAR\(0x[0-9a-f]+\)\n -> undef\n/i
253########
254dumpvalue(\\undef);
255EXPECT
256/0 REF\(0x[0-9a-f]+\)\n -> SCALAR\(0x[0-9a-f]+\)\n -> undef\n/i
257########
258dumpvalue([]);
259EXPECT
260/0 ARRAY\(0x[0-9a-f]+\)\n empty array/i
261########
262dumpvalue({});
263EXPECT
264/0 HASH\(0x[0-9a-f]+\)\n\s+empty hash/i
265########
266dumpvalue(sub{});
267EXPECT
268/0 CODE\(0x[0-9a-f]+\)\n -> &CODE\(0x[0-9a-f]+\) in /i
269########
270dumpvalue(\*a);
271EXPECT
272/0 GLOB\(0x[0-9a-f]+\)\n -> \*main::a\n/i
273########
274dumpvalue($foo);
275EXPECT
276/0 Foo=ARRAY\(0x[0-9a-f]+\)\n 0 1\n 1 2\n 2 3\n 3 4\n 4 5\n/i
277########
278dumpvalue($bar);
279EXPECT
280/0 Bar=ARRAY\(0x[0-9a-f]+\)\n 0 1\n 1 2\n 2 3\n 3 4\n 4 5\n/i
281########
282dumpvalue("1\n2\n3")
283EXPECT
284/0 '1\n2\n3'\n/i
285########
286dumpvalue([1..4]);
287EXPECT
288/0 ARRAY\(0x[0-9a-f]+\)\n 0 1\n 1 2\n 2 3\n 3 4\n/i
289########
290dumpvalue({1..4});
291EXPECT
292/0 HASH\(0x[0-9a-f]+\)\n 1 => 2\n 3 => 4\n/i
293########
294dumpvalue({1=>2,3=>4});
295EXPECT
296/0 HASH\(0x[0-9a-f]+\)\n 1 => 2\n 3 => 4\n/i
297########
298dumpvalue({a=>1,b=>2});
299EXPECT
300/0 HASH\(0x[0-9a-f]+\)\n 'a' => 1\n 'b' => 2\n/i
301########
302dumpvalue([{a=>[1,2,3],b=>{c=>1,d=>2}},{e=>{f=>1,g=>2},h=>[qw(i j k)]}]);
303EXPECT
304/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
305########
306dumpvalue({reverse map {$_=>1} sort qw(the quick brown fox)})
307EXPECT
308/0 HASH\(0x[0-9a-f]+\)\n 1 => 'brown'\n/i
309########
310my @x=qw(a b c); dumpvalue(\@x);
311EXPECT
312/0 ARRAY\(0x[0-9a-f]+\)\n 0 'a'\n 1 'b'\n 2 'c'\n/i
313########
314my %x=(a=>1, b=>2); dumpvalue(\%x);
315EXPECT
316/0 HASH\(0x[0-9a-f]+\)\n 'a' => 1\n 'b' => 2\n/i