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