This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Refactor t/op/splice.t to use t/test.pl instead of making TAP by hand.
authorColin Kuskie <colink@perldreamer.com>
Fri, 22 Jun 2012 22:35:58 +0000 (15:35 -0700)
committerNicholas Clark <nick@ccl4.org>
Tue, 3 Jul 2012 16:27:45 +0000 (18:27 +0200)
t/op/splice.t

index bc6fb40..d462f0c 100644 (file)
@@ -1,41 +1,47 @@
 #!./perl
 
-print "1..21\n";
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require './test.pl';
+}
+
+$|  = 1;
 
 @a = (1..10);
 
 sub j { join(":",@_) }
 
-print "not " unless j(splice(@a,@a,0,11,12)) eq "" && j(@a) eq j(1..12);
-print "ok 1\n";
+is( j(splice(@a,@a,0,11,12)), '', 'return value of splice when nothing is removed, only added');
+is( j(@a), j(1..12), '... added two elements');
 
-print "not " unless j(splice(@a,-1)) eq "12" && j(@a) eq j(1..11);
-print "ok 2\n";
+is( j(splice(@a,-1)), "12", 'remove last element, return value');
+is( j(@a), j(1..11), '... removed last element');
 
-print "not " unless j(splice(@a,0,1)) eq "1" && j(@a) eq j(2..11);
-print "ok 3\n";
+is( j(splice(@a,0,1)), "1", 'remove first element, return value');
+is( j(@a), j(2..11), '... first element removed');
 
-print "not " unless j(splice(@a,0,0,0,1)) eq "" && j(@a) eq j(0..11);
-print "ok 4\n";
+is( j(splice(@a,0,0,0,1)), "", 'emulate shift, return value is empty');
+is( j(@a), j(0..11), '... added two elements to beginning of the list');
 
-print "not " unless j(splice(@a,5,1,5)) eq "5" && j(@a) eq j(0..11);
-print "ok 5\n";
+is( j(splice(@a,5,1,5)), "5", 'remove and replace an element to the end of the list, return value is the element');
+is( j(@a), j(0..11), '... list remains the same');
 
-print "not " unless j(splice(@a, @a, 0, 12, 13)) eq "" && j(@a) eq j(0..13);
-print "ok 6\n";
+is( j(splice(@a, @a, 0, 12, 13)), "", 'push two elements onto the end of the list, return value is empty');
+is( j(@a), j(0..13), '... added two elements to the end of the list');
 
-print "not " unless j(splice(@a, -@a, @a, 1, 2, 3)) eq j(0..13) && j(@a) eq j(1..3);
-print "ok 7\n";
+is( j(splice(@a, -@a, @a, 1, 2, 3)), j(0..13), 'splice the whole list out, add 3 elements, return value is @a');
+is( j(@a), j(1..3), '... array only contains new elements');
 
-print "not " unless j(splice(@a, 1, -1, 7, 7)) eq "2" && j(@a) eq j(1,7,7,3);
-print "ok 8\n";
+is( j(splice(@a, 1, -1, 7, 7)), "2", 'replace middle element with two elements, negative offset, return value is the element' );
+is( j(@a), j(1,7,7,3), '... array 1,7,7,3');
 
-print "not " unless j(splice(@a,-3,-2,2)) eq j(7) && j(@a) eq j(1,2,7,3);
-print "ok 9\n";
+is( j(splice(@a,-3,-2,2)), j(7), 'replace first 7 with a 2, negative offset, negative length, return value is 7');
+is( j(@a), j(1,2,7,3), '... array has 1,2,7,3');
 
 # Bug 20000223.001 - no test for splice(@array).  Destructive test!
-print "not " unless j(splice(@a)) eq j(1,2,7,3) && j(@a) eq '';
-print "ok 10\n";
+is( j(splice(@a)), j(1,2,7,3), 'bare splice empties the array, return value is the array');
+is( j(@a),  '', 'array is empty');
 
 # Tests 11 and 12:
 # [ID 20010711.005] in Tie::Array, SPLICE ignores context, breaking SHIFT
@@ -44,56 +50,46 @@ my $foo;
 
 @a = ('red', 'green', 'blue');
 $foo = splice @a, 1, 2;
-print "not " unless $foo eq 'blue';
-print "ok 11\n";
+is( $foo, 'blue', 'remove a single element in scalar context');
 
 @a = ('red', 'green', 'blue');
 $foo = shift @a;
-print "not " unless $foo eq 'red';
-print "ok 12\n";
+is( $foo, 'red', 'do the same with shift');
 
 # Bug [perl #30568] - insertions of deleted elements
 @a = (1, 2, 3);
 splice( @a, 0, 3, $a[1], $a[0] );
-print "not " unless j(@a) eq j(2,1);
-print "ok 13\n";
+is( j(@a), j(2,1), 'splice and replace with indexes 1, 0');
 
 @a = (1, 2, 3);
 splice( @a, 0, 3 ,$a[0], $a[1] );
-print "not " unless j(@a) eq j(1,2);
-print "ok 14\n";
+is( j(@a), j(1,2), 'splice and replace with indexes 0, 1');
 
 @a = (1, 2, 3);
 splice( @a, 0, 3 ,$a[2], $a[1], $a[0] );
-print "not " unless j(@a) eq j(3,2,1);
-print "ok 15\n";
+is( j(@a), j(3,2,1), 'splice and replace with indexes 2, 1, 0');
 
 @a = (1, 2, 3);
 splice( @a, 0, 3, $a[0], $a[1], $a[2], $a[0], $a[1], $a[2] );
-print "not " unless j(@a) eq j(1,2,3,1,2,3);
-print "ok 16\n";
+is( j(@a), j(1,2,3,1,2,3), 'splice and replace with a whole bunch');
 
 @a = (1, 2, 3);
 splice( @a, 1, 2, $a[2], $a[1] );
-print "not " unless j(@a) eq j(1,3,2);
-print "ok 17\n";
+is( j(@a), j(1,3,2), 'swap last two elements');
 
 @a = (1, 2, 3);
 splice( @a, 1, 2, $a[1], $a[1] );
-print "not " unless j(@a) eq j(1,2,2);
-print "ok 18\n";
+is( j(@a), j(1,2,2), 'duplicate middle element on the end');
 
 # splice should invoke get magic
 
-print "not " if Foo->isa('Bar');
-print "ok 19\n";
+ok( ! Foo->isa('Bar'), 'Foo is not a Bar');
 
 splice @Foo::ISA, 0, 0, 'Bar';
-
-print "not " if !Foo->isa('Bar');
-print "ok 20\n";
+ok( !oo->isa('Bar'), 'splice @ISA and make Foo a Bar');
 
 # Test undef first arg
 eval { splice( $new_arrayref, 0, 0, 1, 2, 3 ) };
-print "not " unless $@ && $@ =~ /Not an ARRAY/;
-print "ok 21\n";
+like($@, qr/Not an ARRAY/, 'undefined first argument to splice');
+
+done_testing;