15 my %h = map { $_ => uc $_ } 'a'..'z';
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");
21 ok( eq_hash( { %h{'q','w'} }, { q => 'Q', w => 'W' } ), "correct hash" );
23 is( join(':', %h{()}), '', "correct result for empty slice");
26 # not existing elements
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" );
32 ok( !exists $h{e}, "no autovivification" );
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";
45 local $SIG{__WARN__} = sub {push @warn, "@_"};
47 my %h = map { $_ => uc $_ } 'a'..'z';
48 is scalar eval"%h{'c','d','e'}", 'E', 'last element in scalar context';
51 qr/^\%h\{\.\.\.\} in scalar context better written as \$h\{\.\.\.\}/);
53 eval 'is( scalar %h{i}, "I", "correct value");';
57 qr/^\%h\{"i"\} in scalar context better written as \$h\{"i"\}/);
62 my %h = map { $_ => uc $_ } 'a'..'b';
65 is( join(':', map {$_//'undef'} @a), 'c:undef:d:undef', "correct result");
66 ok( eq_hash( \%h, { a => 'A', b => 'B' } ), "correct hash" );
71 my $h = { map { $_ => uc $_ } 'a'..'z' };
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");
79 my %h = map { $_ => uc $_ } 'a'..'b';
80 is( "%h{'a','b'}", q{%h{'a','b'}}, 'no interpolation within strings' );
83 # ref of a slice produces list
85 my %h = map { $_ => uc $_ } 'a'..'z';
86 my @a = \%h{ qw'c d e' };
89 $ok = 0 if grep !ref, @a;
90 ok $ok, "all elements are refs";
92 is join( ':', map{ $$_ } @a ), 'c:C:d:D:e:E'
95 # lvalue usage in foreach
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" );
102 # lvalue subs in foreach
104 my %h = qw(a 1 b 2 c 3);
105 sub foo:lvalue{ %h{qw(a b)} };
107 ok( eq_hash( \%h, { a => 2, b => 3, c => 3 } ), "correct hash" );
112 my %h = map { $_ => uc $_ } 'a'..'b';
116 eval 'local %h{qw(a b)}';
117 like $@, qr{^Can't modify key/value hash slice in local at},
123 eval '%h{qw(a b)} = qw(B A)';
124 like $@, qr{^Can't modify key/value hash slice in list assignment},
127 # lvalue subs in assignment
130 eval 'sub bar:lvalue{ %h{qw(a b)} }; (bar) = "1"';
131 like $@, qr{^Can't modify key/value hash slice in list assignment},
132 'not allowed as result of lvalue sub';
133 eval 'sub bbar:lvalue{ %h{qw(a b)} }; bbar() = "1"';
135 qr{^Can't modify key/value hash slice in scalar assignment},
136 'not allowed as result of lvalue sub';
143 local $SIG{__WARN__} = sub {push @warn, "@_"};
145 my %h = map { $_ => uc $_ } 'a'..'c';
148 my $v = eval '%h{a}';
149 is (scalar @warn, 1, 'warning in scalar context');
151 qr{^%h\{"a"\} in scalar context better written as \$h\{"a"\}},
152 "correct warning text";
156 my ($k,$v) = eval '%h{a}';
159 is (scalar @warn, 0, 'no warning in list context');
165 like($@, qr/Can't use a hash as a reference/, 'hash reference is error' );
167 eval '%$h->{"b","c"}';
168 like($@, qr/Can't use a hash as a reference/, 'hash slice reference is error' );
172 # simple case with tied
175 tie my %h, 'Tie::StdHash';
176 %h = map { $_ => uc $_ } 'a'..'c';
178 ok( eq_array( [%h{'b','a', 'e'}], [qw(b B a A e), undef] ),
181 ok( !exists $h{e}, "no autovivification" );
184 # keys/value/each refuse to compile kvhslice
187 my %i = (foo => \%h);
188 eval '() = keys %i{foo=>}';
189 like($@, qr/Experimental keys on scalar is now forbidden/,
190 'keys %hash{key} forbidden');
191 eval '() = values %i{foo=>}';
192 like($@, qr/Experimental values on scalar is now forbidden/,
193 'values %hash{key} forbidden');
194 eval '() = each %i{foo=>}';
195 like($@, qr/Experimental each on scalar is now forbidden/,
196 'each %hash{key} forbidden');
199 # \% prototype expects hash deref
200 sub nowt_but_hash(\%) {}
201 eval 'nowt_but_hash %INC{bar}';
202 like $@, qr`^Type of arg 1 to main::nowt_but_hash must be hash \(not(?x:
203 ) key/value hash slice\) at `,