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