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