1#!./perl 2 3BEGIN { 4 chdir 't' if -d 't'; 5 require './test.pl'; 6 set_up_inc('../lib'); 7} 8 9$| = 1; 10 11@a = (1..10); 12 13sub j { join(":",@_) } 14 15is( j(splice(@a,@a,0,11,12)), '', 'return value of splice when nothing is removed, only added'); 16is( j(@a), j(1..12), '... added two elements'); 17 18is( j(splice(@a,-1)), "12", 'remove last element, return value'); 19is( j(@a), j(1..11), '... removed last element'); 20 21is( j(splice(@a,0,1)), "1", 'remove first element, return value'); 22is( j(@a), j(2..11), '... first element removed'); 23 24is( j(splice(@a,0,0,0,1)), "", 'emulate shift, return value is empty'); 25is( j(@a), j(0..11), '... added two elements to beginning of the list'); 26 27is( j(splice(@a,5,1,5)), "5", 'remove and replace an element to the end of the list, return value is the element'); 28is( j(@a), j(0..11), '... list remains the same'); 29 30is( j(splice(@a, @a, 0, 12, 13)), "", 'push two elements onto the end of the list, return value is empty'); 31is( j(@a), j(0..13), '... added two elements to the end of the list'); 32 33is( j(splice(@a, -@a, @a, 1, 2, 3)), j(0..13), 'splice the whole list out, add 3 elements, return value is @a'); 34is( j(@a), j(1..3), '... array only contains new elements'); 35 36is( j(splice(@a, 1, -1, 7, 7)), "2", 'replace middle element with two elements, negative offset, return value is the element' ); 37is( j(@a), j(1,7,7,3), '... array 1,7,7,3'); 38 39is( j(splice(@a,-3,-2,2)), j(7), 'replace first 7 with a 2, negative offset, negative length, return value is 7'); 40is( j(@a), j(1,2,7,3), '... array has 1,2,7,3'); 41 42# Bug 20000223.001 (#2196) - no test for splice(@array). Destructive test! 43is( j(splice(@a)), j(1,2,7,3), 'bare splice empties the array, return value is the array'); 44is( j(@a), '', 'array is empty'); 45 46# Tests 11 and 12: 47# [ID 20010711.005 (#7265)] in Tie::Array, SPLICE ignores context, breaking SHIFT 48 49my $foo; 50 51@a = ('red', 'green', 'blue'); 52$foo = splice @a, 1, 2; 53is( $foo, 'blue', 'remove a single element in scalar context'); 54 55@a = ('red', 'green', 'blue'); 56$foo = shift @a; 57is( $foo, 'red', 'do the same with shift'); 58 59# Bug [perl #30568] - insertions of deleted elements 60@a = (1, 2, 3); 61splice( @a, 0, 3, $a[1], $a[0] ); 62is( j(@a), j(2,1), 'splice and replace with indexes 1, 0'); 63 64@a = (1, 2, 3); 65splice( @a, 0, 3 ,$a[0], $a[1] ); 66is( j(@a), j(1,2), 'splice and replace with indexes 0, 1'); 67 68@a = (1, 2, 3); 69splice( @a, 0, 3 ,$a[2], $a[1], $a[0] ); 70is( j(@a), j(3,2,1), 'splice and replace with indexes 2, 1, 0'); 71 72@a = (1, 2, 3); 73splice( @a, 0, 3, $a[0], $a[1], $a[2], $a[0], $a[1], $a[2] ); 74is( j(@a), j(1,2,3,1,2,3), 'splice and replace with a whole bunch'); 75 76@a = (1, 2, 3); 77splice( @a, 1, 2, $a[2], $a[1] ); 78is( j(@a), j(1,3,2), 'swap last two elements'); 79 80@a = (1, 2, 3); 81splice( @a, 1, 2, $a[1], $a[1] ); 82is( j(@a), j(1,2,2), 'duplicate middle element on the end'); 83 84# splice should invoke get magic 85 86ok( ! Foo->isa('Bar'), 'Foo is not a Bar'); 87 88splice @Foo::ISA, 0, 0, 'Bar'; 89ok( Foo->isa('Bar'), 'splice @ISA and make Foo a Bar'); 90 91# Test arrays with nonexistent elements (crashes when it fails) 92@a = (); 93$#a++; 94is sprintf("%s", splice @a, 0, 1), "", 95 'splice handles nonexistent elems when shrinking the array'; 96@a = (); 97$#a++; 98is sprintf("%s", splice @a, 0, 1, undef), "", 99 'splice handles nonexistent elems when array len stays the same'; 100 101# RT#131000 102{ 103 local $@; 104 my @readonly_array = 10..11; 105 Internals::SvREADONLY(@readonly_array, 1); 106 eval { splice @readonly_array, 1, 0, () }; 107 like $@, qr/^Modification of a read-only value/, 108 "croak when splicing into readonly array"; 109} 110 111done_testing; 112