X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fop%2Fchop.t;h=bacc439676a26b594a1ce52c0fe9bf7e9a086e60;hb=3ab3c9b49fb213f2b1d4cda8797de17be82b2b15;hp=ba6d6262b3e23c6ab344f5b0311015052f70669b;hpb=fe14fcc35f78a371a174a1d14256c2f35ae4262b;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/t/op/chop.t b/t/op/chop.t
old mode 100644
new mode 100755
index ba6d626..bacc439
--- a/t/op/chop.t
+++ b/t/op/chop.t
@@ -1,20 +1,20 @@
 #!./perl
 
-# $Header: chop.t,v 4.0 91/03/20 01:51:42 lwall Locked $
-
-print "1..4\n";
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require './test.pl';
+}
 
-# optimized
+plan tests => 133;
 
 $_ = 'abc';
 $c = do foo();
-if ($c . $_ eq 'cab') {print "ok 1\n";} else {print "not ok 1 $c$_\n";}
-
-# unoptimized
+is ($c . $_, 'cab', 'optimized');
 
 $_ = 'abc';
 $c = chop($_);
-if ($c . $_ eq 'cab') {print "ok 2\n";} else {print "not ok 2\n";}
+is ($c . $_ , 'cab', 'unoptimized');
 
 sub foo {
     chop;
@@ -23,8 +23,202 @@ sub foo {
 @foo = ("hi \n","there\n","!\n");
 @bar = @foo;
 chop(@bar);
-print join('',@bar) eq 'hi there!' ? "ok 3\n" : "not ok 3\n";
+is (join('',@bar), 'hi there!');
 
 $foo = "\n";
 chop($foo,@foo);
-print join('',$foo,@foo) eq 'hi there!' ? "ok 4\n" : "not ok 4\n";
+is (join('',$foo,@foo), 'hi there!');
+
+$_ = "foo\n\n";
+$got = chomp();
+ok ($got == 1) or print "# got $got\n";
+is ($_, "foo\n");
+
+$_ = "foo\n";
+$got = chomp();
+ok ($got == 1) or print "# got $got\n";
+is ($_, "foo");
+
+$_ = "foo";
+$got = chomp();
+ok ($got == 0) or print "# got $got\n";
+is ($_, "foo");
+
+$_ = "foo";
+$/ = "oo";
+$got = chomp();
+ok ($got == 2) or print "# got $got\n";
+is ($_, "f");
+
+$_ = "bar";
+$/ = "oo";
+$got = chomp();
+ok ($got == 0) or print "# got $got\n";
+is ($_, "bar");
+
+$_ = "f\n\n\n\n\n";
+$/ = "";
+$got = chomp();
+ok ($got == 5) or print "# got $got\n";
+is ($_, "f");
+
+$_ = "f\n\n";
+$/ = "";
+$got = chomp();
+ok ($got == 2) or print "# got $got\n";
+is ($_, "f");
+
+$_ = "f\n";
+$/ = "";
+$got = chomp();
+ok ($got == 1) or print "# got $got\n";
+is ($_, "f");
+
+$_ = "f";
+$/ = "";
+$got = chomp();
+ok ($got == 0) or print "# got $got\n";
+is ($_, "f");
+
+$_ = "xx";
+$/ = "xx";
+$got = chomp();
+ok ($got == 2) or print "# got $got\n";
+is ($_, "");
+
+$_ = "axx";
+$/ = "xx";
+$got = chomp();
+ok ($got == 2) or print "# got $got\n";
+is ($_, "a");
+
+$_ = "axx";
+$/ = "yy";
+$got = chomp();
+ok ($got == 0) or print "# got $got\n";
+is ($_, "axx");
+
+# This case once mistakenly behaved like paragraph mode.
+$_ = "ab\n";
+$/ = \3;
+$got = chomp();
+ok ($got == 0) or print "# got $got\n";
+is ($_, "ab\n");
+
+# Go Unicode.
+
+$_ = "abc\x{1234}";
+chop;
+is ($_, "abc", "Go Unicode");
+
+$_ = "abc\x{1234}d";
+chop;
+is ($_, "abc\x{1234}");
+
+$_ = "\x{1234}\x{2345}";
+chop;
+is ($_, "\x{1234}");
+
+my @stuff = qw(this that);
+is (chop(@stuff[0,1]), 't');
+
+# bug id 20010305.012
+@stuff = qw(ab cd ef);
+is (chop(@stuff = @stuff), 'f');
+
+@stuff = qw(ab cd ef);
+is (chop(@stuff[0, 2]), 'f');
+
+my %stuff = (1..4);
+is (chop(@stuff{1, 3}), '4');
+
+# chomp should not stringify references unless it decides to modify them
+$_ = [];
+$/ = "\n";
+$got = chomp();
+ok ($got == 0) or print "# got $got\n";
+is (ref($_), "ARRAY", "chomp ref (modify)");
+
+$/ = ")";  # the last char of something like "ARRAY(0x80ff6e4)"
+$got = chomp();
+ok ($got == 1) or print "# got $got\n";
+ok (!ref($_), "chomp ref (no modify)");
+
+$/ = "\n";
+
+%chomp = ("One" => "One", "Two\n" => "Two", "" => "");
+%chop = ("One" => "On", "Two\n" => "Two", "" => "");
+
+foreach (keys %chomp) {
+  my $key = $_;
+  eval {chomp $_};
+  if ($@) {
+    my $err = $@;
+    $err =~ s/\n$//s;
+    fail ("\$\@ = \"$err\"");
+  } else {
+    is ($_, $chomp{$key}, "chomp hash key");
+  }
+}
+
+foreach (keys %chop) {
+  my $key = $_;
+  eval {chop $_};
+  if ($@) {
+    my $err = $@;
+    $err =~ s/\n$//s;
+    fail ("\$\@ = \"$err\"");
+  } else {
+    is ($_, $chop{$key}, "chop hash key");
+  }
+}
+
+# chop and chomp can't be lvalues
+eval 'chop($x) = 1;';
+ok($@ =~ /Can\'t modify.*chop.*in.*assignment/);
+eval 'chomp($x) = 1;';
+ok($@ =~ /Can\'t modify.*chom?p.*in.*assignment/);
+eval 'chop($x, $y) = (1, 2);';
+ok($@ =~ /Can\'t modify.*chop.*in.*assignment/);
+eval 'chomp($x, $y) = (1, 2);';
+ok($@ =~ /Can\'t modify.*chom?p.*in.*assignment/);
+
+my @chars = ("N", "\xd3", substr ("\xd4\x{100}", 0, 1), chr 1296);
+foreach my $start (@chars) {
+  foreach my $end (@chars) {
+    local $/ = $end;
+    my $message = "start=" . ord ($start) . " end=" . ord $end;
+    my $string = $start . $end;
+    is (chomp ($string), 1, "$message [returns 1]");
+    is ($string, $start, $message);
+
+    my $end_utf8 = $end;
+    utf8::encode ($end_utf8);
+    next if $end_utf8 eq $end;
+
+    # $end ne $end_utf8, so these should not chomp.
+    $string = $start . $end_utf8;
+    my $chomped = $string;
+    is (chomp ($chomped), 0, "$message (end as bytes) [returns 0]");
+    is ($chomped, $string, "$message (end as bytes)");
+
+    $/ = $end_utf8;
+    $string = $start . $end;
+    $chomped = $string;
+    is (chomp ($chomped), 0, "$message (\$/ as bytes) [returns 0]");
+    is ($chomped, $string, "$message (\$/ as bytes)");
+  }
+}
+
+{
+    # returns length in characters, but not in bytes.
+    $/ = "\x{100}";
+    $a = "A$/";
+    $b = chomp $a;
+    is ($b, 1);
+
+    $/ = "\x{100}\x{101}";
+    $a = "A$/";
+    $b = chomp $a;
+    is ($b, 2);
+}