This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
b60afa6275aa6700efb53de1b07707e6d70f7195
[perl5.git] / lib / perl5db / 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') { # 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     open my $select, ">", \my $got or die;
54     select $select;
55     eval $prog;
56     my $ERR = $@;
57     close $select;
58     select STDOUT;
59     if ($ERR) {
60         ok(0, "$prog - $ERR");
61     } else {
62         if ($expected =~ m:^/:) {
63             like($got, $expected, $prog);
64         } else {
65             is($got, $expected, $prog);
66         }
67     }
68 }
69
70 __END__
71 unctrl("A");
72 EXPECT
73 A
74 ########
75 unctrl("\cA");
76 EXPECT
77 ^A
78 ########
79 uniescape("A");
80 EXPECT
81 A
82 ########
83 uniescape("\x{100}");
84 EXPECT
85 \x{0100}
86 ########
87 stringify(undef);
88 EXPECT
89 undef
90 ########
91 stringify("foo");
92 EXPECT
93 'foo'
94 ########
95 stringify("\cA");
96 EXPECT
97 "\cA"
98 ########
99 stringify(*a);
100 EXPECT
101 *main::a
102 ########
103 stringify(\undef);
104 EXPECT
105 /^'SCALAR\(0x[0-9a-f]+\)'$/i
106 ########
107 stringify([]);
108 EXPECT
109 /^'ARRAY\(0x[0-9a-f]+\)'$/i
110 ########
111 stringify({});
112 EXPECT
113 /^'HASH\(0x[0-9a-f]+\)'$/i
114 ########
115 stringify(sub{});
116 EXPECT
117 /^'CODE\(0x[0-9a-f]+\)'$/i
118 ########
119 stringify(\*a);
120 EXPECT
121 /^'GLOB\(0x[0-9a-f]+\)'$/i
122 ########
123 stringify($foo);
124 EXPECT
125 /^'Foo=ARRAY\(0x[0-9a-f]+\)'$/i
126 ########
127 stringify($bar);
128 EXPECT
129 /^'Bar=ARRAY\(0x[0-9a-f]+\)'$/i
130 ########
131 dumpValue(undef);
132 EXPECT
133 undef
134 ########
135 dumpValue(1);
136 EXPECT
137 1
138 ########
139 dumpValue("\cA");
140 EXPECT
141 "\cA"
142 ########
143 dumpValue("\x{100}");
144 EXPECT
145 '\x{0100}'
146 ########
147 dumpValue("1\n2\n3");
148 EXPECT
149 '1
150 2
151 3'
152 ########
153 dumpValue([1..3],1);
154 EXPECT
155 0  1
156 1  2
157 2  3
158 ########
159 dumpValue({1..4},1);
160 EXPECT
161 1 => 2
162 3 => 4
163 ########
164 dumpValue($foo,1);
165 EXPECT
166 0  1
167 1  2
168 2  3
169 3  4
170 4  5
171 ########
172 dumpValue($bar,1);
173 EXPECT
174 0  1
175 1  2
176 2  3
177 3  4
178 4  5
179 ########