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 | |
cba5a3b0 DG |
44 | # test for push/pop on arrayref |
45 | push(\@x,5); | |
e589c1fb | 46 | is( join(':',@x), '1:2:3:1:2:3:4:5', 'push arrayref'); |
cba5a3b0 | 47 | pop(\@x); |
e589c1fb | 48 | is( join(':',@x), '1:2:3:1:2:3:4', 'pop arrayref'); |
cba5a3b0 DG |
49 | |
50 | # test autovivification | |
51 | push @$undef1, 1, 2, 3; | |
e589c1fb | 52 | is( join(':',@$undef1), '1:2:3', 'autovivify array'); |
d4fc4415 FC |
53 | |
54 | # test push on undef (error) | |
55 | eval { push $undef2, 1, 2, 3 }; | |
e589c1fb | 56 | like( $@, qr/Not an ARRAY/, 'push on undef generates an error'); |
cba5a3b0 DG |
57 | |
58 | # test constant | |
59 | use constant CONST_ARRAYREF => [qw/a b c/]; | |
60 | push CONST_ARRAYREF(), qw/d e f/; | |
e589c1fb | 61 | is( join(':',@{CONST_ARRAYREF()}), 'a:b:c:d:e:f', 'test constant'); |
cba5a3b0 DG |
62 | |
63 | # test implicit dereference errors | |
64 | eval "push 42, 0, 1, 2, 3"; | |
e589c1fb | 65 | like ( $@, qr/must be array/, 'push onto a literal integer'); |
cba5a3b0 DG |
66 | |
67 | $hashref = { }; | |
68 | eval { push $hashref, 0, 1, 2, 3 }; | |
e589c1fb | 69 | like( $@, qr/Not an ARRAY reference/, 'push onto a hashref'); |
cba5a3b0 | 70 | |
d4fc4415 | 71 | eval { push bless([]), 0, 1, 2, 3 }; |
e589c1fb | 72 | like( $@, qr/Not an unblessed ARRAY reference/, 'push onto a blessed array ref'); |
d4fc4415 FC |
73 | |
74 | $test = 13; | |
cba5a3b0 DG |
75 | |
76 | # test context | |
77 | { | |
78 | my($first, $second) = ([1], [2]); | |
79 | sub two_things { return +($first, $second) } | |
80 | push two_things(), 3; | |
e589c1fb CK |
81 | is( join(':',@$first), '1', "\$first = [ @$first ];"); |
82 | is( join(':',@$second), '2:3', "\$second = [ @$second ]"); | |
cba5a3b0 DG |
83 | |
84 | push @{ two_things() }, 4; | |
e589c1fb CK |
85 | is( join(':',@$first), '1', "\$first = [ @$first ];"); |
86 | is( join(':',@$second), '2:3:4', "\$second = [ @$second ]"); | |
cba5a3b0 DG |
87 | } |
88 | ||
79a0689e LW |
89 | foreach $line (@tests) { |
90 | ($list,$get,$leave) = split(/,\t*/,$line); | |
79072805 | 91 | ($pos, $len, @list) = split(' ',$list); |
79a0689e LW |
92 | @get = split(' ',$get); |
93 | @leave = split(' ',$leave); | |
94 | @x = (0,1,2,3,4,5,6,7); | |
cba5a3b0 | 95 | $y = [0,1,2,3,4,5,6,7]; |
79072805 LW |
96 | if (defined $len) { |
97 | @got = splice(@x, $pos, $len, @list); | |
cba5a3b0 | 98 | @got2 = splice($y, $pos, $len, @list); |
79072805 LW |
99 | } |
100 | else { | |
101 | @got = splice(@x, $pos); | |
cba5a3b0 | 102 | @got2 = splice($y, $pos); |
79072805 | 103 | } |
e589c1fb CK |
104 | is(join(':',@got), join(':',@get), "got: @got == @get"); |
105 | is(join(':',@x), join(':',@leave), "left: @x == @leave"); | |
106 | is(join(':',@got2), join(':',@get), "ref got: @got2 == @get"); | |
107 | is(join(':',@$y), join(':',@leave), "ref left: @$y == @leave"); | |
79a0689e LW |
108 | } |
109 | ||
a60c0954 | 110 | 1; # this file is require'd by lib/tie-stdpush.t |