1#!./perl -w
2# t/misc.t - Test various functionality
3
4BEGIN {
5    if ($ENV{PERL_CORE}){
6        require Config; import Config;
7        no warnings 'once';
8        if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
9            print "1..0 # Skip: Data::Dumper was not built\n";
10            exit 0;
11        }
12    }
13}
14
15use strict;
16
17use Data::Dumper;
18use Test::More tests => 18;
19use lib qw( ./t/lib );
20use Testing qw( _dumptostr );
21
22my ($a, $b, @c, %d);
23$a = 'alpha';
24$b = 'beta';
25@c = ( qw| gamma delta epsilon | );
26%d = ( zeta => 'eta', theta => 'iota' );
27
28note("Argument validation for new()");
29{
30    local $@ = '';
31    eval { my $obj = Data::Dumper->new(undef); };
32    like($@,
33        qr/^Usage:\s+PACKAGE->new\(ARRAYREF,\s*\[ARRAYREF\]\)/,
34        "Got error message: new() needs defined argument"
35    );
36}
37
38{
39    local $@ = '';
40    eval { my $obj = Data::Dumper->new( { $a => $b } ); };
41    like($@,
42        qr/^Usage:\s+PACKAGE->new\(ARRAYREF,\s*\[ARRAYREF\]\)/,
43        "Got error message: new() needs array reference"
44    );
45}
46
47{
48    note("\$Data::Dumper::Useperl, Useqq, Deparse");
49    my ($obj, %dumpstr);
50
51    local $Data::Dumper::Useperl = 1;
52    $obj = Data::Dumper->new( [ \@c, \%d ] );
53    $dumpstr{useperl} = [ $obj->Values ];
54    local $Data::Dumper::Useperl = 0;
55
56    local $Data::Dumper::Useqq = 1;
57    $obj = Data::Dumper->new( [ \@c, \%d ] );
58    $dumpstr{useqq} = [ $obj->Values ];
59    local $Data::Dumper::Useqq = 0;
60
61    is_deeply($dumpstr{useperl}, $dumpstr{useqq},
62        "Useperl and Useqq return same");
63
64    local $Data::Dumper::Deparse = 1;
65    $obj = Data::Dumper->new( [ \@c, \%d ] );
66    $dumpstr{deparse} = [ $obj->Values ];
67    local $Data::Dumper::Deparse = 0;
68
69    is_deeply($dumpstr{useperl}, $dumpstr{deparse},
70        "Useperl and Deparse return same");
71}
72
73{
74    note("\$Data::Dumper::Pad and \$obj->Pad");
75    my ($obj, %dumps, $pad);
76    $obj = Data::Dumper->new([$a,$b]);
77    $dumps{'noprev'} = _dumptostr($obj);
78
79    $obj = Data::Dumper->new([$a,$b]);
80    $obj->Pad('');
81    $dumps{'emptystring'} = _dumptostr($obj);
82
83    is($dumps{'noprev'}, $dumps{'emptystring'},
84        "No setting for \$Data::Dumper::Pad and Pad('') give same result");
85
86    $pad = 'XXX: ';
87    local $Data::Dumper::Pad = $pad;
88    $obj = Data::Dumper->new([$a,$b]);
89    $dumps{'ddp'} = _dumptostr($obj);
90    local $Data::Dumper::Pad = '';
91
92    $obj = Data::Dumper->new([$a,$b]);
93    $obj->Pad($pad);
94    $dumps{'obj'} = _dumptostr($obj);
95
96    is($dumps{'ddp'}, $dumps{'obj'},
97        "\$Data::Dumper::Pad and \$obj->Pad() give same result");
98
99    is( (grep {! /^$pad/} (split(/\n/, $dumps{'ddp'}))), 0,
100        "Each line of dumped output padded as expected");
101}
102
103{
104    note("\$Data::Dumper::Varname and \$obj->Varname");
105    my ($obj, %dumps, $varname);
106    $obj = Data::Dumper->new([$a,$b]);
107    $dumps{'noprev'} = _dumptostr($obj);
108
109    $obj = Data::Dumper->new([$a,$b]);
110    $obj->Varname('');
111    $dumps{'emptystring'} = _dumptostr($obj);
112
113    # Because Varname defaults to '$VAR', providing an empty argument to
114    # Varname produces a non-default result.
115    isnt($dumps{'noprev'}, $dumps{'emptystring'},
116        "No setting for \$Data::Dumper::Varname and Varname('') give different results");
117
118    $varname = 'MIMI';
119    local $Data::Dumper::Varname = $varname;
120    $obj = Data::Dumper->new([$a,$b]);
121    $dumps{'ddv'} = _dumptostr($obj);
122    local $Data::Dumper::Varname = undef;
123
124    $obj = Data::Dumper->new([$a,$b]);
125    $obj->Varname($varname);
126    $dumps{'varname'} = _dumptostr($obj);
127
128    is($dumps{'ddv'}, $dumps{'varname'},
129        "Setting for \$Data::Dumper::Varname and Varname() give same result");
130
131    is( (grep { /^\$$varname/ } (split(/\n/, $dumps{'ddv'}))), 2,
132        "All lines of dumped output use provided varname");
133
134    is( (grep { /^\$VAR/ } (split(/\n/, $dumps{'ddv'}))), 0,
135        "No lines of dumped output use default \$VAR");
136}
137
138{
139    note("\$Data::Dumper::Useqq and \$obj->Useqq");
140    my ($obj, %dumps, $useqq);
141    $obj = Data::Dumper->new([$a,$b]);
142    $dumps{'noprev'} = _dumptostr($obj);
143
144    $obj = Data::Dumper->new([$a,$b]);
145    $obj->Useqq(undef);
146    $dumps{'undef'} = _dumptostr($obj);
147
148    $obj = Data::Dumper->new([$a,$b]);
149    $obj->Useqq('');
150    $dumps{'emptystring'} = _dumptostr($obj);
151
152    $obj = Data::Dumper->new([$a,$b]);
153    $obj->Useqq(0);
154    $dumps{'zero'} = _dumptostr($obj);
155
156    my $current = $Data::Dumper::Useqq;
157    local $Data::Dumper::Useqq = 0;
158    $obj = Data::Dumper->new([$a,$b]);
159    $dumps{'dduzero'} = _dumptostr($obj);
160    local $Data::Dumper::Useqq = $current;
161
162    is($dumps{'noprev'}, $dumps{'undef'},
163        "No setting for \$Data::Dumper::Useqq and Useqq(undef) give same result");
164
165    is($dumps{'noprev'}, $dumps{'zero'},
166        "No setting for \$Data::Dumper::Useqq and Useqq(0) give same result");
167
168    is($dumps{'noprev'}, $dumps{'emptystring'},
169        "No setting for \$Data::Dumper::Useqq and Useqq('') give same result");
170
171    is($dumps{'noprev'}, $dumps{'dduzero'},
172        "No setting for \$Data::Dumper::Useqq and Useqq(undef) give same result");
173
174    local $Data::Dumper::Useqq = 1;
175    $obj = Data::Dumper->new([$a,$b]);
176    $dumps{'ddu'} = _dumptostr($obj);
177    local $Data::Dumper::Useqq = $current;
178
179    $obj = Data::Dumper->new([$a,$b]);
180    $obj->Useqq(1);
181    $dumps{'obj'} = _dumptostr($obj);
182
183    is($dumps{'ddu'}, $dumps{'obj'},
184        "\$Data::Dumper::Useqq=1 and Useqq(1) give same result");
185
186    like($dumps{'ddu'},
187        qr/"$a".+?"$b"/s,
188        "Double-quotes used around values"
189    );
190
191    unlike($dumps{'ddu'},
192        qr/'$a'.+?'$b'/s,
193        "Single-quotes not used around values"
194    );
195}
196