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" } |
28 | |
29 | package Foo; |
30 | |
31 | sub new { my $class = shift; bless [ @_ ], $class } |
32 | |
33 | package Bar; |
34 | |
35 | sub new { my $class = shift; bless [ @_ ], $class } |
36 | |
37 | use overload '""' => sub { "Bar<@{$_[0]}>" }; |
38 | |
39 | package main; |
40 | |
41 | my $foo = Foo->new(1..5); |
42 | my $bar = Bar->new(1..5); |
43 | |
96b31d9e |
44 | for (@prgs) { |
45 | my($prog, $expected) = split(/\nEXPECT\n?/, $_); |
f97a9a4b |
46 | # TODO: dumpvar::stringify() is controlled by a pile of package |
47 | # dumpvar variables: $printUndef, $unctrl, $quoteHighBit, $bareStringify, |
48 | # and so forth. We need to test with various settings of those. |
1d8663a3 |
49 | my $out = tie *STDOUT, 'TieOut'; |
fafebdf5 |
50 | eval $prog; |
96b31d9e |
51 | my $ERR = $@; |
1d8663a3 |
52 | untie $out; |
96b31d9e |
53 | if ($ERR) { |
54 | ok(0, "$prog - $ERR"); |
55 | } else { |
f97a9a4b |
56 | if ($expected =~ m:^/:) { |
1d8663a3 |
57 | like($$out, $expected, $prog); |
f97a9a4b |
58 | } else { |
1d8663a3 |
59 | is($$out, $expected, $prog); |
f97a9a4b |
60 | } |
96b31d9e |
61 | } |
fafebdf5 |
62 | } |
63 | |
1d8663a3 |
64 | package TieOut; |
65 | |
66 | sub TIEHANDLE { |
67 | bless( \(my $self), $_[0] ); |
68 | } |
69 | |
70 | sub PRINT { |
71 | my $self = shift; |
72 | $$self .= join('', @_); |
73 | } |
74 | |
75 | sub read { |
76 | my $self = shift; |
77 | substr( $$self, 0, length($$self), '' ); |
78 | } |
79 | |
fafebdf5 |
80 | __END__ |
f97a9a4b |
81 | unctrl("A"); |
82 | EXPECT |
83 | A |
84 | ######## |
85 | unctrl("\cA"); |
86 | EXPECT |
87 | ^A |
88 | ######## |
89 | uniescape("A"); |
90 | EXPECT |
91 | A |
92 | ######## |
93 | uniescape("\x{100}"); |
94 | EXPECT |
95 | \x{0100} |
96 | ######## |
97 | stringify(undef); |
98 | EXPECT |
99 | undef |
100 | ######## |
101 | stringify("foo"); |
102 | EXPECT |
103 | 'foo' |
104 | ######## |
105 | stringify("\cA"); |
106 | EXPECT |
107 | "\cA" |
108 | ######## |
109 | stringify(*a); |
110 | EXPECT |
111 | *main::a |
112 | ######## |
113 | stringify(\undef); |
114 | EXPECT |
115 | /^'SCALAR\(0x[0-9a-f]+\)'$/i |
116 | ######## |
117 | stringify([]); |
118 | EXPECT |
119 | /^'ARRAY\(0x[0-9a-f]+\)'$/i |
120 | ######## |
121 | stringify({}); |
122 | EXPECT |
123 | /^'HASH\(0x[0-9a-f]+\)'$/i |
124 | ######## |
125 | stringify(sub{}); |
126 | EXPECT |
127 | /^'CODE\(0x[0-9a-f]+\)'$/i |
128 | ######## |
129 | stringify(\*a); |
130 | EXPECT |
131 | /^'GLOB\(0x[0-9a-f]+\)'$/i |
132 | ######## |
133 | stringify($foo); |
134 | EXPECT |
135 | /^'Foo=ARRAY\(0x[0-9a-f]+\)'$/i |
136 | ######## |
137 | stringify($bar); |
138 | EXPECT |
139 | /^'Bar=ARRAY\(0x[0-9a-f]+\)'$/i |
140 | ######## |
141 | dumpValue(undef); |
142 | EXPECT |
143 | undef |
144 | ######## |
fafebdf5 |
145 | dumpValue(1); |
146 | EXPECT |
147 | 1 |
148 | ######## |
f97a9a4b |
149 | dumpValue("\cA"); |
150 | EXPECT |
151 | "\cA" |
152 | ######## |
153 | dumpValue("\x{100}"); |
154 | EXPECT |
155 | '\x{0100}' |
156 | ######## |
fafebdf5 |
157 | dumpValue("1\n2\n3"); |
158 | EXPECT |
159 | '1 |
160 | 2 |
161 | 3' |
162 | ######## |
163 | dumpValue([1..3],1); |
164 | EXPECT |
165 | 0 1 |
166 | 1 2 |
167 | 2 3 |
168 | ######## |
169 | dumpValue({1..4},1); |
170 | EXPECT |
171 | 1 => 2 |
172 | 3 => 4 |
173 | ######## |
f97a9a4b |
174 | dumpValue($foo,1); |
175 | EXPECT |
176 | 0 1 |
177 | 1 2 |
178 | 2 3 |
179 | 3 4 |
180 | 4 5 |
181 | ######## |
182 | dumpValue($bar,1); |
183 | EXPECT |
184 | 0 1 |
185 | 1 2 |
186 | 2 3 |
187 | 3 4 |
188 | 4 5 |
189 | ######## |