1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
|
#!./perl -w
# t/quotekeys.t - Test Quotekeys()
BEGIN {
if ($ENV{PERL_CORE}){
require Config; import Config;
no warnings 'once';
if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
print "1..0 # Skip: Data::Dumper was not built\n";
exit 0;
}
}
}
use strict;
use Data::Dumper;
use Test::More tests => 18;
use lib qw( ./t/lib );
use Testing qw( _dumptostr );
my %d = (
delta => 'd',
beta => 'b',
gamma => 'c',
alpha => 'a',
);
run_tests_for_quotekeys();
SKIP: {
skip "XS version was unavailable, so we already ran with pure Perl", 5
if $Data::Dumper::Useperl;
local $Data::Dumper::Useperl = 1;
run_tests_for_quotekeys();
}
sub run_tests_for_quotekeys {
note("\$Data::Dumper::Useperl = $Data::Dumper::Useperl");
my ($obj, %dumps, $quotekeys, $starting);
note("\$Data::Dumper::Quotekeys and Quotekeys() set to true value");
$obj = Data::Dumper->new( [ \%d ] );
$dumps{'ddqkdefault'} = _dumptostr($obj);
$starting = $Data::Dumper::Quotekeys;
$quotekeys = 1;
local $Data::Dumper::Quotekeys = $quotekeys;
$obj = Data::Dumper->new( [ \%d ] );
$dumps{'ddqkone'} = _dumptostr($obj);
local $Data::Dumper::Quotekeys = $starting;
$obj = Data::Dumper->new( [ \%d ] );
$obj->Quotekeys($quotekeys);
$dumps{'objqkone'} = _dumptostr($obj);
is($dumps{'ddqkdefault'}, $dumps{'ddqkone'},
"\$Data::Dumper::Quotekeys = 1 is default");
is($dumps{'ddqkone'}, $dumps{'objqkone'},
"\$Data::Dumper::Quotekeys = 1 and Quotekeys(1) are equivalent");
%dumps = ();
$quotekeys = 0;
local $Data::Dumper::Quotekeys = $quotekeys;
$obj = Data::Dumper->new( [ \%d ] );
$dumps{'ddqkzero'} = _dumptostr($obj);
local $Data::Dumper::Quotekeys = $starting;
$obj = Data::Dumper->new( [ \%d ] );
$obj->Quotekeys($quotekeys);
$dumps{'objqkzero'} = _dumptostr($obj);
is($dumps{'ddqkzero'}, $dumps{'objqkzero'},
"\$Data::Dumper::Quotekeys = 0 and Quotekeys(0) are equivalent");
$quotekeys = undef;
local $Data::Dumper::Quotekeys = $quotekeys;
$obj = Data::Dumper->new( [ \%d ] );
$dumps{'ddqkundef'} = _dumptostr($obj);
local $Data::Dumper::Quotekeys = $starting;
$obj = Data::Dumper->new( [ \%d ] );
$obj->Quotekeys($quotekeys);
$dumps{'objqkundef'} = _dumptostr($obj);
note("Quotekeys(undef) will fall back to the default value\nfor \$Data::Dumper::Quotekeys, which is a true value.");
isnt($dumps{'ddqkundef'}, $dumps{'objqkundef'},
"\$Data::Dumper::Quotekeys = undef and Quotekeys(undef) are equivalent");
isnt($dumps{'ddqkzero'}, $dumps{'objqkundef'},
"\$Data::Dumper::Quotekeys = undef and = 0 are equivalent");
%dumps = ();
local $Data::Dumper::Quotekeys = 1;
local $Data::Dumper::Sortkeys = 1;
local $Data::Dumper::Indent = 0;
local $Data::Dumper::Useqq = 0;
my %qkdata =
(
0 => 1,
'012345' => 1,
12 => 1,
123456789 => 1,
1234567890 => 1,
'::de::fg' => 1,
ab => 1,
'hi::12' => 1,
"1\x{660}" => 1,
);
is(Dumper(\%qkdata),
q($VAR1 = {'0' => 1,'012345' => 1,'12' => 1,'123456789' => 1,'1234567890' => 1,"1\x{660}" => 1,'::de::fg' => 1,'ab' => 1,'hi::12' => 1};),
"always quote when quotekeys true");
{
local $Data::Dumper::Useqq = 1;
is(Dumper(\%qkdata),
q($VAR1 = {"0" => 1,"012345" => 1,"12" => 1,"123456789" => 1,"1234567890" => 1,"1\x{660}" => 1,"::de::fg" => 1,"ab" => 1,"hi::12" => 1};),
"always quote when quotekeys true (useqq)");
}
local $Data::Dumper::Quotekeys = 0;
is(Dumper(\%qkdata),
q($VAR1 = {0 => 1,'012345' => 1,12 => 1,123456789 => 1,'1234567890' => 1,"1\x{660}" => 1,'::de::fg' => 1,ab => 1,'hi::12' => 1};),
"avoid quotes when quotekeys false");
{
local $Data::Dumper::Useqq = 1;
is(Dumper(\%qkdata),
q($VAR1 = {0 => 1,"012345" => 1,12 => 1,123456789 => 1,"1234567890" => 1,"1\x{660}" => 1,"::de::fg" => 1,ab => 1,"hi::12" => 1};),
"avoid quotes when quotekeys false (useqq)");
}
}
|
