This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Added descriptions to tests lacking them
[perl5.git] / t / op / chop.t
CommitLineData
8d063cd8
LW
1#!./perl
2
991e6d41
NC
3BEGIN {
4 chdir 't' if -d 't';
5 @INC = '../lib';
6 require './test.pl';
7}
8d063cd8 8
65ab9279 9plan tests => 143;
8d063cd8
LW
10
11$_ = 'abc';
bb19cdcd 12$c = foo();
991e6d41 13is ($c . $_, 'cab', 'optimized');
8d063cd8
LW
14
15$_ = 'abc';
16$c = chop($_);
991e6d41 17is ($c . $_ , 'cab', 'unoptimized');
8d063cd8
LW
18
19sub foo {
20 chop;
21}
a687059c
LW
22
23@foo = ("hi \n","there\n","!\n");
24@bar = @foo;
25chop(@bar);
ff64f327 26is (join('',@bar), 'hi there!', 'chop list of strings');
a687059c
LW
27
28$foo = "\n";
29chop($foo,@foo);
ff64f327 30is (join('',$foo,@foo), 'hi there!', 'chop on list reduces one-character element to an empty string');
a0d0e21e
LW
31
32$_ = "foo\n\n";
991e6d41 33$got = chomp();
ff64f327
JA
34is($got, 1, 'check return value when chomp string ending with two newlines; $/ is set to default of one newline');
35is ($_, "foo\n", 'chomp string ending with two newlines while $/ is set to one newline' );
a0d0e21e
LW
36
37$_ = "foo\n";
991e6d41 38$got = chomp();
ff64f327
JA
39is($got, 1, 'check return value chomp string ending with one newline while $/ is set to a newline');
40is ($_, "foo", 'test typical use of chomp; chomp a string ending in a single newline while $/ is set to default of one newline');
a0d0e21e
LW
41
42$_ = "foo";
991e6d41 43$got = chomp();
ff64f327
JA
44is($got, 0, 'check return value when chomp a string that does not end with current value of $/, 0 should be returned');
45is ($_, "foo", 'chomp a string that does not end with the current value of $/');
a0d0e21e
LW
46
47$_ = "foo";
48$/ = "oo";
991e6d41 49$got = chomp();
ff64f327
JA
50is ($got, "2", 'check return value when chomp string with $/ consisting of more than one character, and with the ending of the string matching $/');
51is ($_, "f", 'chomp a string when $/ consists of two characters that are at the end of the string, check that chomped string contains remnant of original string');
a0d0e21e
LW
52
53$_ = "bar";
54$/ = "oo";
991e6d41 55$got = chomp();
ff64f327
JA
56is($got, "0", 'check return value when call chomp with $/ consisting of more than one character, and with the ending of the string NOT matching $/');
57is ($_, "bar", 'chomp a string when $/ consists of two characters that are NOT at the end of the string');
a0d0e21e
LW
58
59$_ = "f\n\n\n\n\n";
60$/ = "";
991e6d41 61$got = chomp();
ff64f327
JA
62is ($got, 5, 'check return value when chomp in paragraph mode on string ending with 5 newlines');
63is ($_, "f", 'chomp in paragraph mode on string ending with 5 newlines');
a0d0e21e
LW
64
65$_ = "f\n\n";
66$/ = "";
991e6d41 67$got = chomp();
ff64f327
JA
68is ($got, 2, 'check return value when chomp in paragraph mode on string ending with 2 newlines');
69is ($_, "f", 'chomp in paragraph mode on string ending with 2 newlines');
a0d0e21e
LW
70
71$_ = "f\n";
72$/ = "";
991e6d41 73$got = chomp();
ff64f327
JA
74is ($got, 1, 'check return value when chomp in paragraph mode on string ending with 1 newline');
75is ($_, "f", 'chomp in paragraph mode on string ending with 1 newlines');
a0d0e21e
LW
76
77$_ = "f";
78$/ = "";
991e6d41 79$got = chomp();
ff64f327
JA
80is ($got, 0, 'check return value when chomp in paragraph mode on string ending with no newlines');
81is ($_, "f", 'chomp in paragraph mode on string lacking trailing newlines');
c85b29f8
PP
82
83$_ = "xx";
84$/ = "xx";
991e6d41 85$got = chomp();
ff64f327
JA
86is ($got, 2, 'check return value when chomp string that consists solely of current value of $/');
87is ($_, "", 'chomp on string that consists solely of current value of $/; check that empty string remains');
c85b29f8
PP
88
89$_ = "axx";
90$/ = "xx";
991e6d41 91$got = chomp();
ff64f327
JA
92is ($got, 2, 'check return value when chomp string that ends with current value of $/. $/ contains two characters');
93is ($_, "a", 'check that when chomp string that ends with currnt value of $/, the part of original string that wasn\'t in $/ remains');
c85b29f8
PP
94
95$_ = "axx";
96$/ = "yy";
991e6d41 97$got = chomp();
ff64f327
JA
98is ($got, 0, 'check return value when chomp string that does not end with $/');
99is ($_, "axx", 'chomp a string that does not end with $/, the entire string should remain intact');
4c5a6083
GS
100
101# This case once mistakenly behaved like paragraph mode.
102$_ = "ab\n";
103$/ = \3;
991e6d41 104$got = chomp();
ff64f327
JA
105is ($got, 0, 'check return value when call chomp with $_ = "ab\\n", $/ = \3' );
106is ($_, "ab\n", 'chomp with $_ = "ab\\n", $/ = \3' );
9b83640a
JH
107
108# Go Unicode.
109
110$_ = "abc\x{1234}";
111chop;
ff64f327 112is ($_, "abc", 'Go Unicode');
9b83640a
JH
113
114$_ = "abc\x{1234}d";
115chop;
991e6d41 116is ($_, "abc\x{1234}");
9b83640a
JH
117
118$_ = "\x{1234}\x{2345}";
119chop;
991e6d41 120is ($_, "\x{1234}");
37ce32a7 121
37ce32a7 122my @stuff = qw(this that);
991e6d41 123is (chop(@stuff[0,1]), 't');
2ec6af5f
RG
124
125# bug id 20010305.012
126@stuff = qw(ab cd ef);
991e6d41 127is (chop(@stuff = @stuff), 'f');
2ec6af5f
RG
128
129@stuff = qw(ab cd ef);
991e6d41 130is (chop(@stuff[0, 2]), 'f');
2ec6af5f
RG
131
132my %stuff = (1..4);
991e6d41 133is (chop(@stuff{1, 3}), '4');
9b33ce3b
GA
134
135# chomp should not stringify references unless it decides to modify them
136$_ = [];
137$/ = "\n";
991e6d41
NC
138$got = chomp();
139ok ($got == 0) or print "# got $got\n";
140is (ref($_), "ARRAY", "chomp ref (modify)");
9b33ce3b
GA
141
142$/ = ")"; # the last char of something like "ARRAY(0x80ff6e4)"
991e6d41
NC
143$got = chomp();
144ok ($got == 1) or print "# got $got\n";
145ok (!ref($_), "chomp ref (no modify)");
146
147$/ = "\n";
148
149%chomp = ("One" => "One", "Two\n" => "Two", "" => "");
150%chop = ("One" => "On", "Two\n" => "Two", "" => "");
151
152foreach (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
164foreach (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}
75ea820e
SM
175
176# chop and chomp can't be lvalues
177eval 'chop($x) = 1;';
30ebab2d 178ok($@ =~ /Can\'t modify.*chop.*in.*assignment/);
75ea820e 179eval 'chomp($x) = 1;';
30ebab2d 180ok($@ =~ /Can\'t modify.*chom?p.*in.*assignment/);
75ea820e 181eval 'chop($x, $y) = (1, 2);';
30ebab2d 182ok($@ =~ /Can\'t modify.*chop.*in.*assignment/);
75ea820e 183eval 'chomp($x, $y) = (1, 2);';
30ebab2d 184ok($@ =~ /Can\'t modify.*chom?p.*in.*assignment/);
75ea820e 185
8a38a836 186my @chars = ("N", latin1_to_native("\xd3"), substr ("\xd4\x{100}", 0, 1), chr 1296);
c4c87a06
NC
187foreach 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;
132d8bbf 192 is (chomp ($string), 1, "$message [returns 1]");
c4c87a06
NC
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;
132d8bbf 202 is (chomp ($chomped), 0, "$message (end as bytes) [returns 0]");
c4c87a06
NC
203 is ($chomped, $string, "$message (end as bytes)");
204
205 $/ = $end_utf8;
206 $string = $start . $end;
207 $chomped = $string;
132d8bbf 208 is (chomp ($chomped), 0, "$message (\$/ as bytes) [returns 0]");
c4c87a06
NC
209 is ($chomped, $string, "$message (\$/ as bytes)");
210 }
211}
a6aa349d
ST
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}
ace7757b
ST
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}
1937c63e
ST
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}
65ab9279
TC
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: {
dfae3023 256 no warnings 'overflow'; # avoid compile-time warnings below on 32-bit architectures
65ab9279
TC
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}