extra code in pp_concat, Take 2
[p5sagit/p5-mst-13.2.git] / lib / dumpvar.t
1 #!./perl -- -*- mode: cperl; cperl-indent-level: 4 -*-
2
3 BEGIN {
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
13 use strict;
14
15 $|=1;
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
28 require "dumpvar.pl";
29
30 sub unctrl    { print dumpvar::unctrl($_[0]), "\n" }
31 sub uniescape { print dumpvar::uniescape($_[0]), "\n" }
32 sub stringify { print dumpvar::stringify($_[0]), "\n" }
33 sub 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
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
52 package main;
53
54 my $foo = Foo->new(1..5);
55 my $bar = Bar->new(1..5);
56
57 for (@prgs) {
58     my($prog, $expected) = split(/\nEXPECT\n?/, $_);
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.
62     my $out = tie *STDOUT, 'TieOut';
63     eval $prog;
64     my $ERR = $@;
65     untie $out;
66     if ($ERR) {
67         ok(0, "$prog - $ERR");
68     } else {
69         if ($expected =~ m:^/:) {
70             like($$out, $expected, $prog);
71         } else {
72             is($$out, $expected, $prog);
73         }
74     }
75 }
76
77 package TieOut;
78
79 sub TIEHANDLE {
80     bless( \(my $self), $_[0] );
81 }
82
83 sub PRINT {
84     my $self = shift;
85     $$self .= join('', @_);
86 }
87
88 sub read {
89     my $self = shift;
90     substr( $$self, 0, length($$self), '' );
91 }
92
93 __END__
94 unctrl("A");
95 EXPECT
96 A
97 ########
98 unctrl("\cA");
99 EXPECT
100 ^A
101 ########
102 uniescape("A");
103 EXPECT
104 A
105 ########
106 uniescape("\x{100}");
107 EXPECT
108 \x{0100}
109 ########
110 stringify(undef);
111 EXPECT
112 undef
113 ########
114 stringify("foo");
115 EXPECT
116 'foo'
117 ########
118 stringify("\cA");
119 EXPECT
120 "\cA"
121 ########
122 stringify(*a);
123 EXPECT
124 *main::a
125 ########
126 stringify(\undef);
127 EXPECT
128 /^'SCALAR\(0x[0-9a-f]+\)'$/i
129 ########
130 stringify([]);
131 EXPECT
132 /^'ARRAY\(0x[0-9a-f]+\)'$/i
133 ########
134 stringify({});
135 EXPECT
136 /^'HASH\(0x[0-9a-f]+\)'$/i
137 ########
138 stringify(sub{});
139 EXPECT
140 /^'CODE\(0x[0-9a-f]+\)'$/i
141 ########
142 stringify(\*a);
143 EXPECT
144 /^'GLOB\(0x[0-9a-f]+\)'$/i
145 ########
146 stringify($foo);
147 EXPECT
148 /^'Foo=ARRAY\(0x[0-9a-f]+\)'$/i
149 ########
150 stringify($bar);
151 EXPECT
152 /^'Bar=ARRAY\(0x[0-9a-f]+\)'$/i
153 ########
154 dumpValue(undef);
155 EXPECT
156 undef
157 ########
158 dumpValue(1);
159 EXPECT
160 1
161 ########
162 dumpValue("\cA");
163 EXPECT
164 "\cA"
165 ########
166 dumpValue("\x{100}");
167 EXPECT
168 '\x{0100}'
169 ########
170 dumpValue("1\n2\n3");
171 EXPECT
172 '1
173 2
174 3'
175 ########
176 dumpValue([1..3],1);
177 EXPECT
178 0  1
179 1  2
180 2  3
181 ########
182 dumpValue([1..3]);
183 EXPECT
184 0  1
185 1  2
186 2  3
187 ########
188 dumpValue({1..4},1);
189 EXPECT
190 1 => 2
191 3 => 4
192 ########
193 dumpValue({1..4});
194 EXPECT
195 1 => 2
196 3 => 4
197 ########
198 dumpValue($foo,1);
199 EXPECT
200 0  1
201 1  2
202 2  3
203 3  4
204 4  5
205 ########
206 dumpValue($foo);
207 EXPECT
208 0  1
209 1  2
210 2  3
211 3  4
212 4  5
213 ########
214 dumpValue($bar,1);
215 EXPECT
216 0  1
217 1  2
218 2  3
219 3  4
220 4  5
221 ########
222 dumpValue($bar);
223 EXPECT
224 0  1
225 1  2
226 2  3
227 3  4
228 4  5
229 ########
230 dumpvalue("a");
231 EXPECT
232 0  'a'
233 ########
234 dumpvalue("\cA");
235 EXPECT
236 0  "\cA"
237 ########
238 dumpvalue("\x{100}");
239 EXPECT
240 0  '\x{0100}'
241 ########
242 dumpvalue(undef);
243 EXPECT
244 0  undef
245 ########
246 dumpvalue("foo");
247 EXPECT
248 0  'foo'
249 ########
250 dumpvalue(\undef);
251 EXPECT
252 /0  SCALAR\(0x[0-9a-f]+\)\n   -> undef\n/i
253 ########
254 dumpvalue(\\undef);
255 EXPECT
256 /0  REF\(0x[0-9a-f]+\)\n   -> SCALAR\(0x[0-9a-f]+\)\n         -> undef\n/i
257 ########
258 dumpvalue([]);
259 EXPECT
260 /0  ARRAY\(0x[0-9a-f]+\)\n     empty array/i
261 ########
262 dumpvalue({});
263 EXPECT
264 /0  HASH\(0x[0-9a-f]+\)\n\s+empty hash/i
265 ########
266 dumpvalue(sub{});
267 EXPECT
268 /0  CODE\(0x[0-9a-f]+\)\n   -> &CODE\(0x[0-9a-f]+\) in /i
269 ########
270 dumpvalue(\*a);
271 EXPECT
272 /0  GLOB\(0x[0-9a-f]+\)\n   -> \*main::a\n/i
273 ########
274 dumpvalue($foo);
275 EXPECT
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 ########
278 dumpvalue($bar);
279 EXPECT
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 ########
282 dumpvalue("1\n2\n3")
283 EXPECT
284 /0  '1\n2\n3'\n/i
285 ########
286 dumpvalue([1..4]);
287 EXPECT
288 /0  ARRAY\(0x[0-9a-f]+\)\n   0  1\n   1  2\n   2  3\n   3  4\n/i
289 ########
290 dumpvalue({1..4});
291 EXPECT
292 /0  HASH\(0x[0-9a-f]+\)\n   1 => 2\n   3 => 4\n/i
293 ########
294 dumpvalue({1=>2,3=>4});
295 EXPECT
296 /0  HASH\(0x[0-9a-f]+\)\n   1 => 2\n   3 => 4\n/i
297 ########
298 dumpvalue({a=>1,b=>2});
299 EXPECT
300 /0  HASH\(0x[0-9a-f]+\)\n   'a' => 1\n   'b' => 2\n/i
301 ########
302 dumpvalue([{a=>[1,2,3],b=>{c=>1,d=>2}},{e=>{f=>1,g=>2},h=>[qw(i j k)]}]);
303 EXPECT
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 ########
306 dumpvalue({reverse map {$_=>1} sort qw(the quick brown fox)})
307 EXPECT
308 /0  HASH\(0x[0-9a-f]+\)\n   1 => 'brown'\n/i
309 ########
310 my @x=qw(a b c); dumpvalue(\@x);
311 EXPECT
312 /0  ARRAY\(0x[0-9a-f]+\)\n   0  'a'\n   1  'b'\n   2  'c'\n/i
313 ########
314 my %x=(a=>1, b=>2); dumpvalue(\%x);
315 EXPECT
316 /0  HASH\(0x[0-9a-f]+\)\n   'a' => 1\n   'b' => 2\n/i