1#!./perl 2 3BEGIN { 4 chdir 't' if -d 't'; 5 @INC = '../lib'; 6 require './test.pl'; 7} 8 9use strict; 10plan( tests => 69 ); 11 12my $foo = 'Now is the time for all good men to come to the aid of their country.'; 13 14my $first = substr($foo,0,index($foo,'the')); 15is($first, "Now is "); 16 17my $last = substr($foo,rindex($foo,'the'),100); 18is($last, "their country."); 19 20$last = substr($foo,index($foo,'Now'),2); 21is($last, "No"); 22 23$last = substr($foo,rindex($foo,'Now'),2); 24is($last, "No"); 25 26$last = substr($foo,index($foo,'.'),100); 27is($last, "."); 28 29$last = substr($foo,rindex($foo,'.'),100); 30is($last, "."); 31 32is(index("ababa","a",-1), 0); 33is(index("ababa","a",0), 0); 34is(index("ababa","a",1), 2); 35is(index("ababa","a",2), 2); 36is(index("ababa","a",3), 4); 37is(index("ababa","a",4), 4); 38is(index("ababa","a",5), -1); 39 40is(rindex("ababa","a",-1), -1); 41is(rindex("ababa","a",0), 0); 42is(rindex("ababa","a",1), 0); 43is(rindex("ababa","a",2), 2); 44is(rindex("ababa","a",3), 2); 45is(rindex("ababa","a",4), 4); 46is(rindex("ababa","a",5), 4); 47 48# tests for empty search string 49is(index("abc", "", -1), 0); 50is(index("abc", "", 0), 0); 51is(index("abc", "", 1), 1); 52is(index("abc", "", 2), 2); 53is(index("abc", "", 3), 3); 54is(index("abc", "", 4), 3); 55is(rindex("abc", "", -1), 0); 56is(rindex("abc", "", 0), 0); 57is(rindex("abc", "", 1), 1); 58is(rindex("abc", "", 2), 2); 59is(rindex("abc", "", 3), 3); 60is(rindex("abc", "", 4), 3); 61 62$a = "foo \x{1234}bar"; 63 64is(index($a, "\x{1234}"), 4); 65is(index($a, "bar", ), 5); 66 67is(rindex($a, "\x{1234}"), 4); 68is(rindex($a, "foo", ), 0); 69 70{ 71 my $needle = "\x{1230}\x{1270}"; 72 my @needles = split ( //, $needle ); 73 my $haystack = "\x{1228}\x{1228}\x{1230}\x{1270}"; 74 foreach ( @needles ) { 75 my $a = index ( "\x{1228}\x{1228}\x{1230}\x{1270}", $_ ); 76 my $b = index ( $haystack, $_ ); 77 is($a, $b, q{[perl #22375] 'split'/'index' problem for utf8}); 78 } 79 $needle = "\x{1270}\x{1230}"; # Transpose them. 80 @needles = split ( //, $needle ); 81 foreach ( @needles ) { 82 my $a = index ( "\x{1228}\x{1228}\x{1230}\x{1270}", $_ ); 83 my $b = index ( $haystack, $_ ); 84 is($a, $b, q{[perl #22375] 'split'/'index' problem for utf8}); 85 } 86} 87 88{ 89 my $search; 90 my $text; 91 if (ord('A') == 193) { 92 $search = "foo \x71 bar"; 93 $text = "a\xb1\xb1a $search $search quux"; 94 } else { 95 $search = "foo \xc9 bar"; 96 $text = "a\xa3\xa3a $search $search quux"; 97 } 98 99 my $text_utf8 = $text; 100 utf8::upgrade($text_utf8); 101 my $search_utf8 = $search; 102 utf8::upgrade($search_utf8); 103 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); 112 113 my $text_octets = $text_utf8; 114 utf8::encode ($text_octets); 115 my $search_octets = $search_utf8; 116 utf8::encode ($search_octets); 117 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); 125 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); 130} 131 132foreach my $utf8 ('', ', utf-8') { 133 foreach my $arraybase (0, 1, -1, -2) { 134 my $expect_pos = 2 + $arraybase; 135 136 my $prog = "\$[ = $arraybase; \$big = \"N\\xabN\\xab\"; "; 137 $prog .= '$big .= chr 256; chop $big; ' if $utf8; 138 $prog .= 'print rindex $big, "N", 2 + $['; 139 140 fresh_perl_is($prog, $expect_pos, {}, "\$[ = $arraybase$utf8"); 141 } 142} 143 144SKIP: { 145 skip "UTF-EBCDIC is limited to 0x7fffffff", 3 if ord("A") == 193; 146 147 my $a = "\x{80000000}"; 148 my $s = $a.'defxyz'; 149 is(index($s, 'def'), 1, "0x80000000 is a single character"); 150 151 my $b = "\x{fffffffd}"; 152 my $t = $b.'pqrxyz'; 153 is(index($t, 'pqr'), 1, "0xfffffffd is a single character"); 154 155 local ${^UTF8CACHE} = -1; 156 is(index($t, 'xyz'), 4, "0xfffffffd and utf8cache"); 157} 158