Commit | Line | Data |
---|---|---|
fafebdf5 A |
1 | #!./perl -- -*- mode: cperl; cperl-indent-level: 4 -*- |
2 | ||
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
5 | @INC = '../lib'; | |
78cd8b71 | 6 | require Config; |
98641f60 | 7 | if (($Config::Config{'extensions'} !~ m!\bList/Util\b!) ){ |
78cd8b71 NC |
8 | print "1..0 # Skip -- Perl configured without List::Util module\n"; |
9 | exit 0; | |
10 | } | |
fafebdf5 A |
11 | } |
12 | ||
13 | use strict; | |
14 | ||
15 | $|=1; | |
96b31d9e JH |
16 | |
17 | my @prgs; | |
18 | { | |
19 | local $/; | |
20 | @prgs = split "########\n", <DATA>; | |
21 | close DATA; | |
22 | } | |
23 | ||
24 | use Test::More; | |
25 | ||
26 | plan tests => scalar @prgs; | |
27 | ||
fafebdf5 A |
28 | require "dumpvar.pl"; |
29 | ||
f97a9a4b JH |
30 | sub unctrl { print dumpvar::unctrl($_[0]), "\n" } |
31 | sub uniescape { print dumpvar::uniescape($_[0]), "\n" } | |
32 | sub stringify { print dumpvar::stringify($_[0]), "\n" } | |
9bcb75ad | 33 | sub dumpvalue { |
2c227d66 | 34 | # Call main::dumpValue exactly as the perl5db.pl calls it. |
9bcb75ad JM |
35 | local $\ = ''; |
36 | local $, = ''; | |
37 | local $" = ' '; | |
38 | my @params = @_; | |
2c227d66 | 39 | &main::dumpValue(\@params,-1); |
9bcb75ad | 40 | } |
f97a9a4b JH |
41 | |
42 | package Foo; | |
43 | ||
44 | sub new { my $class = shift; bless [ @_ ], $class } | |
45 | ||
46 | package Bar; | |
47 | ||
48 | sub new { my $class = shift; bless [ @_ ], $class } | |
49 | ||
50 | use overload '""' => sub { "Bar<@{$_[0]}>" }; | |
51 | ||
6cee328e FC |
52 | package Tyre; |
53 | ||
54 | sub TIESCALAR{bless[]} | |
55 | # other methods intentionally omitted | |
56 | ||
0d0268b0 RS |
57 | package Kerb; |
58 | ||
59 | sub TIEHASH{bless{}} | |
60 | # other methods intentionally omitted | |
61 | ||
f97a9a4b JH |
62 | package main; |
63 | ||
64 | my $foo = Foo->new(1..5); | |
65 | my $bar = Bar->new(1..5); | |
66 | ||
96b31d9e JH |
67 | for (@prgs) { |
68 | my($prog, $expected) = split(/\nEXPECT\n?/, $_); | |
f97a9a4b JH |
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. | |
1d8663a3 | 72 | my $out = tie *STDOUT, 'TieOut'; |
fafebdf5 | 73 | eval $prog; |
96b31d9e | 74 | my $ERR = $@; |
1d8663a3 | 75 | untie $out; |
96b31d9e JH |
76 | if ($ERR) { |
77 | ok(0, "$prog - $ERR"); | |
78 | } else { | |
f97a9a4b | 79 | if ($expected =~ m:^/:) { |
1d8663a3 | 80 | like($$out, $expected, $prog); |
f97a9a4b | 81 | } else { |
1d8663a3 | 82 | is($$out, $expected, $prog); |
f97a9a4b | 83 | } |
96b31d9e | 84 | } |
fafebdf5 A |
85 | } |
86 | ||
1d8663a3 JH |
87 | package TieOut; |
88 | ||
89 | sub TIEHANDLE { | |
90 | bless( \(my $self), $_[0] ); | |
91 | } | |
92 | ||
93 | sub PRINT { | |
94 | my $self = shift; | |
95 | $$self .= join('', @_); | |
96 | } | |
97 | ||
98 | sub read { | |
99 | my $self = shift; | |
100 | substr( $$self, 0, length($$self), '' ); | |
101 | } | |
102 | ||
fafebdf5 | 103 | __END__ |
f97a9a4b JH |
104 | unctrl("A"); |
105 | EXPECT | |
106 | A | |
107 | ######## | |
108 | unctrl("\cA"); | |
109 | EXPECT | |
110 | ^A | |
111 | ######## | |
112 | uniescape("A"); | |
113 | EXPECT | |
114 | A | |
115 | ######## | |
116 | uniescape("\x{100}"); | |
117 | EXPECT | |
118 | \x{0100} | |
119 | ######## | |
120 | stringify(undef); | |
121 | EXPECT | |
122 | undef | |
123 | ######## | |
124 | stringify("foo"); | |
125 | EXPECT | |
126 | 'foo' | |
127 | ######## | |
128 | stringify("\cA"); | |
129 | EXPECT | |
130 | "\cA" | |
131 | ######## | |
132 | stringify(*a); | |
133 | EXPECT | |
134 | *main::a | |
135 | ######## | |
136 | stringify(\undef); | |
137 | EXPECT | |
138 | /^'SCALAR\(0x[0-9a-f]+\)'$/i | |
139 | ######## | |
140 | stringify([]); | |
141 | EXPECT | |
142 | /^'ARRAY\(0x[0-9a-f]+\)'$/i | |
143 | ######## | |
144 | stringify({}); | |
145 | EXPECT | |
146 | /^'HASH\(0x[0-9a-f]+\)'$/i | |
147 | ######## | |
148 | stringify(sub{}); | |
149 | EXPECT | |
150 | /^'CODE\(0x[0-9a-f]+\)'$/i | |
151 | ######## | |
152 | stringify(\*a); | |
153 | EXPECT | |
154 | /^'GLOB\(0x[0-9a-f]+\)'$/i | |
155 | ######## | |
156 | stringify($foo); | |
157 | EXPECT | |
158 | /^'Foo=ARRAY\(0x[0-9a-f]+\)'$/i | |
159 | ######## | |
160 | stringify($bar); | |
161 | EXPECT | |
162 | /^'Bar=ARRAY\(0x[0-9a-f]+\)'$/i | |
163 | ######## | |
164 | dumpValue(undef); | |
165 | EXPECT | |
166 | undef | |
167 | ######## | |
fafebdf5 A |
168 | dumpValue(1); |
169 | EXPECT | |
170 | 1 | |
171 | ######## | |
f97a9a4b JH |
172 | dumpValue("\cA"); |
173 | EXPECT | |
174 | "\cA" | |
175 | ######## | |
176 | dumpValue("\x{100}"); | |
177 | EXPECT | |
178 | '\x{0100}' | |
179 | ######## | |
fafebdf5 A |
180 | dumpValue("1\n2\n3"); |
181 | EXPECT | |
182 | '1 | |
183 | 2 | |
184 | 3' | |
185 | ######## | |
186 | dumpValue([1..3],1); | |
187 | EXPECT | |
188 | 0 1 | |
189 | 1 2 | |
190 | 2 3 | |
191 | ######## | |
2c227d66 JH |
192 | dumpValue([1..3]); |
193 | EXPECT | |
194 | 0 1 | |
195 | 1 2 | |
196 | 2 3 | |
197 | ######## | |
fafebdf5 A |
198 | dumpValue({1..4},1); |
199 | EXPECT | |
200 | 1 => 2 | |
201 | 3 => 4 | |
202 | ######## | |
2c227d66 JH |
203 | dumpValue({1..4}); |
204 | EXPECT | |
205 | 1 => 2 | |
206 | 3 => 4 | |
207 | ######## | |
f97a9a4b JH |
208 | dumpValue($foo,1); |
209 | EXPECT | |
210 | 0 1 | |
211 | 1 2 | |
212 | 2 3 | |
213 | 3 4 | |
214 | 4 5 | |
215 | ######## | |
2c227d66 JH |
216 | dumpValue($foo); |
217 | EXPECT | |
218 | 0 1 | |
219 | 1 2 | |
220 | 2 3 | |
221 | 3 4 | |
222 | 4 5 | |
223 | ######## | |
f97a9a4b JH |
224 | dumpValue($bar,1); |
225 | EXPECT | |
226 | 0 1 | |
227 | 1 2 | |
228 | 2 3 | |
229 | 3 4 | |
230 | 4 5 | |
231 | ######## | |
2c227d66 JH |
232 | dumpValue($bar); |
233 | EXPECT | |
234 | 0 1 | |
235 | 1 2 | |
236 | 2 3 | |
237 | 3 4 | |
238 | 4 5 | |
239 | ######## | |
9bcb75ad JM |
240 | dumpvalue("a"); |
241 | EXPECT | |
242 | 0 'a' | |
243 | ######## | |
244 | dumpvalue("\cA"); | |
245 | EXPECT | |
246 | 0 "\cA" | |
247 | ######## | |
248 | dumpvalue("\x{100}"); | |
249 | EXPECT | |
250 | 0 '\x{0100}' | |
251 | ######## | |
252 | dumpvalue(undef); | |
253 | EXPECT | |
254 | 0 undef | |
255 | ######## | |
256 | dumpvalue("foo"); | |
257 | EXPECT | |
258 | 0 'foo' | |
259 | ######## | |
260 | dumpvalue(\undef); | |
261 | EXPECT | |
262 | /0 SCALAR\(0x[0-9a-f]+\)\n -> undef\n/i | |
263 | ######## | |
264 | dumpvalue(\\undef); | |
265 | EXPECT | |
266 | /0 REF\(0x[0-9a-f]+\)\n -> SCALAR\(0x[0-9a-f]+\)\n -> undef\n/i | |
267 | ######## | |
268 | dumpvalue([]); | |
269 | EXPECT | |
270 | /0 ARRAY\(0x[0-9a-f]+\)\n empty array/i | |
271 | ######## | |
272 | dumpvalue({}); | |
273 | EXPECT | |
274 | /0 HASH\(0x[0-9a-f]+\)\n\s+empty hash/i | |
275 | ######## | |
276 | dumpvalue(sub{}); | |
277 | EXPECT | |
278 | /0 CODE\(0x[0-9a-f]+\)\n -> &CODE\(0x[0-9a-f]+\) in /i | |
279 | ######## | |
280 | dumpvalue(\*a); | |
281 | EXPECT | |
282 | /0 GLOB\(0x[0-9a-f]+\)\n -> \*main::a\n/i | |
283 | ######## | |
284 | dumpvalue($foo); | |
285 | EXPECT | |
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 | ######## | |
288 | dumpvalue($bar); | |
289 | EXPECT | |
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 | ######## | |
292 | dumpvalue("1\n2\n3") | |
293 | EXPECT | |
294 | /0 '1\n2\n3'\n/i | |
295 | ######## | |
296 | dumpvalue([1..4]); | |
297 | EXPECT | |
298 | /0 ARRAY\(0x[0-9a-f]+\)\n 0 1\n 1 2\n 2 3\n 3 4\n/i | |
299 | ######## | |
300 | dumpvalue({1..4}); | |
301 | EXPECT | |
302 | /0 HASH\(0x[0-9a-f]+\)\n 1 => 2\n 3 => 4\n/i | |
303 | ######## | |
304 | dumpvalue({1=>2,3=>4}); | |
305 | EXPECT | |
306 | /0 HASH\(0x[0-9a-f]+\)\n 1 => 2\n 3 => 4\n/i | |
307 | ######## | |
308 | dumpvalue({a=>1,b=>2}); | |
309 | EXPECT | |
310 | /0 HASH\(0x[0-9a-f]+\)\n 'a' => 1\n 'b' => 2\n/i | |
311 | ######## | |
312 | dumpvalue([{a=>[1,2,3],b=>{c=>1,d=>2}},{e=>{f=>1,g=>2},h=>[qw(i j k)]}]); | |
313 | EXPECT | |
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 | ######## | |
316 | dumpvalue({reverse map {$_=>1} sort qw(the quick brown fox)}) | |
317 | EXPECT | |
318 | /0 HASH\(0x[0-9a-f]+\)\n 1 => 'brown'\n/i | |
319 | ######## | |
320 | my @x=qw(a b c); dumpvalue(\@x); | |
321 | EXPECT | |
322 | /0 ARRAY\(0x[0-9a-f]+\)\n 0 'a'\n 1 'b'\n 2 'c'\n/i | |
323 | ######## | |
324 | my %x=(a=>1, b=>2); dumpvalue(\%x); | |
325 | EXPECT | |
326 | /0 HASH\(0x[0-9a-f]+\)\n 'a' => 1\n 'b' => 2\n/i | |
d5dd42fa FC |
327 | ######## |
328 | dumpvalue(bless[1,2,3,4],"a=b=c"); | |
329 | EXPECT | |
330 | /0 a=b=c=ARRAY\(0x[0-9a-f]+\)\n 0 1\n 1 2\n 2 3\n 3 4\n/i | |
6cee328e FC |
331 | ######## |
332 | local *_; tie $_, 'Tyre'; stringify(''); | |
333 | EXPECT | |
334 | '' | |
335 | ######## | |
336 | local *_; tie $_, 'Tyre'; unctrl('abc'); | |
337 | EXPECT | |
338 | abc | |
0d0268b0 RS |
339 | ######## |
340 | tie my %h, 'Kerb'; my $v = { a => 1, b => \%h, c => 2 }; dumpvalue($v); | |
341 | EXPECT | |
342 | /'a' => 1\n.+Can't locate object method.+'c' => 2/s |