1#!./perl 2 3BEGIN { 4 chdir 't' if -d 't'; 5 @INC = '../lib'; 6 require './test.pl'; 7} 8 9@tests = split(/\n/, <<EOF); 100 3, 0 1 2, 3 4 5 6 7 110 0 a b c, , a b c 0 1 2 3 4 5 6 7 128 0 a b c, , 0 1 2 3 4 5 6 7 a b c 137 0 6.5, , 0 1 2 3 4 5 6 6.5 7 141 0 a b c d e f g h i j,, 0 a b c d e f g h i j 1 2 3 4 5 6 7 150 1 a, 0, a 1 2 3 4 5 6 7 161 6 x y z, 1 2 3 4 5 6, 0 x y z 7 170 7 x y z, 0 1 2 3 4 5 6, x y z 7 181 7 x y z, 1 2 3 4 5 6 7, 0 x y z 194, 4 5 6 7, 0 1 2 3 20-4, 4 5 6 7, 0 1 2 3 21EOF 22 23plan tests => 16 + @tests*4; 24die "blech" unless @tests; 25 26@x = (1,2,3); 27push(@x,@x); 28is( join(':',@x), '1:2:3:1:2:3', 'push array onto array'); 29push(@x,4); 30is( join(':',@x), '1:2:3:1:2:3:4', 'push integer onto array'); 31 32# test for push/pop intuiting @ on array 33{ 34 no warnings 'deprecated'; 35 push(x,3); 36} 37is( join(':',@x), '1:2:3:1:2:3:4:3', 'push intuiting @ on array'); 38{ 39 no warnings 'deprecated'; 40 pop(x); 41} 42is( join(':',@x), '1:2:3:1:2:3:4', 'pop intuiting @ on array'); 43 44no warnings 'experimental::autoderef'; 45 46# test for push/pop on arrayref 47push(\@x,5); 48is( join(':',@x), '1:2:3:1:2:3:4:5', 'push arrayref'); 49pop(\@x); 50is( join(':',@x), '1:2:3:1:2:3:4', 'pop arrayref'); 51 52# test autovivification 53push @$undef1, 1, 2, 3; 54is( join(':',@$undef1), '1:2:3', 'autovivify array'); 55 56# test push on undef (error) 57eval { push $undef2, 1, 2, 3 }; 58like( $@, qr/Not an ARRAY/, 'push on undef generates an error'); 59 60# test constant 61use constant CONST_ARRAYREF => [qw/a b c/]; 62push CONST_ARRAYREF(), qw/d e f/; 63is( join(':',@{CONST_ARRAYREF()}), 'a:b:c:d:e:f', 'test constant'); 64 65# test implicit dereference errors 66eval "push 42, 0, 1, 2, 3"; 67like ( $@, qr/must be array/, 'push onto a literal integer'); 68 69$hashref = { }; 70eval { push $hashref, 0, 1, 2, 3 }; 71like( $@, qr/Not an ARRAY reference/, 'push onto a hashref'); 72 73eval { push bless([]), 0, 1, 2, 3 }; 74like( $@, qr/Not an unblessed ARRAY reference/, 'push onto a blessed array ref'); 75 76$test = 13; 77 78# test context 79{ 80 my($first, $second) = ([1], [2]); 81 sub two_things { return +($first, $second) } 82 push two_things(), 3; 83 is( join(':',@$first), '1', "\$first = [ @$first ];"); 84 is( join(':',@$second), '2:3', "\$second = [ @$second ]"); 85 86 push @{ two_things() }, 4; 87 is( join(':',@$first), '1', "\$first = [ @$first ];"); 88 is( join(':',@$second), '2:3:4', "\$second = [ @$second ]"); 89} 90 91foreach $line (@tests) { 92 ($list,$get,$leave) = split(/,\t*/,$line); 93 ($pos, $len, @list) = split(' ',$list); 94 @get = split(' ',$get); 95 @leave = split(' ',$leave); 96 @x = (0,1,2,3,4,5,6,7); 97 $y = [0,1,2,3,4,5,6,7]; 98 if (defined $len) { 99 @got = splice(@x, $pos, $len, @list); 100 @got2 = splice($y, $pos, $len, @list); 101 } 102 else { 103 @got = splice(@x, $pos); 104 @got2 = splice($y, $pos); 105 } 106 is(join(':',@got), join(':',@get), "got: @got == @get"); 107 is(join(':',@x), join(':',@leave), "left: @x == @leave"); 108 is(join(':',@got2), join(':',@get), "ref got: @got2 == @get"); 109 is(join(':',@$y), join(':',@leave), "ref left: @$y == @leave"); 110} 111 1121; # this file is require'd by lib/tie-stdpush.t 113