7 require './charset_tools.pl';
13 run_tests() unless caller;
17 my $foo = 'Now is the time for all good men to come to the aid of their country.';
19 my $first = substr($foo,0,index($foo,'the'));
20 is($first, "Now is ");
22 my $last = substr($foo,rindex($foo,'the'),100);
23 is($last, "their country.");
25 $last = substr($foo,index($foo,'Now'),2);
28 $last = substr($foo,rindex($foo,'Now'),2);
31 $last = substr($foo,index($foo,'.'),100);
34 $last = substr($foo,rindex($foo,'.'),100);
37 is(index("ababa","a",-1), 0);
38 is(index("ababa","a",0), 0);
39 is(index("ababa","a",1), 2);
40 is(index("ababa","a",2), 2);
41 is(index("ababa","a",3), 4);
42 is(index("ababa","a",4), 4);
43 is(index("ababa","a",5), -1);
45 is(rindex("ababa","a",-1), -1);
46 is(rindex("ababa","a",0), 0);
47 is(rindex("ababa","a",1), 0);
48 is(rindex("ababa","a",2), 2);
49 is(rindex("ababa","a",3), 2);
50 is(rindex("ababa","a",4), 4);
51 is(rindex("ababa","a",5), 4);
53 # tests for empty search string
54 is(index("abc", "", -1), 0);
55 is(index("abc", "", 0), 0);
56 is(index("abc", "", 1), 1);
57 is(index("abc", "", 2), 2);
58 is(index("abc", "", 3), 3);
59 is(index("abc", "", 4), 3);
60 is(rindex("abc", "", -1), 0);
61 is(rindex("abc", "", 0), 0);
62 is(rindex("abc", "", 1), 1);
63 is(rindex("abc", "", 2), 2);
64 is(rindex("abc", "", 3), 3);
65 is(rindex("abc", "", 4), 3);
67 $a = "foo \x{1234}bar";
69 is(index($a, "\x{1234}"), 4);
70 is(index($a, "bar", ), 5);
72 is(rindex($a, "\x{1234}"), 4);
73 is(rindex($a, "foo", ), 0);
76 my $needle = "\x{1230}\x{1270}";
77 my @needles = split ( //, $needle );
78 my $haystack = "\x{1228}\x{1228}\x{1230}\x{1270}";
79 foreach ( @needles ) {
80 my $a = index ( "\x{1228}\x{1228}\x{1230}\x{1270}", $_ );
81 my $b = index ( $haystack, $_ );
82 is($a, $b, q{[perl #22375] 'split'/'index' problem for utf8});
84 $needle = "\x{1270}\x{1230}"; # Transpose them.
85 @needles = split ( //, $needle );
86 foreach ( @needles ) {
87 my $a = index ( "\x{1228}\x{1228}\x{1230}\x{1270}", $_ );
88 my $b = index ( $haystack, $_ );
89 is($a, $b, q{[perl #22375] 'split'/'index' problem for utf8});
96 $search = "foo " . uni_to_native("\xc9") . " bar";
97 $text = "a" . uni_to_native("\xa3\xa3") . "a $search $search quux";
99 my $text_utf8 = $text;
100 utf8::upgrade($text_utf8);
101 my $search_utf8 = $search;
102 utf8::upgrade($search_utf8);
104 is (index($text, $search), 5);
105 is (rindex($text, $search), 18);
106 is (index($text, $search_utf8), 5);
107 is (rindex($text, $search_utf8), 18);
108 is (index($text_utf8, $search), 5);
109 is (rindex($text_utf8, $search), 18);
110 is (index($text_utf8, $search_utf8), 5);
111 is (rindex($text_utf8, $search_utf8), 18);
113 my $text_octets = $text_utf8;
114 utf8::encode ($text_octets);
115 my $search_octets = $search_utf8;
116 utf8::encode ($search_octets);
118 is (index($text_octets, $search_octets), 7, "index octets, octets")
119 or _diag ($text_octets, $search_octets);
120 is (rindex($text_octets, $search_octets), 21, "rindex octets, octets");
121 is (index($text_octets, $search_utf8), -1);
122 is (rindex($text_octets, $search_utf8), -1);
123 is (index($text_utf8, $search_octets), -1);
124 is (rindex($text_utf8, $search_octets), -1);
126 is (index($text_octets, $search), -1);
127 is (rindex($text_octets, $search), -1);
128 is (index($text, $search_octets), -1);
129 is (rindex($text, $search_octets), -1);
133 my $a = eval q{"\x{7fffffff}"};
135 is(index($s, 'def'), 1, "0x7fffffff is a single character");
137 my $b = eval q{"\x{7ffffffd}"};
139 is(index($t, 'pqr'), 1, "0x7ffffffd is a single character");
141 local ${^UTF8CACHE} = -1;
142 is(index($t, 'xyz'), 4, "0x7ffffffd and utf8cache");
146 # Tests for NUL characters.
154 ["foo\0", 3, -1, -1],
155 ["foo\0foo\0\0", 3, 7, -1],
157 foreach my $l (1 .. 3) {
160 foreach my $test (@tests) {
162 my $str = $$test [0];
163 my $res = $$test [$l];
166 is (index ($str, $q), $res, "Find NUL character(s)");
170 # Bug #53746 shows a difference between variables and literals,
171 # so test literals as well.
173 my $test_str = qq {is (index ("$str", "$q"), $res, } .
174 qq {"Find NUL character(s)")};
175 $test_str =~ s/\0/\\0/g;
185 is(eval { utf8::upgrade($_ = " "); index $_, " ", 72 }, -1,
186 'UTF-8 cache handles offset beyond the end of the string');
188 is(index($_, "C", 4), -1,
189 'UTF-8 cache handles offset beyond the end of the string');
193 use constant {PVBM => 'galumphing', PVBM2 => 'bang'};
196 is(index('galumphing', PVBM), 0,
197 "index isn't confused by format compilation");
201 is($^A, '', '$^A is empty');
203 is($^A, 'galumphing', "formline isn't confused by index compilation");
207 # must not do index here before formline.
208 is($^A, '', '$^A is empty');
210 is($^A, 'bang', "formline isn't confused by index compilation");
211 is(index('bang', PVBM2), 0, "index isn't confused by format compilation");
214 use constant perl => "rules";
215 is(index("perl rules", perl), 5, 'first index of a constant works');
216 is(index("rules 1 & 2", perl), 0, 'second index of the same constant works');
219 # PVBM compilation should not flatten ref constants
220 use constant riffraff => \our $referent;
221 index "foo", riffraff;
222 is ref riffraff, 'SCALAR', 'index does not flatten ref constants';
224 package o { use overload '""' => sub { "foo" } }
225 bless \our $referent, o::;
226 is index("foo", riffraff), 0,
227 'index respects changes in ref stringification';
229 use constant quire => ${qr/(?{})/}; # A REGEXP, not a reference to one
231 eval ' "" =~ quire ';
232 is $@, "", 'regexp constants containing code blocks are not flattened';
234 use constant bang => $! = 8;
236 cmp_ok bang, '==', 8, 'dualvar constants are not flattened';
238 use constant u => undef;
241 local $SIG{__WARN__} = sub { $w .= shift };
244 sub { () = index "foo", u; }
246 is $w, undef, 'no warnings from compiling index($foo, undef_constant)';
248 is u, undef, 'undef constant is still undef';
250 is index('the main road', __PACKAGE__), 4,
251 '[perl #119169] __PACKAGE__ as 2nd argument';
253 } # end of sub run_tests
255 utf8::upgrade my $substr = "\x{a3}a";
257 is index($substr, 'a'), 1, 'index reply reflects characters not octets';