Commit | Line | Data |
---|---|---|
8d063cd8 LW |
1 | #!./perl |
2 | ||
e589c1fb CK |
3 | BEGIN { |
4 | chdir 't' if -d 't'; | |
e589c1fb | 5 | require './test.pl'; |
43ece5b1 | 6 | set_up_inc('../lib'); |
e589c1fb CK |
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 | ||
26230909 | 23 | plan tests => 8 + @tests*2; |
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 | |
cba5a3b0 DG |
32 | # test autovivification |
33 | push @$undef1, 1, 2, 3; | |
e589c1fb | 34 | is( join(':',@$undef1), '1:2:3', 'autovivify array'); |
d4fc4415 | 35 | |
cba5a3b0 DG |
36 | # test implicit dereference errors |
37 | eval "push 42, 0, 1, 2, 3"; | |
e589c1fb | 38 | like ( $@, qr/must be array/, 'push onto a literal integer'); |
cba5a3b0 DG |
39 | |
40 | $hashref = { }; | |
26230909 AC |
41 | eval q{ push $hashref, 0, 1, 2, 3 }; |
42 | like( $@, qr/Experimental push on scalar is now forbidden/, 'push onto a hashref'); | |
cba5a3b0 | 43 | |
26230909 AC |
44 | eval q{ push bless([]), 0, 1, 2, 3 }; |
45 | like( $@, qr/Experimental push on scalar is now forbidden/, 'push onto a blessed array ref'); | |
d4fc4415 FC |
46 | |
47 | $test = 13; | |
cba5a3b0 DG |
48 | |
49 | # test context | |
50 | { | |
51 | my($first, $second) = ([1], [2]); | |
52 | sub two_things { return +($first, $second) } | |
26230909 | 53 | push @{ two_things() }, 3; |
e589c1fb CK |
54 | is( join(':',@$first), '1', "\$first = [ @$first ];"); |
55 | is( join(':',@$second), '2:3', "\$second = [ @$second ]"); | |
cba5a3b0 DG |
56 | } |
57 | ||
79a0689e LW |
58 | foreach $line (@tests) { |
59 | ($list,$get,$leave) = split(/,\t*/,$line); | |
79072805 | 60 | ($pos, $len, @list) = split(' ',$list); |
79a0689e LW |
61 | @get = split(' ',$get); |
62 | @leave = split(' ',$leave); | |
63 | @x = (0,1,2,3,4,5,6,7); | |
79072805 LW |
64 | if (defined $len) { |
65 | @got = splice(@x, $pos, $len, @list); | |
66 | } | |
67 | else { | |
68 | @got = splice(@x, $pos); | |
69 | } | |
e589c1fb CK |
70 | is(join(':',@got), join(':',@get), "got: @got == @get"); |
71 | is(join(':',@x), join(':',@leave), "left: @x == @leave"); | |
79a0689e LW |
72 | } |
73 | ||
a60c0954 | 74 | 1; # this file is require'd by lib/tie-stdpush.t |