This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
dist/Data-Dumper/t/quotekeys.t: Generalize for EBCDIC
[perl5.git] / dist / Data-Dumper / t / quotekeys.t
1 #!./perl -w
2 # t/quotekeys.t - Test Quotekeys()
3
4 BEGIN {
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
15 use strict;
16
17 use Data::Dumper;
18 use Test::More tests => 18;
19 use lib qw( ./t/lib );
20 use Testing qw( _dumptostr );
21
22 my %d = (
23     delta   => 'd',
24     beta    => 'b',
25     gamma   => 'c',
26     alpha   => 'a',
27 );
28
29 my $is_ascii = ord("A") == 65;
30
31 run_tests_for_quotekeys();
32 SKIP: {
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
39 sub 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     note("Quotekeys(undef) will fall back to the default value\nfor \$Data::Dumper::Quotekeys, which is a true value.");
90     isnt($dumps{'ddqkundef'}, $dumps{'objqkundef'},
91         "\$Data::Dumper::Quotekeys = undef and Quotekeys(undef) are equivalent");
92     isnt($dumps{'ddqkzero'}, $dumps{'objqkundef'},
93         "\$Data::Dumper::Quotekeys = undef and = 0 are equivalent");
94     %dumps = ();
95
96     local $Data::Dumper::Quotekeys = 1;
97     local $Data::Dumper::Sortkeys = 1;
98     local $Data::Dumper::Indent = 0;
99     local $Data::Dumper::Useqq = 0;
100
101     my %qkdata =
102       (
103        0 => 1,
104        '012345' => 1,
105        12 => 1,
106        123456789 => 1,
107        1234567890 => 1,
108        '::de::fg' => 1,
109        ab => 1,
110        'hi::12' => 1,
111        "1\x{660}" => 1,
112       );
113
114     is(Dumper(\%qkdata),
115        (($is_ascii) # Sort order is different on EBCDIC platforms
116         ? q($VAR1 = {'0' => 1,'012345' => 1,'12' => 1,'123456789' => 1,'1234567890' => 1,"1\x{660}" => 1,'::de::fg' => 1,'ab' => 1,'hi::12' => 1};)
117         : q($VAR1 = {'::de::fg' => 1,'ab' => 1,'hi::12' => 1,'0' => 1,'012345' => 1,'12' => 1,'123456789' => 1,'1234567890' => 1,"1\x{660}" => 1};)),
118        "always quote when quotekeys true");
119
120     {
121         local $Data::Dumper::Useqq = 1;
122         is(Dumper(\%qkdata),
123            (($is_ascii)
124             ? q($VAR1 = {"0" => 1,"012345" => 1,"12" => 1,"123456789" => 1,"1234567890" => 1,"1\x{660}" => 1,"::de::fg" => 1,"ab" => 1,"hi::12" => 1};)
125             : q($VAR1 = {"::de::fg" => 1,"ab" => 1,"hi::12" => 1,"0" => 1,"012345" => 1,"12" => 1,"123456789" => 1,"1234567890" => 1,"1\x{660}" => 1};)),
126            "always quote when quotekeys true (useqq)");
127     }
128
129     local $Data::Dumper::Quotekeys = 0;
130
131     is(Dumper(\%qkdata),
132         (($is_ascii)
133          ? q($VAR1 = {0 => 1,'012345' => 1,12 => 1,123456789 => 1,'1234567890' => 1,"1\x{660}" => 1,'::de::fg' => 1,ab => 1,'hi::12' => 1};)
134          : q($VAR1 = {'::de::fg' => 1,ab => 1,'hi::12' => 1,0 => 1,'012345' => 1,12 => 1,123456789 => 1,'1234567890' => 1,"1\x{660}" => 1};)),
135               "avoid quotes when quotekeys false");
136     {
137         local $Data::Dumper::Useqq = 1;
138         is(Dumper(\%qkdata),
139             (($is_ascii)
140              ? q($VAR1 = {0 => 1,"012345" => 1,12 => 1,123456789 => 1,"1234567890" => 1,"1\x{660}" => 1,"::de::fg" => 1,ab => 1,"hi::12" => 1};)
141              : q($VAR1 = {"::de::fg" => 1,ab => 1,"hi::12" => 1,0 => 1,"012345" => 1,12 => 1,123456789 => 1,"1234567890" => 1,"1\x{660}" => 1};)),
142               "avoid quotes when quotekeys false (useqq)");
143     }
144 }
145