t/op/chop.t

   1 #!./perl
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     @INC = '../lib';
   6     require './test.pl';
   7 }
   8
   9 plan tests => 143;
  10
  11 $_ = 'abc';
  12 $c = foo();
  13 is ($c . $_, 'cab', 'optimized');
  14
  15 $_ = 'abc';
  16 $c = chop($_);
  17 is ($c . $_ , 'cab', 'unoptimized');
  18
  19 sub foo {
  20     chop;
  21 }
  22
  23 @foo = ("hi \n","there\n","!\n");
  24 @bar = @foo;
  25 chop(@bar);
  26 is (join('',@bar), 'hi there!');
  27
  28 $foo = "\n";
  29 chop($foo,@foo);
  30 is (join('',$foo,@foo), 'hi there!');
  31
  32 $_ = "foo\n\n";
  33 $got = chomp();
  34 ok ($got == 1) or print "# got $got\n";
  35 is ($_, "foo\n");
  36
  37 $_ = "foo\n";
  38 $got = chomp();
  39 ok ($got == 1) or print "# got $got\n";
  40 is ($_, "foo");
  41
  42 $_ = "foo";
  43 $got = chomp();
  44 ok ($got == 0) or print "# got $got\n";
  45 is ($_, "foo");
  46
  47 $_ = "foo";
  48 $/ = "oo";
  49 $got = chomp();
  50 ok ($got == 2) or print "# got $got\n";
  51 is ($_, "f");
  52
  53 $_ = "bar";
  54 $/ = "oo";
  55 $got = chomp();
  56 ok ($got == 0) or print "# got $got\n";
  57 is ($_, "bar");
  58
  59 $_ = "f\n\n\n\n\n";
  60 $/ = "";
  61 $got = chomp();
  62 ok ($got == 5) or print "# got $got\n";
  63 is ($_, "f");
  64
  65 $_ = "f\n\n";
  66 $/ = "";
  67 $got = chomp();
  68 ok ($got == 2) or print "# got $got\n";
  69 is ($_, "f");
  70
  71 $_ = "f\n";
  72 $/ = "";
  73 $got = chomp();
  74 ok ($got == 1) or print "# got $got\n";
  75 is ($_, "f");
  76
  77 $_ = "f";
  78 $/ = "";
  79 $got = chomp();
  80 ok ($got == 0) or print "# got $got\n";
  81 is ($_, "f");
  82
  83 $_ = "xx";
  84 $/ = "xx";
  85 $got = chomp();
  86 ok ($got == 2) or print "# got $got\n";
  87 is ($_, "");
  88
  89 $_ = "axx";
  90 $/ = "xx";
  91 $got = chomp();
  92 ok ($got == 2) or print "# got $got\n";
  93 is ($_, "a");
  94
  95 $_ = "axx";
  96 $/ = "yy";
  97 $got = chomp();
  98 ok ($got == 0) or print "# got $got\n";
  99 is ($_, "axx");
 100
 101 # This case once mistakenly behaved like paragraph mode.
 102 $_ = "ab\n";
 103 $/ = \3;
 104 $got = chomp();
 105 ok ($got == 0) or print "# got $got\n";
 106 is ($_, "ab\n");
 107
 108 # Go Unicode.
 109
 110 $_ = "abc\x{1234}";
 111 chop;
 112 is ($_, "abc", "Go Unicode");
 113
 114 $_ = "abc\x{1234}d";
 115 chop;
 116 is ($_, "abc\x{1234}");
 117
 118 $_ = "\x{1234}\x{2345}";
 119 chop;
 120 is ($_, "\x{1234}");
 121
 122 my @stuff = qw(this that);
 123 is (chop(@stuff[0,1]), 't');
 124
 125 # bug id 20010305.012
 126 @stuff = qw(ab cd ef);
 127 is (chop(@stuff = @stuff), 'f');
 128
 129 @stuff = qw(ab cd ef);
 130 is (chop(@stuff[0, 2]), 'f');
 131
 132 my %stuff = (1..4);
 133 is (chop(@stuff{1, 3}), '4');
 134
 135 # chomp should not stringify references unless it decides to modify them
 136 $_ = [];
 137 $/ = "\n";
 138 $got = chomp();
 139 ok ($got == 0) or print "# got $got\n";
 140 is (ref($_), "ARRAY", "chomp ref (modify)");
 141
 142 $/ = ")";  # the last char of something like "ARRAY(0x80ff6e4)"
 143 $got = chomp();
 144 ok ($got == 1) or print "# got $got\n";
 145 ok (!ref($_), "chomp ref (no modify)");
 146
 147 $/ = "\n";
 148
 149 %chomp = ("One" => "One", "Two\n" => "Two", "" => "");
 150 %chop = ("One" => "On", "Two\n" => "Two", "" => "");
 151
 152 foreach (keys %chomp) {
 153   my $key = $_;
 154   eval {chomp $_};
 155   if ($@) {
 156     my $err = $@;
 157     $err =~ s/\n$//s;
 158     fail ("\$\@ = \"$err\"");
 159   } else {
 160     is ($_, $chomp{$key}, "chomp hash key");
 161   }
 162 }
 163
 164 foreach (keys %chop) {
 165   my $key = $_;
 166   eval {chop $_};
 167   if ($@) {
 168     my $err = $@;
 169     $err =~ s/\n$//s;
 170     fail ("\$\@ = \"$err\"");
 171   } else {
 172     is ($_, $chop{$key}, "chop hash key");
 173   }
 174 }
 175
 176 # chop and chomp can't be lvalues
 177 eval 'chop($x) = 1;';
 178 ok($@ =~ /Can\'t modify.*chop.*in.*assignment/);
 179 eval 'chomp($x) = 1;';
 180 ok($@ =~ /Can\'t modify.*chom?p.*in.*assignment/);
 181 eval 'chop($x, $y) = (1, 2);';
 182 ok($@ =~ /Can\'t modify.*chop.*in.*assignment/);
 183 eval 'chomp($x, $y) = (1, 2);';
 184 ok($@ =~ /Can\'t modify.*chom?p.*in.*assignment/);
 185
 186 my @chars = ("N", latin1_to_native("\xd3"), substr ("\xd4\x{100}", 0, 1), chr 1296);
 187 foreach my $start (@chars) {
 188   foreach my $end (@chars) {
 189     local $/ = $end;
 190     my $message = "start=" . ord ($start) . " end=" . ord $end;
 191     my $string = $start . $end;
 192     is (chomp ($string), 1, "$message [returns 1]");
 193     is ($string, $start, $message);
 194
 195     my $end_utf8 = $end;
 196     utf8::encode ($end_utf8);
 197     next if $end_utf8 eq $end;
 198
 199     # $end ne $end_utf8, so these should not chomp.
 200     $string = $start . $end_utf8;
 201     my $chomped = $string;
 202     is (chomp ($chomped), 0, "$message (end as bytes) [returns 0]");
 203     is ($chomped, $string, "$message (end as bytes)");
 204
 205     $/ = $end_utf8;
 206     $string = $start . $end;
 207     $chomped = $string;
 208     is (chomp ($chomped), 0, "$message (\$/ as bytes) [returns 0]");
 209     is ($chomped, $string, "$message (\$/ as bytes)");
 210   }
 211 }
 212
 213 {
 214     # returns length in characters, but not in bytes.
 215     $/ = "\x{100}";
 216     $a = "A$/";
 217     $b = chomp $a;
 218     is ($b, 1);
 219
 220     $/ = "\x{100}\x{101}";
 221     $a = "A$/";
 222     $b = chomp $a;
 223     is ($b, 2);
 224 }
 225
 226 {
 227     # [perl #36569] chop fails on decoded string with trailing nul
 228     my $asc = "perl\0";
 229     my $utf = "perl".pack('U',0); # marked as utf8
 230     is(chop($asc), "\0", "chopping ascii NUL");
 231     is(chop($utf), "\0", "chopping utf8 NUL");
 232     is($asc, "perl", "chopped ascii NUL");
 233     is($utf, "perl", "chopped utf8 NUL");
 234 }
 235
 236 {
 237     # Change 26011: Re: A surprising segfault
 238     # to make sure only that these obfuscated sentences will not crash.
 239
 240     map chop(+()), ('')x68;
 241     ok(1, "extend sp in pp_chop");
 242
 243     map chomp(+()), ('')x68;
 244     ok(1, "extend sp in pp_chomp");
 245 }
 246
 247 {
 248     # [perl #73246] chop doesn't support utf8
 249     # the problem was UTF8_IS_START() didn't handle perl's extended UTF8
 250     my $utf = "\x{80000001}\x{80000000}";
 251     my $result = chop($utf);
 252     is($utf, "\x{80000001}", "chopping high 'unicode'- remnant");
 253     is($result, "\x{80000000}", "chopping high 'unicode' - result");
 254
 255     SKIP: {
 256         no warnings 'overflow'; # avoid compile-time warnings below on 32-bit architectures
 257         use Config;
 258         $Config{ivsize} >= 8
 259           or skip("this build can't handle very large characters", 2);
 260         my $utf = "\x{ffffffffffffffff}\x{fffffffffffffffe}";
 261         my $result = chop $utf;
 262         is($utf, "\x{ffffffffffffffff}", "chop even higher 'unicode' - remnant");
 263         is($result, "\x{fffffffffffffffe}", "chop even higher 'unicode' - result");
 264     }
 265 }