1#!./perl -w
2# t/quotekeys.t - Test Quotekeys()
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 %d = (
23    delta   => 'd',
24    beta    => 'b',
25    gamma   => 'c',
26    alpha   => 'a',
27);
28
29my $is_ascii = ord("A") == 65;
30
31run_tests_for_quotekeys();
32SKIP: {
33    skip "XS version was unavailable, so we already ran with pure Perl", 5
34        if $Data::Dumper::Useperl;
35    local $Data::Dumper::Useperl = 1;
36    run_tests_for_quotekeys();
37}
38
39sub run_tests_for_quotekeys {
40    note("\$Data::Dumper::Useperl = $Data::Dumper::Useperl");
41
42    my ($obj, %dumps, $quotekeys, $starting);
43
44    note("\$Data::Dumper::Quotekeys and Quotekeys() set to true value");
45
46    $obj = Data::Dumper->new( [ \%d ] );
47    $dumps{'ddqkdefault'} = _dumptostr($obj);
48
49    $starting = $Data::Dumper::Quotekeys;
50    $quotekeys = 1;
51    local $Data::Dumper::Quotekeys = $quotekeys;
52    $obj = Data::Dumper->new( [ \%d ] );
53    $dumps{'ddqkone'} = _dumptostr($obj);
54    local $Data::Dumper::Quotekeys = $starting;
55
56    $obj = Data::Dumper->new( [ \%d ] );
57    $obj->Quotekeys($quotekeys);
58    $dumps{'objqkone'} = _dumptostr($obj);
59
60    is($dumps{'ddqkdefault'}, $dumps{'ddqkone'},
61        "\$Data::Dumper::Quotekeys = 1 is default");
62    is($dumps{'ddqkone'}, $dumps{'objqkone'},
63        "\$Data::Dumper::Quotekeys = 1 and Quotekeys(1) are equivalent");
64    %dumps = ();
65
66    $quotekeys = 0;
67    local $Data::Dumper::Quotekeys = $quotekeys;
68    $obj = Data::Dumper->new( [ \%d ] );
69    $dumps{'ddqkzero'} = _dumptostr($obj);
70    local $Data::Dumper::Quotekeys = $starting;
71
72    $obj = Data::Dumper->new( [ \%d ] );
73    $obj->Quotekeys($quotekeys);
74    $dumps{'objqkzero'} = _dumptostr($obj);
75
76    is($dumps{'ddqkzero'}, $dumps{'objqkzero'},
77        "\$Data::Dumper::Quotekeys = 0 and Quotekeys(0) are equivalent");
78
79    $quotekeys = undef;
80    local $Data::Dumper::Quotekeys = $quotekeys;
81    $obj = Data::Dumper->new( [ \%d ] );
82    $dumps{'ddqkundef'} = _dumptostr($obj);
83    local $Data::Dumper::Quotekeys = $starting;
84
85    $obj = Data::Dumper->new( [ \%d ] );
86    $obj->Quotekeys($quotekeys);
87    $dumps{'objqkundef'} = _dumptostr($obj);
88
89    is($dumps{'ddqkundef'}, $dumps{'objqkundef'},
90        "\$Data::Dumper::Quotekeys = undef and Quotekeys(undef) are equivalent");
91    is($dumps{'ddqkzero'}, $dumps{'objqkundef'},
92        "\$Data::Dumper::Quotekeys = undef and = 0 are equivalent");
93    %dumps = ();
94
95    local $Data::Dumper::Quotekeys = 1;
96    local $Data::Dumper::Sortkeys = 1;
97    local $Data::Dumper::Indent = 0;
98    local $Data::Dumper::Useqq = 0;
99
100    my %qkdata =
101      (
102       0 => 1,
103       '012345' => 1,
104       12 => 1,
105       123456789 => 1,
106       1234567890 => 1,
107       '::de::fg' => 1,
108       ab => 1,
109       'hi::12' => 1,
110       "1\x{660}" => 1,
111      );
112
113    is(Dumper(\%qkdata),
114       (($is_ascii) # Sort order is different on EBCDIC platforms
115        ? q($VAR1 = {'0' => 1,'012345' => 1,'12' => 1,'123456789' => 1,'1234567890' => 1,"1\x{660}" => 1,'::de::fg' => 1,'ab' => 1,'hi::12' => 1};)
116        : q($VAR1 = {'::de::fg' => 1,'ab' => 1,'hi::12' => 1,'0' => 1,'012345' => 1,'12' => 1,'123456789' => 1,'1234567890' => 1,"1\x{660}" => 1};)),
117       "always quote when quotekeys true");
118
119    {
120        local $Data::Dumper::Useqq = 1;
121        is(Dumper(\%qkdata),
122           (($is_ascii)
123	    ? q($VAR1 = {"0" => 1,"012345" => 1,"12" => 1,"123456789" => 1,"1234567890" => 1,"1\x{660}" => 1,"::de::fg" => 1,"ab" => 1,"hi::12" => 1};)
124            : q($VAR1 = {"::de::fg" => 1,"ab" => 1,"hi::12" => 1,"0" => 1,"012345" => 1,"12" => 1,"123456789" => 1,"1234567890" => 1,"1\x{660}" => 1};)),
125	   "always quote when quotekeys true (useqq)");
126    }
127
128    local $Data::Dumper::Quotekeys = 0;
129
130    is(Dumper(\%qkdata),
131        (($is_ascii)
132         ? q($VAR1 = {0 => 1,'012345' => 1,12 => 1,123456789 => 1,'1234567890' => 1,"1\x{660}" => 1,'::de::fg' => 1,ab => 1,'hi::12' => 1};)
133         : q($VAR1 = {'::de::fg' => 1,ab => 1,'hi::12' => 1,0 => 1,'012345' => 1,12 => 1,123456789 => 1,'1234567890' => 1,"1\x{660}" => 1};)),
134	      "avoid quotes when quotekeys false");
135    {
136        local $Data::Dumper::Useqq = 1;
137	is(Dumper(\%qkdata),
138            (($is_ascii)
139	     ? q($VAR1 = {0 => 1,"012345" => 1,12 => 1,123456789 => 1,"1234567890" => 1,"1\x{660}" => 1,"::de::fg" => 1,ab => 1,"hi::12" => 1};)
140             : q($VAR1 = {"::de::fg" => 1,ab => 1,"hi::12" => 1,0 => 1,"012345" => 1,12 => 1,123456789 => 1,"1234567890" => 1,"1\x{660}" => 1};)),
141	      "avoid quotes when quotekeys false (useqq)");
142    }
143}
144
145