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
CommitLineData
fafebdf5
A
1#!./perl -- -*- mode: cperl; cperl-indent-level: 4 -*-
2
3BEGIN {
4 chdir 't' if -d 't';
5 @INC = '../lib';
6}
7
8use strict;
9
10$|=1;
96b31d9e
JH
11
12my @prgs;
13{
14 local $/;
15 @prgs = split "########\n", <DATA>;
16 close DATA;
17}
18
19use Test::More;
20
21plan tests => scalar @prgs;
22
fafebdf5
A
23require "dumpvar.pl";
24
f97a9a4b
JH
25sub unctrl { print dumpvar::unctrl($_[0]), "\n" }
26sub uniescape { print dumpvar::uniescape($_[0]), "\n" }
27sub stringify { print dumpvar::stringify($_[0]), "\n" }
28
29package Foo;
30
31sub new { my $class = shift; bless [ @_ ], $class }
32
33package Bar;
34
35sub new { my $class = shift; bless [ @_ ], $class }
36
37use overload '""' => sub { "Bar<@{$_[0]}>" };
38
39package main;
40
41my $foo = Foo->new(1..5);
42my $bar = Bar->new(1..5);
43
96b31d9e
JH
44for (@prgs) {
45 my($prog, $expected) = split(/\nEXPECT\n?/, $_);
f97a9a4b
JH
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
JH
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
A
62}
63
1d8663a3
JH
64package TieOut;
65
66sub TIEHANDLE {
67 bless( \(my $self), $_[0] );
68}
69
70sub PRINT {
71 my $self = shift;
72 $$self .= join('', @_);
73}
74
75sub read {
76 my $self = shift;
77 substr( $$self, 0, length($$self), '' );
78}
79
fafebdf5 80__END__
f97a9a4b
JH
81unctrl("A");
82EXPECT
83A
84########
85unctrl("\cA");
86EXPECT
87^A
88########
89uniescape("A");
90EXPECT
91A
92########
93uniescape("\x{100}");
94EXPECT
95\x{0100}
96########
97stringify(undef);
98EXPECT
99undef
100########
101stringify("foo");
102EXPECT
103'foo'
104########
105stringify("\cA");
106EXPECT
107"\cA"
108########
109stringify(*a);
110EXPECT
111*main::a
112########
113stringify(\undef);
114EXPECT
115/^'SCALAR\(0x[0-9a-f]+\)'$/i
116########
117stringify([]);
118EXPECT
119/^'ARRAY\(0x[0-9a-f]+\)'$/i
120########
121stringify({});
122EXPECT
123/^'HASH\(0x[0-9a-f]+\)'$/i
124########
125stringify(sub{});
126EXPECT
127/^'CODE\(0x[0-9a-f]+\)'$/i
128########
129stringify(\*a);
130EXPECT
131/^'GLOB\(0x[0-9a-f]+\)'$/i
132########
133stringify($foo);
134EXPECT
135/^'Foo=ARRAY\(0x[0-9a-f]+\)'$/i
136########
137stringify($bar);
138EXPECT
139/^'Bar=ARRAY\(0x[0-9a-f]+\)'$/i
140########
141dumpValue(undef);
142EXPECT
143undef
144########
fafebdf5
A
145dumpValue(1);
146EXPECT
1471
148########
f97a9a4b
JH
149dumpValue("\cA");
150EXPECT
151"\cA"
152########
153dumpValue("\x{100}");
154EXPECT
155'\x{0100}'
156########
fafebdf5
A
157dumpValue("1\n2\n3");
158EXPECT
159'1
1602
1613'
162########
163dumpValue([1..3],1);
164EXPECT
1650 1
1661 2
1672 3
168########
169dumpValue({1..4},1);
170EXPECT
1711 => 2
1723 => 4
173########
f97a9a4b
JH
174dumpValue($foo,1);
175EXPECT
1760 1
1771 2
1782 3
1793 4
1804 5
181########
182dumpValue($bar,1);
183EXPECT
1840 1
1851 2
1862 3
1873 4
1884 5
189########