xref: /openbsd/gnu/usr.bin/perl/t/op/chop.t (revision 898184e3) 
1#!./perl
2
3BEGIN {
4    chdir 't' if -d 't';
5    @INC = '../lib';
6    require './test.pl';
7}
8
9plan tests => 139;
10
11$_ = 'abc';
12$c = foo();
13is ($c . $_, 'cab', 'optimized');
14
15$_ = 'abc';
16$c = chop($_);
17is ($c . $_ , 'cab', 'unoptimized');
18
19sub foo {
20    chop;
21}
22
23@foo = ("hi \n","there\n","!\n");
24@bar = @foo;
25chop(@bar);
26is (join('',@bar), 'hi there!');
27
28$foo = "\n";
29chop($foo,@foo);
30is (join('',$foo,@foo), 'hi there!');
31
32$_ = "foo\n\n";
33$got = chomp();
34ok ($got == 1) or print "# got $got\n";
35is ($_, "foo\n");
36
37$_ = "foo\n";
38$got = chomp();
39ok ($got == 1) or print "# got $got\n";
40is ($_, "foo");
41
42$_ = "foo";
43$got = chomp();
44ok ($got == 0) or print "# got $got\n";
45is ($_, "foo");
46
47$_ = "foo";
48$/ = "oo";
49$got = chomp();
50ok ($got == 2) or print "# got $got\n";
51is ($_, "f");
52
53$_ = "bar";
54$/ = "oo";
55$got = chomp();
56ok ($got == 0) or print "# got $got\n";
57is ($_, "bar");
58
59$_ = "f\n\n\n\n\n";
60$/ = "";
61$got = chomp();
62ok ($got == 5) or print "# got $got\n";
63is ($_, "f");
64
65$_ = "f\n\n";
66$/ = "";
67$got = chomp();
68ok ($got == 2) or print "# got $got\n";
69is ($_, "f");
70
71$_ = "f\n";
72$/ = "";
73$got = chomp();
74ok ($got == 1) or print "# got $got\n";
75is ($_, "f");
76
77$_ = "f";
78$/ = "";
79$got = chomp();
80ok ($got == 0) or print "# got $got\n";
81is ($_, "f");
82
83$_ = "xx";
84$/ = "xx";
85$got = chomp();
86ok ($got == 2) or print "# got $got\n";
87is ($_, "");
88
89$_ = "axx";
90$/ = "xx";
91$got = chomp();
92ok ($got == 2) or print "# got $got\n";
93is ($_, "a");
94
95$_ = "axx";
96$/ = "yy";
97$got = chomp();
98ok ($got == 0) or print "# got $got\n";
99is ($_, "axx");
100
101# This case once mistakenly behaved like paragraph mode.
102$_ = "ab\n";
103$/ = \3;
104$got = chomp();
105ok ($got == 0) or print "# got $got\n";
106is ($_, "ab\n");
107
108# Go Unicode.
109
110$_ = "abc\x{1234}";
111chop;
112is ($_, "abc", "Go Unicode");
113
114$_ = "abc\x{1234}d";
115chop;
116is ($_, "abc\x{1234}");
117
118$_ = "\x{1234}\x{2345}";
119chop;
120is ($_, "\x{1234}");
121
122my @stuff = qw(this that);
123is (chop(@stuff[0,1]), 't');
124
125# bug id 20010305.012
126@stuff = qw(ab cd ef);
127is (chop(@stuff = @stuff), 'f');
128
129@stuff = qw(ab cd ef);
130is (chop(@stuff[0, 2]), 'f');
131
132my %stuff = (1..4);
133is (chop(@stuff{1, 3}), '4');
134
135# chomp should not stringify references unless it decides to modify them
136$_ = [];
137$/ = "\n";
138$got = chomp();
139ok ($got == 0) or print "# got $got\n";
140is (ref($_), "ARRAY", "chomp ref (modify)");
141
142$/ = ")";  # the last char of something like "ARRAY(0x80ff6e4)"
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}
175
176# chop and chomp can't be lvalues
177eval 'chop($x) = 1;';
178ok($@ =~ /Can\'t modify.*chop.*in.*assignment/);
179eval 'chomp($x) = 1;';
180ok($@ =~ /Can\'t modify.*chom?p.*in.*assignment/);
181eval 'chop($x, $y) = (1, 2);';
182ok($@ =~ /Can\'t modify.*chop.*in.*assignment/);
183eval 'chomp($x, $y) = (1, 2);';
184ok($@ =~ /Can\'t modify.*chom?p.*in.*assignment/);
185
186my @chars = ("N", ord('A') == 193 ? "\xee" : "\xd3", substr ("\xd4\x{100}", 0, 1), chr 1296);
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;
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