Commit | Line | Data |
---|---|---|
2dc206e5 RZ |
1 | #!./perl -w |
2 | ||
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
5 | @INC = '../lib'; | |
6 | require './test.pl'; | |
7 | } | |
8 | ||
9 | # use strict; | |
10 | ||
1f1ec7b5 | 11 | plan tests => 40; |
2dc206e5 RZ |
12 | |
13 | # simple use cases | |
14 | { | |
15 | my %h = map { $_ => uc $_ } 'a'..'z'; | |
16 | ||
17 | is( join(':', %h{'c','d','e'}), 'c:C:d:D:e:E', "correct result and order"); | |
18 | is( join(':', %h{'e','d','c'}), 'e:E:d:D:c:C', "correct result and order"); | |
19 | is( join(':', %h{'e','c','d'}), 'e:E:c:C:d:D', "correct result and order"); | |
20 | ||
21 | ok( eq_hash( { %h{'q','w'} }, { q => 'Q', w => 'W' } ), "correct hash" ); | |
22 | ||
23 | is( join(':', %h{()}), '', "correct result for empty slice"); | |
24 | } | |
25 | ||
26 | # not existing elements | |
27 | { | |
28 | my %h = map { $_ => uc $_ } 'a'..'d'; | |
29 | ok( eq_hash( { %h{qw(e d)} }, { e => undef, d => 'D' } ), | |
30 | "not existing returned with undef value" ); | |
31 | ||
32 | ok( !exists $h{e}, "no autovivification" ); | |
33 | } | |
34 | ||
35 | # repeated keys | |
36 | { | |
37 | my %h = map { $_ => uc $_ } 'a'..'d'; | |
38 | my @a = %h{ ('c') x 3 }; | |
39 | ok eq_array( \@a, [ ('c', 'C') x 3 ]), "repetead keys end with repeated results"; | |
40 | } | |
41 | ||
42 | # scalar context | |
43 | { | |
2186f873 FC |
44 | my @warn; |
45 | local $SIG{__WARN__} = sub {push @warn, "@_"}; | |
46 | ||
2dc206e5 | 47 | my %h = map { $_ => uc $_ } 'a'..'z'; |
2186f873 | 48 | is scalar eval"%h{'c','d','e'}", 'E', 'last element in scalar context'; |
2dc206e5 | 49 | |
2186f873 FC |
50 | like ($warn[0], |
51 | qr/^\%h\{\.\.\.\} in scalar context better written as \$h\{\.\.\.\}/); | |
2dc206e5 | 52 | |
2186f873 FC |
53 | eval 'is( scalar %h{i}, "I", "correct value");'; |
54 | ||
55 | is (scalar @warn, 2); | |
56 | like ($warn[1], | |
57 | qr/^\%h\{"i"\} in scalar context better written as \$h\{"i"\}/); | |
2dc206e5 RZ |
58 | } |
59 | ||
60 | # autovivification | |
61 | { | |
62 | my %h = map { $_ => uc $_ } 'a'..'b'; | |
63 | ||
64 | my @a = %h{'c','d'}; | |
65 | is( join(':', map {$_//'undef'} @a), 'c:undef:d:undef', "correct result"); | |
66 | ok( eq_hash( \%h, { a => 'A', b => 'B' } ), "correct hash" ); | |
67 | } | |
68 | ||
69 | # hash refs | |
70 | { | |
71 | my $h = { map { $_ => uc $_ } 'a'..'z' }; | |
72 | ||
73 | is( join(':', %$h{'c','d','e'}), 'c:C:d:D:e:E', "correct result and order"); | |
74 | is( join(':', %{$h}{'c','d','e'}), 'c:C:d:D:e:E', "correct result and order"); | |
75 | } | |
76 | ||
77 | # no interpolation | |
78 | { | |
79 | my %h = map { $_ => uc $_ } 'a'..'b'; | |
80 | is( "%h{'a','b'}", q{%h{'a','b'}}, 'no interpolation within strings' ); | |
81 | } | |
82 | ||
83 | # ref of a slice produces list | |
84 | { | |
85 | my %h = map { $_ => uc $_ } 'a'..'z'; | |
86 | my @a = \%h{ qw'c d e' }; | |
87 | ||
88 | my $ok = 1; | |
89 | $ok = 0 if grep !ref, @a; | |
90 | ok $ok, "all elements are refs"; | |
91 | ||
92 | is join( ':', map{ $$_ } @a ), 'c:C:d:D:e:E' | |
93 | } | |
94 | ||
95 | # lvalue usage in foreach | |
96 | { | |
97 | my %h = qw(a 1 b 2 c 3); | |
98 | $_++ foreach %h{'b', 'c'}; | |
99 | ok( eq_hash( \%h, { a => 1, b => 3, c => 4 } ), "correct hash" ); | |
100 | } | |
101 | ||
102 | # lvalue subs in foreach | |
103 | { | |
104 | my %h = qw(a 1 b 2 c 3); | |
105 | sub foo:lvalue{ %h{qw(a b)} }; | |
106 | $_++ foreach foo(); | |
107 | ok( eq_hash( \%h, { a => 2, b => 3, c => 3 } ), "correct hash" ); | |
108 | } | |
109 | ||
110 | # errors | |
111 | { | |
112 | my %h = map { $_ => uc $_ } 'a'..'b'; | |
113 | # no local | |
114 | { | |
115 | local $@; | |
116 | eval 'local %h{qw(a b)}'; | |
117 | like $@, qr{^Can't modify key/value hash slice in local at}, | |
118 | 'local dies'; | |
119 | } | |
120 | # no delete | |
121 | { | |
122 | local $@; | |
123 | eval 'delete %h{qw(a b)}'; | |
124 | like $@, qr{^delete argument is key/value hash slice, use hash slice}, | |
125 | 'delete dies'; | |
126 | } | |
127 | # no assign | |
128 | { | |
129 | local $@; | |
130 | eval '%h{qw(a b)} = qw(B A)'; | |
131 | like $@, qr{^Can't modify key/value hash slice in list assignment}, | |
132 | 'assign dies'; | |
133 | } | |
134 | # lvalue subs in assignment | |
135 | { | |
136 | local $@; | |
137 | eval 'sub bar:lvalue{ %h{qw(a b)} }; bar() = "1"'; | |
138 | like $@, qr{^Can't modify key/value hash slice in list assignment}, | |
139 | 'not allowed as result of lvalue sub'; | |
140 | } | |
141 | } | |
142 | ||
143 | # warnings | |
144 | { | |
145 | my @warn; | |
146 | local $SIG{__WARN__} = sub {push @warn, "@_"}; | |
147 | ||
148 | my %h = map { $_ => uc $_ } 'a'..'c'; | |
149 | { | |
150 | @warn = (); | |
95a31aad | 151 | my $v = eval '%h{a}'; |
2dc206e5 | 152 | is (scalar @warn, 1, 'warning in scalar context'); |
95a31aad | 153 | like $warn[0], |
412f55bb | 154 | qr{^%h\{"a"\} in scalar context better written as \$h\{"a"\}}, |
2dc206e5 RZ |
155 | "correct warning text"; |
156 | } | |
157 | { | |
158 | @warn = (); | |
159 | my ($k,$v) = eval '%h{a}'; | |
160 | is ($k, 'a'); | |
161 | is ($v, 'A'); | |
95a31aad | 162 | is (scalar @warn, 0, 'no warning in list context'); |
2dc206e5 RZ |
163 | } |
164 | ||
2dc206e5 RZ |
165 | { |
166 | my $h = \%h; | |
1f1ec7b5 KW |
167 | eval '%$h->{a}'; |
168 | like($@, qr/Can't use a hash as a reference/, 'hash reference is error' ); | |
2dc206e5 | 169 | |
1f1ec7b5 KW |
170 | eval '%$h->{"b","c"}'; |
171 | like($@, qr/Can't use a hash as a reference/, 'hash slice reference is error' ); | |
2dc206e5 RZ |
172 | } |
173 | } | |
174 | ||
175 | # simple case with tied | |
176 | { | |
177 | require Tie::Hash; | |
178 | tie my %h, 'Tie::StdHash'; | |
179 | %h = map { $_ => uc $_ } 'a'..'c'; | |
180 | ||
181 | ok( eq_array( [%h{'b','a', 'e'}], [qw(b B a A e), undef] ), | |
182 | "works on tied" ); | |
183 | ||
184 | ok( !exists $h{e}, "no autovivification" ); | |
185 | } | |
186 | ||
f263a88e FC |
187 | # keys/value/each treat argument as scalar |
188 | { | |
189 | my %h = 'a'..'b'; | |
190 | my %i = (foo => \%h); | |
d401967c | 191 | no warnings 'syntax', 'experimental::autoderef'; |
2186f873 | 192 | my ($k,$v) = each %i{foo=>}; |
f263a88e FC |
193 | is $k, 'a', 'key returned by each %hash{key}'; |
194 | is $v, 'b', 'val returned by each %hash{key}'; | |
195 | %h = 1..10; | |
196 | is join('-', sort keys %i{foo=>}), '1-3-5-7-9', 'keys %hash{key}'; | |
197 | is join('-', sort values %i{foo=>}), '10-2-4-6-8', 'values %hash{key}'; | |
198 | } | |
199 | ||
200 | # \% prototype expects hash deref | |
201 | sub nowt_but_hash(\%) {} | |
202 | eval 'nowt_but_hash %INC{bar}'; | |
203 | like $@, qr`^Type of arg 1 to main::nowt_but_hash must be hash \(not(?x: | |
204 | ) key/value hash slice\) at `, | |
205 | '\% prototype'; |