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