xref: /openbsd/gnu/usr.bin/perl/lib/dumpvar.t (revision 91f110e0) 
1#!./perl -- -*- mode: cperl; cperl-indent-level: 4 -*-
2
3BEGIN {
4    chdir 't' if -d 't';
5    @INC = '../lib';
6    require Config;
7    if (($Config::Config{'extensions'} !~ m!\bList/Util\b!) ){
8	print "1..0 # Skip -- Perl configured without List::Util module\n";
9	exit 0;
10    }
11}
12
13use strict;
14
15$|=1;
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
28require "dumpvar.pl";
29
30sub unctrl    { print dumpvar::unctrl($_[0]), "\n" }
31sub uniescape { print dumpvar::uniescape($_[0]), "\n" }
32sub stringify { print dumpvar::stringify($_[0]), "\n" }
33sub dumpvalue {
34	# Call main::dumpValue exactly as the perl5db.pl calls it.
35        local $\ = '';
36        local $, = '';
37        local $" = ' ';
38        my @params = @_;
39        &main::dumpValue(\@params,-1);
40}
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 Tyre;
53
54sub TIESCALAR{bless[]}
55# other methods intentionally omitted
56
57package Kerb;
58
59sub TIEHASH{bless{}}
60# other methods intentionally omitted
61
62package main;
63
64my $foo = Foo->new(1..5);
65my $bar = Bar->new(1..5);
66
67for (@prgs) {
68    my($prog, $expected) = split(/\nEXPECT\n?/, $_);
69    # TODO: dumpvar::stringify() is controlled by a pile of package
70    # dumpvar variables: $printUndef, $unctrl, $quoteHighBit, $bareStringify,
71    # and so forth.  We need to test with various settings of those.
72    my $out = tie *STDOUT, 'TieOut';
73    eval $prog;
74    my $ERR = $@;
75    untie $out;
76    if ($ERR) {
77        ok(0, "$prog - $ERR");
78    } else {
79	if ($expected =~ m:^/:) {
80	    like($$out, $expected, $prog);
81	} else {
82	    is($$out, $expected, $prog);
83	}
84    }
85}
86
87package TieOut;
88
89sub TIEHANDLE {
90    bless( \(my $self), $_[0] );
91}
92
93sub PRINT {
94    my $self = shift;
95    $$self .= join('', @_);
96}
97
98sub read {
99    my $self = shift;
100    substr( $$self, 0, length($$self), '' );
101}
102
103__END__
104unctrl("A");
105EXPECT
106A
107########
108unctrl("\cA");
109EXPECT
110^A
111########
112uniescape("A");
113EXPECT
114A
115########
116uniescape("\x{100}");
117EXPECT
118\x{0100}
119########
120stringify(undef);
121EXPECT
122undef
123########
124stringify("foo");
125EXPECT
126'foo'
127########
128stringify("\cA");
129EXPECT
130"\cA"
131########
132stringify(*a);
133EXPECT
134*main::a
135########
136stringify(\undef);
137EXPECT
138/^'SCALAR\(0x[0-9a-f]+\)'$/i
139########
140stringify([]);
141EXPECT
142/^'ARRAY\(0x[0-9a-f]+\)'$/i
143########
144stringify({});
145EXPECT
146/^'HASH\(0x[0-9a-f]+\)'$/i
147########
148stringify(sub{});
149EXPECT
150/^'CODE\(0x[0-9a-f]+\)'$/i
151########
152stringify(\*a);
153EXPECT
154/^'GLOB\(0x[0-9a-f]+\)'$/i
155########
156stringify($foo);
157EXPECT
158/^'Foo=ARRAY\(0x[0-9a-f]+\)'$/i
159########
160stringify($bar);
161EXPECT
162/^'Bar=ARRAY\(0x[0-9a-f]+\)'$/i
163########
164dumpValue(undef);
165EXPECT
166undef
167########
168dumpValue(1);
169EXPECT
1701
171########
172dumpValue("\cA");
173EXPECT
174"\cA"
175########
176dumpValue("\x{100}");
177EXPECT
178'\x{0100}'
179########
180dumpValue("1\n2\n3");
181EXPECT
182'1
1832
1843'
185########
186dumpValue([1..3],1);
187EXPECT
1880  1
1891  2
1902  3
191########
192dumpValue([1..3]);
193EXPECT
1940  1
1951  2
1962  3
197########
198dumpValue({1..4},1);
199EXPECT
2001 => 2
2013 => 4
202########
203dumpValue({1..4});
204EXPECT
2051 => 2
2063 => 4
207########
208dumpValue($foo,1);
209EXPECT
2100  1
2111  2
2122  3
2133  4
2144  5
215########
216dumpValue($foo);
217EXPECT
2180  1
2191  2
2202  3
2213  4
2224  5
223########
224dumpValue($bar,1);
225EXPECT
2260  1
2271  2
2282  3
2293  4
2304  5
231########
232dumpValue($bar);
233EXPECT
2340  1
2351  2
2362  3
2373  4
2384  5
239########
240dumpvalue("a");
241EXPECT
2420  'a'
243########
244dumpvalue("\cA");
245EXPECT
2460  "\cA"
247########
248dumpvalue("\x{100}");
249EXPECT
2500  '\x{0100}'
251########
252dumpvalue(undef);
253EXPECT
2540  undef
255########
256dumpvalue("foo");
257EXPECT
2580  'foo'
259########
260dumpvalue(\undef);
261EXPECT
262/0  SCALAR\(0x[0-9a-f]+\)\n   -> undef\n/i
263########
264dumpvalue(\\undef);
265EXPECT
266/0  REF\(0x[0-9a-f]+\)\n   -> SCALAR\(0x[0-9a-f]+\)\n         -> undef\n/i
267########
268dumpvalue([]);
269EXPECT
270/0  ARRAY\(0x[0-9a-f]+\)\n     empty array/i
271########
272dumpvalue({});
273EXPECT
274/0  HASH\(0x[0-9a-f]+\)\n\s+empty hash/i
275########
276dumpvalue(sub{});
277EXPECT
278/0  CODE\(0x[0-9a-f]+\)\n   -> &CODE\(0x[0-9a-f]+\) in /i
279########
280dumpvalue(\*a);
281EXPECT
282/0  GLOB\(0x[0-9a-f]+\)\n   -> \*main::a\n/i
283########
284dumpvalue($foo);
285EXPECT
286/0  Foo=ARRAY\(0x[0-9a-f]+\)\n   0  1\n   1  2\n   2  3\n   3  4\n   4  5\n/i
287########
288dumpvalue($bar);
289EXPECT
290/0  Bar=ARRAY\(0x[0-9a-f]+\)\n   0  1\n   1  2\n   2  3\n   3  4\n   4  5\n/i
291########
292dumpvalue("1\n2\n3")
293EXPECT
294/0  '1\n2\n3'\n/i
295########
296dumpvalue([1..4]);
297EXPECT
298/0  ARRAY\(0x[0-9a-f]+\)\n   0  1\n   1  2\n   2  3\n   3  4\n/i
299########
300dumpvalue({1..4});
301EXPECT
302/0  HASH\(0x[0-9a-f]+\)\n   1 => 2\n   3 => 4\n/i
303########
304dumpvalue({1=>2,3=>4});
305EXPECT
306/0  HASH\(0x[0-9a-f]+\)\n   1 => 2\n   3 => 4\n/i
307########
308dumpvalue({a=>1,b=>2});
309EXPECT
310/0  HASH\(0x[0-9a-f]+\)\n   'a' => 1\n   'b' => 2\n/i
311########
312dumpvalue([{a=>[1,2,3],b=>{c=>1,d=>2}},{e=>{f=>1,g=>2},h=>[qw(i j k)]}]);
313EXPECT
314/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
315########
316dumpvalue({reverse map {$_=>1} sort qw(the quick brown fox)})
317EXPECT
318/0  HASH\(0x[0-9a-f]+\)\n   1 => 'brown'\n/i
319########
320my @x=qw(a b c); dumpvalue(\@x);
321EXPECT
322/0  ARRAY\(0x[0-9a-f]+\)\n   0  'a'\n   1  'b'\n   2  'c'\n/i
323########
324my %x=(a=>1, b=>2); dumpvalue(\%x);
325EXPECT
326/0  HASH\(0x[0-9a-f]+\)\n   'a' => 1\n   'b' => 2\n/i
327########
328dumpvalue(bless[1,2,3,4],"a=b=c");
329EXPECT
330/0  a=b=c=ARRAY\(0x[0-9a-f]+\)\n   0  1\n   1  2\n   2  3\n   3  4\n/i
331########
332local *_; tie $_, 'Tyre'; stringify('');
333EXPECT
334''
335########
336local *_; tie $_, 'Tyre'; unctrl('abc');
337EXPECT
338abc
339########
340tie my %h, 'Kerb'; my $v = { a => 1, b => \%h, c => 2 }; dumpvalue($v);
341EXPECT
342/'a' => 1\n.+Can't locate object method.+'c' => 2/s
343