This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fatalize using hash|array as reference
[perl5.git] / t / op / kvhslice.t
CommitLineData
2dc206e5
RZ
1#!./perl -w
2
3BEGIN {
4 chdir 't' if -d 't';
5 @INC = '../lib';
6 require './test.pl';
7}
8
9# use strict;
10
1f1ec7b5 11plan 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
201sub nowt_but_hash(\%) {}
202eval 'nowt_but_hash %INC{bar}';
203like $@, qr`^Type of arg 1 to main::nowt_but_hash must be hash \(not(?x:
204 ) key/value hash slice\) at `,
205 '\% prototype';