Fix for perl #112316: Wrong behavior regarding labels with same prefix

[perl5.git] / t / op / chop.t

diff --git a/t/op/chop.t b/t/op/chop.t
old mode 100755 (executable)
new mode 100644 (file)
index 503f6f7..4aa8db3
--- a/t/op/chop.t
+++ b/t/op/chop.t
@@ -6,10 +6,10 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 139;
+plan tests => 143;
 
 $_ = 'abc';
-$c = do foo();
+$c = foo();
 is ($c . $_, 'cab', 'optimized');
 
 $_ = 'abc';
@@ -183,7 +183,7 @@ ok($@ =~ /Can\'t modify.*chop.*in.*assignment/);
 eval 'chomp($x, $y) = (1, 2);';
 ok($@ =~ /Can\'t modify.*chom?p.*in.*assignment/);
 
-my @chars = ("N", ord('A') == 193 ? "\xee" : "\xd3", substr ("\xd4\x{100}", 0, 1), chr 1296);
+my @chars = ("N", latin1_to_native("\xd3"), substr ("\xd4\x{100}", 0, 1), chr 1296);
 foreach my $start (@chars) {
   foreach my $end (@chars) {
     local $/ = $end;
@@ -243,3 +243,23 @@ foreach my $start (@chars) {
     map chomp(+()), ('')x68;
     ok(1, "extend sp in pp_chomp");
 }
+
+{
+    # [perl #73246] chop doesn't support utf8
+    # the problem was UTF8_IS_START() didn't handle perl's extended UTF8
+    my $utf = "\x{80000001}\x{80000000}";
+    my $result = chop($utf);
+    is($utf, "\x{80000001}", "chopping high 'unicode'- remnant");
+    is($result, "\x{80000000}", "chopping high 'unicode' - result");
+
+    SKIP: {
+        no warnings 'overflow'; # avoid compile-time warnings below on 32-bit architectures
+        use Config;
+        $Config{ivsize} >= 8
+         or skip("this build can't handle very large characters", 2);
+        my $utf = "\x{ffffffffffffffff}\x{fffffffffffffffe}";
+        my $result = chop $utf;
+        is($utf, "\x{ffffffffffffffff}", "chop even higher 'unicode' - remnant");
+        is($result, "\x{fffffffffffffffe}", "chop even higher 'unicode' - result");
+    }
+}