+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", latin1_to_native("\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);
+}
+
+{
+ # [perl #36569] chop fails on decoded string with trailing nul
+ my $asc = "perl\0";
+ my $utf = "perl".pack('U',0); # marked as utf8
+ is(chop($asc), "\0", "chopping ascii NUL");
+ is(chop($utf), "\0", "chopping utf8 NUL");
+ is($asc, "perl", "chopped ascii NUL");
+ is($utf, "perl", "chopped utf8 NUL");
+}
+
+{
+ # Change 26011: Re: A surprising segfault
+ # to make sure only that these obfuscated sentences will not crash.
+
+ map chop(+()), ('')x68;
+ ok(1, "extend sp in pp_chop");
+
+ 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: {
+ 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");
+ }
+}
https://perl5.git.perl.org / perl5.git / blobdiff