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