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