--- /dev/null
+#!./perl -w
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ require './test.pl';
+}
+
+# use strict;
+
+plan tests => 35;
+
+# simple use cases
+{
+ my @a = 'a'..'z';
+
+ is( join(':', %a[0,1,2]), '0:a:1:b:2:c', "correct result and order");
+ is( join(':', %a[2,1,0]), '2:c:1:b:0:a', "correct result and order");
+ is( join(':', %a[1,0,2]), '1:b:0:a:2:c', "correct result and order");
+
+ ok( eq_hash( { %a[5,6] }, { 5 => 'f', 6 => 'g' } ), "correct hash" );
+
+ is( join(':', %a[()]), '', "correct result for empty slice");
+}
+
+# not existing elements
+{
+ my @a = 'a'..'d';
+ ok( eq_hash( { %a[3..4] }, { 3 => 'd', 4 => undef } ),
+ "not existing returned with undef value" );
+
+ ok( !exists $a[5], "no autovivification" );
+}
+
+# repeated keys
+{
+ my @a = 'a'..'d';
+ @a = %a[ (1) x 3 ];
+ ok eq_array( \@a, [ (1 => 'b') x 3 ]), "repetead keys end with repeated results";
+}
+
+# scalar context
+{
+ my @a = 'a'..'z';
+ is scalar %a[4,5,6], 'g', 'last element in scalar context';
+
+ {
+ my @warn;
+ local $SIG{__WARN__} = sub {push @warn, "@_"};
+ eval 'is( scalar %a[5], "f", "correct value");';
+
+ is (scalar @warn, 1);
+ like ($warn[0], qr/^Scalar value \%a\[5\] better written as \$a\[5\]/);
+ }
+}
+
+# autovivification
+{
+ my @a = 'a'..'b';
+
+ my @t = %a[1,2];
+ is( join(':', map {$_//'undef'} @t), '1:b:2:undef', "correct result");
+ ok( eq_array( \@a, ['a', 'b'] ), "correct array" );
+}
+
+# refs
+{
+ my $a = [ 'a'..'z' ];
+
+ is( join(':', %$a[2,3,4]), '2:c:3:d:4:e', "correct result and order");
+ is( join(':', %{$a}[2,3,4]), '2:c:3:d:4:e', "correct result and order");
+}
+
+# no interpolation
+{
+ my @a = 'a'..'b';
+ is( "%a[1,2]", q{%a[1,2]}, 'no interpolation within strings' );
+}
+
+# ref of a slice produces list
+{
+ my @a = 'a'..'z';
+ my @tmp = \%a[2,3,4];
+
+ my $ok = 1;
+ $ok = 0 if grep !ref, @tmp;
+ ok $ok, "all elements are refs";
+
+ is join( ':', map{ $$_ } @tmp ), '2:c:3:d:4:e';
+}
+
+# lvalue usage in foreach
+{
+ my @a = qw(0 1 2 3);
+ my @i = (1,3);
+ $_++ foreach %a[@i];
+ ok( eq_array( \@a, [0,2,2,4] ), "correct array" );
+ ok( eq_array( \@i, [1,3] ), "indexes not touched" );
+}
+
+# lvalue subs in foreach
+{
+ my @a = qw(0 1 2 3);
+ my @i = (1,3);
+ sub foo:lvalue{ %a[@i] };
+ $_++ foreach foo();
+ ok( eq_array( \@a, [0,2,2,4] ), "correct array" );
+ ok( eq_array( \@i, [1,3] ), "indexes not touched" );
+}
+
+# errors
+{
+ my @a = 'a'..'b';
+ # no local
+ {
+ local $@;
+ eval 'local %a[1,2]';
+ like $@, qr{^Can't modify index/value array slice in local at},
+ 'local dies';
+ }
+ # no delete
+ {
+ local $@;
+ eval 'delete %a[1,2]';
+ like $@, qr{^delete argument is index/value array slice, use array slice},
+ 'delete dies';
+ }
+ # no assign
+ {
+ local $@;
+ eval '%a[1,2] = qw(B A)';
+ like $@, qr{^Can't modify index/value array slice in list assignment},
+ 'assign dies';
+ }
+ # lvalue subs in assignment
+ {
+ local $@;
+ eval 'sub bar:lvalue{ %a[1,2] }; bar() = "1"';
+ like $@, qr{^Can't modify index/value array slice in list assignment},
+ 'not allowed as result of lvalue sub';
+ }
+}
+
+# warnings
+{
+ my @warn;
+ local $SIG{__WARN__} = sub {push @warn, "@_"};
+
+ my @a = 'a'..'c';
+ {
+ @warn = ();
+ my ($v) = eval '%a[0]';
+ is (scalar @warn, 1, 'warning in scalar context');
+ like $warn[0], qr{^Scalar value %a\[0\] better written as \$a\[0\]},
+ "correct warning text";
+ }
+ {
+ @warn = ();
+ my ($k,$v) = eval '%a[0]';
+ is ($k, 0);
+ is ($v, 'a');
+ is (scalar @warn, 1, 'warning, even in list context');
+ like $warn[0], qr{^Scalar value %a\[0\] better written as \$a\[0\]},
+ "correct warning text";
+ }
+}
+
+# simple case with tied
+{
+ require Tie::Array;
+ tie my @a, 'Tie::StdArray';
+ @a = 'a'..'c';
+
+ ok( eq_array( [%a[1,2, 3]], [qw(1 b 2 c 3), undef] ),
+ "works on tied" );
+
+ ok( !exists $a[3], "no autovivification" );
+}
+