This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Ooops, perlio into scalars was already history for this test...
[perl5.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 }
7
8 use strict;
9
10 $|=1;
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
23 require "dumpvar.pl";
24
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
44 for (@prgs) {
45     my($prog, $expected) = split(/\nEXPECT\n?/, $_);
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.
49     my $out = tie *STDOUT, 'TieOut';
50     eval $prog;
51     my $ERR = $@;
52     untie $out;
53     if ($ERR) {
54         ok(0, "$prog - $ERR");
55     } else {
56         if ($expected =~ m:^/:) {
57             like($$out, $expected, $prog);
58         } else {
59             is($$out, $expected, $prog);
60         }
61     }
62 }
63
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
80 __END__
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 ########
145 dumpValue(1);
146 EXPECT
147 1
148 ########
149 dumpValue("\cA");
150 EXPECT
151 "\cA"
152 ########
153 dumpValue("\x{100}");
154 EXPECT
155 '\x{0100}'
156 ########
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 ########
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 ########