This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
note about undocumented caller() return value (from M.J.T. Guy);
[perl5.git] / t / op / substr.t
CommitLineData
a687059c 1
e476b1b5 2print "1..125\n";
84902520
TB
3
4#P = start of string Q = start of substr R = end of substr S = end of string
a687059c 5
e476b1b5
GS
6BEGIN {
7 unshift @INC, '../lib' if -d '../lib' ;
8}
9use warnings ;
84902520 10
e476b1b5 11$a = 'abcdefxyz';
84902520
TB
12$SIG{__WARN__} = sub {
13 if ($_[0] =~ /^substr outside of string/) {
14 $w++;
15 } elsif ($_[0] =~ /^Attempt to use reference as lvalue in substr/) {
16 $w += 2;
5d82c453
GA
17 } elsif ($_[0] =~ /^Use of uninitialized value/) {
18 $w += 3;
84902520 19 } else {
5d82c453 20 warn $_[0];
84902520
TB
21 }
22};
a687059c 23
e476b1b5
GS
24sub ok { print (($_[1] ? "" : "not ") . "ok $_[0]\n") }
25
26$FATAL_MSG = '^substr outside of string' ;
84902520 27
e476b1b5
GS
28ok 1, substr($a,0,3) eq 'abc'; # P=Q R S
29ok 2, substr($a,3,3) eq 'def'; # P Q R S
30ok 3, substr($a,6,999) eq 'xyz'; # P Q S R
31$b = substr($a,999,999) ; # warn # P R Q S
32ok 4, $w-- == 1 ;
33eval{substr($a,999,999) = "" ; };# P R Q S
34ok 5, $@ =~ /$FATAL_MSG/;
35ok 6, substr($a,0,-6) eq 'abc'; # P=Q R S
36ok 7, substr($a,-3,1) eq 'x'; # P Q R S
a687059c
LW
37
38$[ = 1;
39
e476b1b5
GS
40ok 8, substr($a,1,3) eq 'abc' ; # P=Q R S
41ok 9, substr($a,4,3) eq 'def' ; # P Q R S
42ok 10, substr($a,7,999) eq 'xyz';# P Q S R
43$b = substr($a,999,999) ; # warn # P R Q S
44ok 11, $w-- == 1 ;
45eval{substr($a,999,999) = "" ; } ; # P R Q S
46ok 12, $@ =~ /$FATAL_MSG/;
47ok 13, substr($a,1,-6) eq 'abc' ;# P=Q R S
48ok 14, substr($a,-3,1) eq 'x' ; # P Q R S
a687059c
LW
49
50$[ = 0;
51
52substr($a,3,3) = 'XYZ';
e476b1b5 53ok 15, $a eq 'abcXYZxyz' ;
a687059c 54substr($a,0,2) = '';
e476b1b5 55ok 16, $a eq 'cXYZxyz' ;
a687059c 56substr($a,0,0) = 'ab';
e476b1b5 57ok 17, $a eq 'abcXYZxyz' ;
a687059c 58substr($a,0,0) = '12345678';
e476b1b5 59ok 18, $a eq '12345678abcXYZxyz' ;
a687059c 60substr($a,-3,3) = 'def';
e476b1b5 61ok 19, $a eq '12345678abcXYZdef';
a687059c 62substr($a,-3,3) = '<';
e476b1b5 63ok 20, $a eq '12345678abcXYZ<' ;
a687059c 64substr($a,-1,1) = '12345678';
e476b1b5 65ok 21, $a eq '12345678abcXYZ12345678' ;
a687059c 66
d9d8d8de
LW
67$a = 'abcdefxyz';
68
e476b1b5
GS
69ok 22, substr($a,6) eq 'xyz' ; # P Q R=S
70ok 23, substr($a,-3) eq 'xyz' ; # P Q R=S
71$b = substr($a,999,999) ; # warning # P R=S Q
72ok 24, $w-- == 1 ;
73eval{substr($a,999,999) = "" ; } ; # P R=S Q
74ok 25, $@ =~ /$FATAL_MSG/;
75ok 26, substr($a,0) eq 'abcdefxyz' ; # P=Q R=S
76ok 27, substr($a,9) eq '' ; # P Q=R=S
77ok 28, substr($a,-11) eq 'abcdefxyz'; # Q P R=S
78ok 29, substr($a,-9) eq 'abcdefxyz'; # P=Q R=S
84902520
TB
79
80$a = '54321';
81
e476b1b5
GS
82$b = substr($a,-7, 1) ; # warn # Q R P S
83ok 30, $w-- == 1 ;
84eval{substr($a,-7, 1) = "" ; }; # Q R P S
85ok 31, $@ =~ /$FATAL_MSG/;
86$b = substr($a,-7,-6) ; # warn # Q R P S
87ok 32, $w-- == 1 ;
88eval{substr($a,-7,-6) = "" ; }; # Q R P S
89ok 33, $@ =~ /$FATAL_MSG/;
90ok 34, substr($a,-5,-7) eq ''; # R P=Q S
91ok 35, substr($a, 2,-7) eq ''; # R P Q S
92ok 36, substr($a,-3,-7) eq ''; # R P Q S
93ok 37, substr($a, 2,-5) eq ''; # P=R Q S
94ok 38, substr($a,-3,-5) eq ''; # P=R Q S
95ok 39, substr($a, 2,-4) eq ''; # P R Q S
96ok 40, substr($a,-3,-4) eq ''; # P R Q S
97ok 41, substr($a, 5,-6) eq ''; # R P Q=S
98ok 42, substr($a, 5,-5) eq ''; # P=R Q S
99ok 43, substr($a, 5,-3) eq ''; # P R Q=S
100$b = substr($a, 7,-7) ; # warn # R P S Q
101ok 44, $w-- == 1 ;
102eval{substr($a, 7,-7) = "" ; }; # R P S Q
103ok 45, $@ =~ /$FATAL_MSG/;
104$b = substr($a, 7,-5) ; # warn # P=R S Q
105ok 46, $w-- == 1 ;
106eval{substr($a, 7,-5) = "" ; }; # P=R S Q
107ok 47, $@ =~ /$FATAL_MSG/;
108$b = substr($a, 7,-3) ; # warn # P Q S Q
109ok 48, $w-- == 1 ;
110eval{substr($a, 7,-3) = "" ; }; # P Q S Q
111ok 49, $@ =~ /$FATAL_MSG/;
112$b = substr($a, 7, 0) ; # warn # P S Q=R
113ok 50, $w-- == 1 ;
114eval{substr($a, 7, 0) = "" ; }; # P S Q=R
115ok 51, $@ =~ /$FATAL_MSG/;
116
117ok 52, substr($a,-7,2) eq ''; # Q P=R S
118ok 53, substr($a,-7,4) eq '54'; # Q P R S
119ok 54, substr($a,-7,7) eq '54321';# Q P R=S
120ok 55, substr($a,-7,9) eq '54321';# Q P S R
121ok 56, substr($a,-5,0) eq ''; # P=Q=R S
122ok 57, substr($a,-5,3) eq '543';# P=Q R S
123ok 58, substr($a,-5,5) eq '54321';# P=Q R=S
124ok 59, substr($a,-5,7) eq '54321';# P=Q S R
125ok 60, substr($a,-3,0) eq ''; # P Q=R S
126ok 61, substr($a,-3,3) eq '321';# P Q R=S
127ok 62, substr($a,-2,3) eq '21'; # P Q S R
128ok 63, substr($a,0,-5) eq ''; # P=Q=R S
129ok 64, substr($a,2,-3) eq ''; # P Q=R S
130ok 65, substr($a,0,0) eq ''; # P=Q=R S
131ok 66, substr($a,0,5) eq '54321';# P=Q R=S
132ok 67, substr($a,0,7) eq '54321';# P=Q S R
133ok 68, substr($a,2,0) eq ''; # P Q=R S
134ok 69, substr($a,2,3) eq '321'; # P Q R=S
135ok 70, substr($a,5,0) eq ''; # P Q=R=S
136ok 71, substr($a,5,2) eq ''; # P Q=S R
137ok 72, substr($a,-7,-5) eq ''; # Q P=R S
138ok 73, substr($a,-7,-2) eq '543';# Q P R S
139ok 74, substr($a,-5,-5) eq ''; # P=Q=R S
140ok 75, substr($a,-5,-2) eq '543';# P=Q R S
141ok 76, substr($a,-3,-3) eq ''; # P Q=R S
142ok 77, substr($a,-3,-1) eq '32';# P Q R S
84902520
TB
143
144$a = '';
145
e476b1b5
GS
146ok 78, substr($a,-2,2) eq ''; # Q P=R=S
147ok 79, substr($a,0,0) eq ''; # P=Q=R=S
148ok 80, substr($a,0,1) eq ''; # P=Q=S R
149ok 81, substr($a,-2,3) eq ''; # Q P=S R
150ok 82, substr($a,-2) eq ''; # Q P=R=S
151ok 83, substr($a,0) eq ''; # P=Q=R=S
152
153
154ok 84, substr($a,0,-1) eq ''; # R P=Q=S
155$b = substr($a,-2, 0) ; # warn # Q=R P=S
156ok 85, $w-- == 1 ;
157eval{substr($a,-2, 0) = "" ; }; # Q=R P=S
158ok 86, $@ =~ /$FATAL_MSG/;
84902520 159
e476b1b5
GS
160$b = substr($a,-2, 1) ; # warn # Q R P=S
161ok 87, $w-- == 1 ;
162eval{substr($a,-2, 1) = "" ; }; # Q R P=S
163ok 88, $@ =~ /$FATAL_MSG/;
84902520 164
e476b1b5
GS
165$b = substr($a,-2,-1) ; # warn # Q R P=S
166ok 89, $w-- == 1 ;
167eval{substr($a,-2,-1) = "" ; }; # Q R P=S
168ok 90, $@ =~ /$FATAL_MSG/;
84902520 169
e476b1b5
GS
170$b = substr($a,-2,-2) ; # warn # Q=R P=S
171ok 91, $w-- == 1 ;
172eval{substr($a,-2,-2) = "" ; }; # Q=R P=S
173ok 92, $@ =~ /$FATAL_MSG/;
174
175$b = substr($a, 1,-2) ; # warn # R P=S Q
176ok 93, $w-- == 1 ;
177eval{substr($a, 1,-2) = "" ; }; # R P=S Q
178ok 94, $@ =~ /$FATAL_MSG/;
179
180$b = substr($a, 1, 1) ; # warn # P=S Q R
181ok 95, $w-- == 1 ;
182eval{substr($a, 1, 1) = "" ; }; # P=S Q R
183ok 96, $@ =~ /$FATAL_MSG/;
184
185$b = substr($a, 1, 0) ;# warn # P=S Q=R
186ok 97, $w-- == 1 ;
187eval{substr($a, 1, 0) = "" ; }; # P=S Q=R
188ok 98, $@ =~ /$FATAL_MSG/;
189
190$b = substr($a,1) ; # warning # P=R=S Q
191ok 99, $w-- == 1 ;
192eval{substr($a,1) = "" ; }; # P=R=S Q
193ok 100, $@ =~ /$FATAL_MSG/;
84902520
TB
194
195my $a = 'zxcvbnm';
196substr($a,2,0) = '';
e476b1b5 197ok 101, $a eq 'zxcvbnm';
84902520 198substr($a,7,0) = '';
e476b1b5 199ok 102, $a eq 'zxcvbnm';
84902520 200substr($a,5,0) = '';
e476b1b5 201ok 103, $a eq 'zxcvbnm';
84902520 202substr($a,0,2) = 'pq';
e476b1b5 203ok 104, $a eq 'pqcvbnm';
84902520 204substr($a,2,0) = 'r';
e476b1b5 205ok 105, $a eq 'pqrcvbnm';
84902520 206substr($a,8,0) = 'asd';
e476b1b5 207ok 106, $a eq 'pqrcvbnmasd';
84902520 208substr($a,0,2) = 'iop';
e476b1b5 209ok 107, $a eq 'ioprcvbnmasd';
84902520 210substr($a,0,5) = 'fgh';
e476b1b5 211ok 108, $a eq 'fghvbnmasd';
84902520 212substr($a,3,5) = 'jkl';
e476b1b5 213ok 109, $a eq 'fghjklsd';
84902520 214substr($a,3,2) = '1234';
e476b1b5 215ok 110, $a eq 'fgh1234lsd';
84902520 216
08cb0b0d
PP
217
218# with lexicals (and in re-entered scopes)
219for (0,1) {
220 my $txt;
221 unless ($_) {
222 $txt = "Foo";
223 substr($txt, -1) = "X";
e476b1b5 224 ok 111, $txt eq "FoX";
08cb0b0d
PP
225 }
226 else {
227 substr($txt, 0, 1) = "X";
e476b1b5 228 ok 112, $txt eq "X";
08cb0b0d
PP
229 }
230}
231
e476b1b5 232$w = 0 ;
84902520 233# coercion of references
08cb0b0d
PP
234{
235 my $s = [];
236 substr($s, 0, 1) = 'Foo';
e476b1b5 237 ok 113, substr($s,0,7) eq "FooRRAY" && !($w-=2);
08cb0b0d 238}
84902520
TB
239
240# check no spurious warnings
e476b1b5 241ok 114, $w == 0;
7b8d334a 242
5d82c453 243# check new 4 arg replacement syntax
7b8d334a 244$a = "abcxyz";
5d82c453 245$w = 0;
e476b1b5
GS
246ok 115, substr($a, 0, 3, "") eq "abc" && $a eq "xyz";
247ok 116, substr($a, 0, 0, "abc") eq "" && $a eq "abcxyz";
248ok 117, substr($a, 3, -1, "") eq "xy" && $a eq "abcz";
249
250ok 118, substr($a, 3, undef, "xy") eq "" && $a eq "abcxyz"
5d82c453 251 && $w == 3;
e476b1b5 252
5d82c453
GA
253$w = 0;
254
e476b1b5
GS
255ok 119, substr($a, 3, 9999999, "") eq "xyz" && $a eq "abc";
256eval{substr($a, -99, 0, "") };
257ok 120, $@ =~ /$FATAL_MSG/;
258eval{substr($a, 99, 3, "") };
259ok 121, $@ =~ /$FATAL_MSG/;
5d82c453
GA
260
261substr($a, 0, length($a), "foo");
e476b1b5 262ok 122, $a eq "foo" && !$w;
5d82c453
GA
263
264# using 4 arg substr as lvalue is a compile time error
265eval 'substr($a,0,0,"") = "abc"';
e476b1b5 266ok 123, $@ && $@ =~ /Can't modify substr/ && $a eq "foo";
c8faf1c5
GS
267
268$a = "abcdefgh";
e476b1b5
GS
269ok 124, sub { shift }->(substr($a, 0, 4, "xxxx")) eq 'abcd';
270ok 125, $a eq 'xxxxefgh';