1#!./perl 2 3@tests = split(/\n/, <<EOF); 40 3, 0 1 2, 3 4 5 6 7 50 0 a b c, , a b c 0 1 2 3 4 5 6 7 68 0 a b c, , 0 1 2 3 4 5 6 7 a b c 77 0 6.5, , 0 1 2 3 4 5 6 6.5 7 81 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 90 1 a, 0, a 1 2 3 4 5 6 7 101 6 x y z, 1 2 3 4 5 6, 0 x y z 7 110 7 x y z, 0 1 2 3 4 5 6, x y z 7 121 7 x y z, 1 2 3 4 5 6 7, 0 x y z 134, 4 5 6 7, 0 1 2 3 14-4, 4 5 6 7, 0 1 2 3 15EOF 16 17print "1..", 4 + @tests, "\n"; 18die "blech" unless @tests; 19 20@x = (1,2,3); 21push(@x,@x); 22if (join(':',@x) eq '1:2:3:1:2:3') {print "ok 1\n";} else {print "not ok 1\n";} 23push(@x,4); 24if (join(':',@x) eq '1:2:3:1:2:3:4') {print "ok 2\n";} else {print "not ok 2\n";} 25 26# test for push/pop intuiting @ on array 27{ 28 no warnings 'deprecated'; 29 push(x,3); 30} 31if (join(':',@x) eq '1:2:3:1:2:3:4:3') {print "ok 3\n";} else {print "not ok 3\n";} 32{ 33 no warnings 'deprecated'; 34 pop(x); 35} 36if (join(':',@x) eq '1:2:3:1:2:3:4') {print "ok 4\n";} else {print "not ok 4\n";} 37 38$test = 5; 39foreach $line (@tests) { 40 ($list,$get,$leave) = split(/,\t*/,$line); 41 ($pos, $len, @list) = split(' ',$list); 42 @get = split(' ',$get); 43 @leave = split(' ',$leave); 44 @x = (0,1,2,3,4,5,6,7); 45 if (defined $len) { 46 @got = splice(@x, $pos, $len, @list); 47 } 48 else { 49 @got = splice(@x, $pos); 50 } 51 if (join(':',@got) eq join(':',@get) && 52 join(':',@x) eq join(':',@leave)) { 53 print "ok ",$test++,"\n"; 54 } 55 else { 56 print "not ok ",$test++," got: @got == @get left: @x == @leave\n"; 57 } 58} 59 601; # this file is require'd by lib/tie-stdpush.t 61