Commit | Line | Data |
fafebdf5 |
1 | #!./perl -- -*- mode: cperl; cperl-indent-level: 4 -*- |
2 | |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
5 | @INC = '../lib'; |
6 | } |
7 | |
8 | use strict; |
9 | |
10 | $|=1; |
96b31d9e |
11 | |
12 | my @prgs; |
13 | { |
14 | local $/; |
15 | @prgs = split "########\n", <DATA>; |
16 | close DATA; |
17 | } |
18 | |
19 | use Test::More; |
20 | |
21 | plan tests => scalar @prgs; |
22 | |
fafebdf5 |
23 | require "dumpvar.pl"; |
24 | |
f97a9a4b |
25 | sub unctrl { print dumpvar::unctrl($_[0]), "\n" } |
26 | sub uniescape { print dumpvar::uniescape($_[0]), "\n" } |
27 | sub stringify { print dumpvar::stringify($_[0]), "\n" } |
9bcb75ad |
28 | sub dumpvalue { |
29 | local $\ = ''; |
30 | local $, = ''; |
31 | local $" = ' '; |
32 | my @params = @_; |
33 | &main::dumpValue(\@params, -1); |
34 | } |
f97a9a4b |
35 | |
36 | package Foo; |
37 | |
38 | sub new { my $class = shift; bless [ @_ ], $class } |
39 | |
40 | package Bar; |
41 | |
42 | sub new { my $class = shift; bless [ @_ ], $class } |
43 | |
44 | use overload '""' => sub { "Bar<@{$_[0]}>" }; |
45 | |
46 | package main; |
47 | |
48 | my $foo = Foo->new(1..5); |
49 | my $bar = Bar->new(1..5); |
50 | |
96b31d9e |
51 | for (@prgs) { |
52 | my($prog, $expected) = split(/\nEXPECT\n?/, $_); |
f97a9a4b |
53 | # TODO: dumpvar::stringify() is controlled by a pile of package |
54 | # dumpvar variables: $printUndef, $unctrl, $quoteHighBit, $bareStringify, |
55 | # and so forth. We need to test with various settings of those. |
1d8663a3 |
56 | my $out = tie *STDOUT, 'TieOut'; |
fafebdf5 |
57 | eval $prog; |
96b31d9e |
58 | my $ERR = $@; |
1d8663a3 |
59 | untie $out; |
96b31d9e |
60 | if ($ERR) { |
61 | ok(0, "$prog - $ERR"); |
62 | } else { |
f97a9a4b |
63 | if ($expected =~ m:^/:) { |
1d8663a3 |
64 | like($$out, $expected, $prog); |
f97a9a4b |
65 | } else { |
1d8663a3 |
66 | is($$out, $expected, $prog); |
f97a9a4b |
67 | } |
96b31d9e |
68 | } |
fafebdf5 |
69 | } |
70 | |
1d8663a3 |
71 | package TieOut; |
72 | |
73 | sub TIEHANDLE { |
74 | bless( \(my $self), $_[0] ); |
75 | } |
76 | |
77 | sub PRINT { |
78 | my $self = shift; |
79 | $$self .= join('', @_); |
80 | } |
81 | |
82 | sub read { |
83 | my $self = shift; |
84 | substr( $$self, 0, length($$self), '' ); |
85 | } |
86 | |
fafebdf5 |
87 | __END__ |
f97a9a4b |
88 | unctrl("A"); |
89 | EXPECT |
90 | A |
91 | ######## |
92 | unctrl("\cA"); |
93 | EXPECT |
94 | ^A |
95 | ######## |
96 | uniescape("A"); |
97 | EXPECT |
98 | A |
99 | ######## |
100 | uniescape("\x{100}"); |
101 | EXPECT |
102 | \x{0100} |
103 | ######## |
104 | stringify(undef); |
105 | EXPECT |
106 | undef |
107 | ######## |
108 | stringify("foo"); |
109 | EXPECT |
110 | 'foo' |
111 | ######## |
112 | stringify("\cA"); |
113 | EXPECT |
114 | "\cA" |
115 | ######## |
116 | stringify(*a); |
117 | EXPECT |
118 | *main::a |
119 | ######## |
120 | stringify(\undef); |
121 | EXPECT |
122 | /^'SCALAR\(0x[0-9a-f]+\)'$/i |
123 | ######## |
124 | stringify([]); |
125 | EXPECT |
126 | /^'ARRAY\(0x[0-9a-f]+\)'$/i |
127 | ######## |
128 | stringify({}); |
129 | EXPECT |
130 | /^'HASH\(0x[0-9a-f]+\)'$/i |
131 | ######## |
132 | stringify(sub{}); |
133 | EXPECT |
134 | /^'CODE\(0x[0-9a-f]+\)'$/i |
135 | ######## |
136 | stringify(\*a); |
137 | EXPECT |
138 | /^'GLOB\(0x[0-9a-f]+\)'$/i |
139 | ######## |
140 | stringify($foo); |
141 | EXPECT |
142 | /^'Foo=ARRAY\(0x[0-9a-f]+\)'$/i |
143 | ######## |
144 | stringify($bar); |
145 | EXPECT |
146 | /^'Bar=ARRAY\(0x[0-9a-f]+\)'$/i |
147 | ######## |
148 | dumpValue(undef); |
149 | EXPECT |
150 | undef |
151 | ######## |
fafebdf5 |
152 | dumpValue(1); |
153 | EXPECT |
154 | 1 |
155 | ######## |
f97a9a4b |
156 | dumpValue("\cA"); |
157 | EXPECT |
158 | "\cA" |
159 | ######## |
160 | dumpValue("\x{100}"); |
161 | EXPECT |
162 | '\x{0100}' |
163 | ######## |
fafebdf5 |
164 | dumpValue("1\n2\n3"); |
165 | EXPECT |
166 | '1 |
167 | 2 |
168 | 3' |
169 | ######## |
170 | dumpValue([1..3],1); |
171 | EXPECT |
172 | 0 1 |
173 | 1 2 |
174 | 2 3 |
175 | ######## |
176 | dumpValue({1..4},1); |
177 | EXPECT |
178 | 1 => 2 |
179 | 3 => 4 |
180 | ######## |
f97a9a4b |
181 | dumpValue($foo,1); |
182 | EXPECT |
183 | 0 1 |
184 | 1 2 |
185 | 2 3 |
186 | 3 4 |
187 | 4 5 |
188 | ######## |
189 | dumpValue($bar,1); |
190 | EXPECT |
191 | 0 1 |
192 | 1 2 |
193 | 2 3 |
194 | 3 4 |
195 | 4 5 |
196 | ######## |
9bcb75ad |
197 | dumpvalue("a"); |
198 | EXPECT |
199 | 0 'a' |
200 | ######## |
201 | dumpvalue("\cA"); |
202 | EXPECT |
203 | 0 "\cA" |
204 | ######## |
205 | dumpvalue("\x{100}"); |
206 | EXPECT |
207 | 0 '\x{0100}' |
208 | ######## |
209 | dumpvalue(undef); |
210 | EXPECT |
211 | 0 undef |
212 | ######## |
213 | dumpvalue("foo"); |
214 | EXPECT |
215 | 0 'foo' |
216 | ######## |
217 | dumpvalue(\undef); |
218 | EXPECT |
219 | /0 SCALAR\(0x[0-9a-f]+\)\n -> undef\n/i |
220 | ######## |
221 | dumpvalue(\\undef); |
222 | EXPECT |
223 | /0 REF\(0x[0-9a-f]+\)\n -> SCALAR\(0x[0-9a-f]+\)\n -> undef\n/i |
224 | ######## |
225 | dumpvalue([]); |
226 | EXPECT |
227 | /0 ARRAY\(0x[0-9a-f]+\)\n empty array/i |
228 | ######## |
229 | dumpvalue({}); |
230 | EXPECT |
231 | /0 HASH\(0x[0-9a-f]+\)\n\s+empty hash/i |
232 | ######## |
233 | dumpvalue(sub{}); |
234 | EXPECT |
235 | /0 CODE\(0x[0-9a-f]+\)\n -> &CODE\(0x[0-9a-f]+\) in /i |
236 | ######## |
237 | dumpvalue(\*a); |
238 | EXPECT |
239 | /0 GLOB\(0x[0-9a-f]+\)\n -> \*main::a\n/i |
240 | ######## |
241 | dumpvalue($foo); |
242 | EXPECT |
243 | /0 Foo=ARRAY\(0x[0-9a-f]+\)\n 0 1\n 1 2\n 2 3\n 3 4\n 4 5\n/i |
244 | ######## |
245 | dumpvalue($bar); |
246 | EXPECT |
247 | /0 Bar=ARRAY\(0x[0-9a-f]+\)\n 0 1\n 1 2\n 2 3\n 3 4\n 4 5\n/i |
248 | ######## |
249 | dumpvalue("1\n2\n3") |
250 | EXPECT |
251 | /0 '1\n2\n3'\n/i |
252 | ######## |
253 | dumpvalue([1..4]); |
254 | EXPECT |
255 | /0 ARRAY\(0x[0-9a-f]+\)\n 0 1\n 1 2\n 2 3\n 3 4\n/i |
256 | ######## |
257 | dumpvalue({1..4}); |
258 | EXPECT |
259 | /0 HASH\(0x[0-9a-f]+\)\n 1 => 2\n 3 => 4\n/i |
260 | ######## |
261 | dumpvalue({1=>2,3=>4}); |
262 | EXPECT |
263 | /0 HASH\(0x[0-9a-f]+\)\n 1 => 2\n 3 => 4\n/i |
264 | ######## |
265 | dumpvalue({a=>1,b=>2}); |
266 | EXPECT |
267 | /0 HASH\(0x[0-9a-f]+\)\n 'a' => 1\n 'b' => 2\n/i |
268 | ######## |
269 | dumpvalue([{a=>[1,2,3],b=>{c=>1,d=>2}},{e=>{f=>1,g=>2},h=>[qw(i j k)]}]); |
270 | EXPECT |
271 | /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 |
272 | ######## |
273 | dumpvalue({reverse map {$_=>1} sort qw(the quick brown fox)}) |
274 | EXPECT |
275 | /0 HASH\(0x[0-9a-f]+\)\n 1 => 'brown'\n/i |
276 | ######## |
277 | my @x=qw(a b c); dumpvalue(\@x); |
278 | EXPECT |
279 | /0 ARRAY\(0x[0-9a-f]+\)\n 0 'a'\n 1 'b'\n 2 'c'\n/i |
280 | ######## |
281 | my %x=(a=>1, b=>2); dumpvalue(\%x); |
282 | EXPECT |
283 | /0 HASH\(0x[0-9a-f]+\)\n 'a' => 1\n 'b' => 2\n/i |