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