1#!./perl -w 2 3#P = start of string Q = start of substr R = end of substr S = end of string 4 5BEGIN { 6 chdir 't' if -d 't'; 7 @INC = '../lib'; 8} 9use warnings ; 10 11$a = 'abcdefxyz'; 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; 17 } elsif ($_[0] =~ /^Use of uninitialized value/) { 18 $w += 3; 19 } else { 20 warn $_[0]; 21 } 22}; 23 24require './test.pl'; 25 26plan(334); 27 28$FATAL_MSG = qr/^substr outside of string/; 29 30is(substr($a,0,3), 'abc'); # P=Q R S 31is(substr($a,3,3), 'def'); # P Q R S 32is(substr($a,6,999), 'xyz'); # P Q S R 33$b = substr($a,999,999) ; # warn # P R Q S 34is ($w--, 1); 35eval{substr($a,999,999) = "" ; };# P R Q S 36like ($@, $FATAL_MSG); 37is(substr($a,0,-6), 'abc'); # P=Q R S 38is(substr($a,-3,1), 'x'); # P Q R S 39 40$[ = 1; 41 42is(substr($a,1,3), 'abc' ); # P=Q R S 43is(substr($a,4,3), 'def' ); # P Q R S 44is(substr($a,7,999), 'xyz');# P Q S R 45$b = substr($a,999,999) ; # warn # P R Q S 46is($w--, 1); 47eval{substr($a,999,999) = "" ; } ; # P R Q S 48like ($@, $FATAL_MSG); 49is(substr($a,1,-6), 'abc' );# P=Q R S 50is(substr($a,-3,1), 'x' ); # P Q R S 51 52$[ = 0; 53 54substr($a,3,3) = 'XYZ'; 55is($a, 'abcXYZxyz' ); 56substr($a,0,2) = ''; 57is($a, 'cXYZxyz' ); 58substr($a,0,0) = 'ab'; 59is($a, 'abcXYZxyz' ); 60substr($a,0,0) = '12345678'; 61is($a, '12345678abcXYZxyz' ); 62substr($a,-3,3) = 'def'; 63is($a, '12345678abcXYZdef'); 64substr($a,-3,3) = '<'; 65is($a, '12345678abcXYZ<' ); 66substr($a,-1,1) = '12345678'; 67is($a, '12345678abcXYZ12345678' ); 68 69$a = 'abcdefxyz'; 70 71is(substr($a,6), 'xyz' ); # P Q R=S 72is(substr($a,-3), 'xyz' ); # P Q R=S 73$b = substr($a,999,999) ; # warning # P R=S Q 74is($w--, 1); 75eval{substr($a,999,999) = "" ; } ; # P R=S Q 76like($@, $FATAL_MSG); 77is(substr($a,0), 'abcdefxyz'); # P=Q R=S 78is(substr($a,9), ''); # P Q=R=S 79is(substr($a,-11), 'abcdefxyz'); # Q P R=S 80is(substr($a,-9), 'abcdefxyz'); # P=Q R=S 81 82$a = '54321'; 83 84$b = substr($a,-7, 1) ; # warn # Q R P S 85is($w--, 1); 86eval{substr($a,-7, 1) = "" ; }; # Q R P S 87like($@, $FATAL_MSG); 88$b = substr($a,-7,-6) ; # warn # Q R P S 89is($w--, 1); 90eval{substr($a,-7,-6) = "" ; }; # Q R P S 91like($@, $FATAL_MSG); 92is(substr($a,-5,-7), ''); # R P=Q S 93is(substr($a, 2,-7), ''); # R P Q S 94is(substr($a,-3,-7), ''); # R P Q S 95is(substr($a, 2,-5), ''); # P=R Q S 96is(substr($a,-3,-5), ''); # P=R Q S 97is(substr($a, 2,-4), ''); # P R Q S 98is(substr($a,-3,-4), ''); # P R Q S 99is(substr($a, 5,-6), ''); # R P Q=S 100is(substr($a, 5,-5), ''); # P=R Q S 101is(substr($a, 5,-3), ''); # P R Q=S 102$b = substr($a, 7,-7) ; # warn # R P S Q 103is($w--, 1); 104eval{substr($a, 7,-7) = "" ; }; # R P S Q 105like($@, $FATAL_MSG); 106$b = substr($a, 7,-5) ; # warn # P=R S Q 107is($w--, 1); 108eval{substr($a, 7,-5) = "" ; }; # P=R S Q 109like($@, $FATAL_MSG); 110$b = substr($a, 7,-3) ; # warn # P Q S Q 111is($w--, 1); 112eval{substr($a, 7,-3) = "" ; }; # P Q S Q 113like($@, $FATAL_MSG); 114$b = substr($a, 7, 0) ; # warn # P S Q=R 115is($w--, 1); 116eval{substr($a, 7, 0) = "" ; }; # P S Q=R 117like($@, $FATAL_MSG); 118 119is(substr($a,-7,2), ''); # Q P=R S 120is(substr($a,-7,4), '54'); # Q P R S 121is(substr($a,-7,7), '54321');# Q P R=S 122is(substr($a,-7,9), '54321');# Q P S R 123is(substr($a,-5,0), ''); # P=Q=R S 124is(substr($a,-5,3), '543');# P=Q R S 125is(substr($a,-5,5), '54321');# P=Q R=S 126is(substr($a,-5,7), '54321');# P=Q S R 127is(substr($a,-3,0), ''); # P Q=R S 128is(substr($a,-3,3), '321');# P Q R=S 129is(substr($a,-2,3), '21'); # P Q S R 130is(substr($a,0,-5), ''); # P=Q=R S 131is(substr($a,2,-3), ''); # P Q=R S 132is(substr($a,0,0), ''); # P=Q=R S 133is(substr($a,0,5), '54321');# P=Q R=S 134is(substr($a,0,7), '54321');# P=Q S R 135is(substr($a,2,0), ''); # P Q=R S 136is(substr($a,2,3), '321'); # P Q R=S 137is(substr($a,5,0), ''); # P Q=R=S 138is(substr($a,5,2), ''); # P Q=S R 139is(substr($a,-7,-5), ''); # Q P=R S 140is(substr($a,-7,-2), '543');# Q P R S 141is(substr($a,-5,-5), ''); # P=Q=R S 142is(substr($a,-5,-2), '543');# P=Q R S 143is(substr($a,-3,-3), ''); # P Q=R S 144is(substr($a,-3,-1), '32');# P Q R S 145 146$a = ''; 147 148is(substr($a,-2,2), ''); # Q P=R=S 149is(substr($a,0,0), ''); # P=Q=R=S 150is(substr($a,0,1), ''); # P=Q=S R 151is(substr($a,-2,3), ''); # Q P=S R 152is(substr($a,-2), ''); # Q P=R=S 153is(substr($a,0), ''); # P=Q=R=S 154 155 156is(substr($a,0,-1), ''); # R P=Q=S 157$b = substr($a,-2, 0) ; # warn # Q=R P=S 158is($w--, 1); 159eval{substr($a,-2, 0) = "" ; }; # Q=R P=S 160like($@, $FATAL_MSG); 161 162$b = substr($a,-2, 1) ; # warn # Q R P=S 163is($w--, 1); 164eval{substr($a,-2, 1) = "" ; }; # Q R P=S 165like($@, $FATAL_MSG); 166 167$b = substr($a,-2,-1) ; # warn # Q R P=S 168is($w--, 1); 169eval{substr($a,-2,-1) = "" ; }; # Q R P=S 170like($@, $FATAL_MSG); 171 172$b = substr($a,-2,-2) ; # warn # Q=R P=S 173is($w--, 1); 174eval{substr($a,-2,-2) = "" ; }; # Q=R P=S 175like($@, $FATAL_MSG); 176 177$b = substr($a, 1,-2) ; # warn # R P=S Q 178is($w--, 1); 179eval{substr($a, 1,-2) = "" ; }; # R P=S Q 180like($@, $FATAL_MSG); 181 182$b = substr($a, 1, 1) ; # warn # P=S Q R 183is($w--, 1); 184eval{substr($a, 1, 1) = "" ; }; # P=S Q R 185like($@, $FATAL_MSG); 186 187$b = substr($a, 1, 0) ;# warn # P=S Q=R 188is($w--, 1); 189eval{substr($a, 1, 0) = "" ; }; # P=S Q=R 190like($@, $FATAL_MSG); 191 192$b = substr($a,1) ; # warning # P=R=S Q 193is($w--, 1); 194eval{substr($a,1) = "" ; }; # P=R=S Q 195like($@, $FATAL_MSG); 196 197my $a = 'zxcvbnm'; 198substr($a,2,0) = ''; 199is($a, 'zxcvbnm'); 200substr($a,7,0) = ''; 201is($a, 'zxcvbnm'); 202substr($a,5,0) = ''; 203is($a, 'zxcvbnm'); 204substr($a,0,2) = 'pq'; 205is($a, 'pqcvbnm'); 206substr($a,2,0) = 'r'; 207is($a, 'pqrcvbnm'); 208substr($a,8,0) = 'asd'; 209is($a, 'pqrcvbnmasd'); 210substr($a,0,2) = 'iop'; 211is($a, 'ioprcvbnmasd'); 212substr($a,0,5) = 'fgh'; 213is($a, 'fghvbnmasd'); 214substr($a,3,5) = 'jkl'; 215is($a, 'fghjklsd'); 216substr($a,3,2) = '1234'; 217is($a, 'fgh1234lsd'); 218 219 220# with lexicals (and in re-entered scopes) 221for (0,1) { 222 my $txt; 223 unless ($_) { 224 $txt = "Foo"; 225 substr($txt, -1) = "X"; 226 is($txt, "FoX"); 227 } 228 else { 229 substr($txt, 0, 1) = "X"; 230 is($txt, "X"); 231 } 232} 233 234$w = 0 ; 235# coercion of references 236{ 237 my $s = []; 238 substr($s, 0, 1) = 'Foo'; 239 is (substr($s,0,7), "FooRRAY"); 240 is ($w,2); 241 $w = 0; 242} 243 244# check no spurious warnings 245is($w, 0); 246 247# check new 4 arg replacement syntax 248$a = "abcxyz"; 249$w = 0; 250is(substr($a, 0, 3, ""), "abc"); 251is($a, "xyz"); 252is(substr($a, 0, 0, "abc"), ""); 253is($a, "abcxyz"); 254is(substr($a, 3, -1, ""), "xy"); 255is($a, "abcz"); 256 257is(substr($a, 3, undef, "xy"), ""); 258is($a, "abcxyz"); 259is($w, 3); 260 261$w = 0; 262 263is(substr($a, 3, 9999999, ""), "xyz"); 264is($a, "abc"); 265eval{substr($a, -99, 0, "") }; 266like($@, $FATAL_MSG); 267eval{substr($a, 99, 3, "") }; 268like($@, $FATAL_MSG); 269 270substr($a, 0, length($a), "foo"); 271is ($a, "foo"); 272is ($w, 0); 273 274# using 4 arg substr as lvalue is a compile time error 275eval 'substr($a,0,0,"") = "abc"'; 276like ($@, qr/Can't modify substr/); 277is ($a, "foo"); 278 279$a = "abcdefgh"; 280is(sub { shift }->(substr($a, 0, 4, "xxxx")), 'abcd'); 281is($a, 'xxxxefgh'); 282 283{ 284 my $y = 10; 285 $y = "2" . $y; 286 is ($y, 210); 287} 288 289# utf8 sanity 290{ 291 my $x = substr("a\x{263a}b",0); 292 is(length($x), 3); 293 $x = substr($x,1,1); 294 is($x, "\x{263a}"); 295 $x = $x x 2; 296 is(length($x), 2); 297 substr($x,0,1) = "abcd"; 298 is($x, "abcd\x{263a}"); 299 is(length($x), 5); 300 $x = reverse $x; 301 is(length($x), 5); 302 is($x, "\x{263a}dcba"); 303 304 my $z = 10; 305 $z = "21\x{263a}" . $z; 306 is(length($z), 5); 307 is($z, "21\x{263a}10"); 308} 309 310# replacement should work on magical values 311require Tie::Scalar; 312my %data; 313tie $data{'a'}, 'Tie::StdScalar'; # makes $data{'a'} magical 314$data{a} = "firstlast"; 315is(substr($data{'a'}, 0, 5, ""), "first"); 316is($data{'a'}, "last"); 317 318# more utf8 319 320# The following two originally from Ignasi Roca. 321 322$x = "\xF1\xF2\xF3"; 323substr($x, 0, 1) = "\x{100}"; # Ignasi had \x{FF} 324is(length($x), 3); 325is($x, "\x{100}\xF2\xF3"); 326is(substr($x, 0, 1), "\x{100}"); 327is(substr($x, 1, 1), "\x{F2}"); 328is(substr($x, 2, 1), "\x{F3}"); 329 330$x = "\xF1\xF2\xF3"; 331substr($x, 0, 1) = "\x{100}\x{FF}"; # Ignasi had \x{FF} 332is(length($x), 4); 333is($x, "\x{100}\x{FF}\xF2\xF3"); 334is(substr($x, 0, 1), "\x{100}"); 335is(substr($x, 1, 1), "\x{FF}"); 336is(substr($x, 2, 1), "\x{F2}"); 337is(substr($x, 3, 1), "\x{F3}"); 338 339# more utf8 lval exercise 340 341$x = "\xF1\xF2\xF3"; 342substr($x, 0, 2) = "\x{100}\xFF"; 343is(length($x), 3); 344is($x, "\x{100}\xFF\xF3"); 345is(substr($x, 0, 1), "\x{100}"); 346is(substr($x, 1, 1), "\x{FF}"); 347is(substr($x, 2, 1), "\x{F3}"); 348 349$x = "\xF1\xF2\xF3"; 350substr($x, 1, 1) = "\x{100}\xFF"; 351is(length($x), 4); 352is($x, "\xF1\x{100}\xFF\xF3"); 353is(substr($x, 0, 1), "\x{F1}"); 354is(substr($x, 1, 1), "\x{100}"); 355is(substr($x, 2, 1), "\x{FF}"); 356is(substr($x, 3, 1), "\x{F3}"); 357 358$x = "\xF1\xF2\xF3"; 359substr($x, 2, 1) = "\x{100}\xFF"; 360is(length($x), 4); 361is($x, "\xF1\xF2\x{100}\xFF"); 362is(substr($x, 0, 1), "\x{F1}"); 363is(substr($x, 1, 1), "\x{F2}"); 364is(substr($x, 2, 1), "\x{100}"); 365is(substr($x, 3, 1), "\x{FF}"); 366 367$x = "\xF1\xF2\xF3"; 368substr($x, 3, 1) = "\x{100}\xFF"; 369is(length($x), 5); 370is($x, "\xF1\xF2\xF3\x{100}\xFF"); 371is(substr($x, 0, 1), "\x{F1}"); 372is(substr($x, 1, 1), "\x{F2}"); 373is(substr($x, 2, 1), "\x{F3}"); 374is(substr($x, 3, 1), "\x{100}"); 375is(substr($x, 4, 1), "\x{FF}"); 376 377$x = "\xF1\xF2\xF3"; 378substr($x, -1, 1) = "\x{100}\xFF"; 379is(length($x), 4); 380is($x, "\xF1\xF2\x{100}\xFF"); 381is(substr($x, 0, 1), "\x{F1}"); 382is(substr($x, 1, 1), "\x{F2}"); 383is(substr($x, 2, 1), "\x{100}"); 384is(substr($x, 3, 1), "\x{FF}"); 385 386$x = "\xF1\xF2\xF3"; 387substr($x, -1, 0) = "\x{100}\xFF"; 388is(length($x), 5); 389is($x, "\xF1\xF2\x{100}\xFF\xF3"); 390is(substr($x, 0, 1), "\x{F1}"); 391is(substr($x, 1, 1), "\x{F2}"); 392is(substr($x, 2, 1), "\x{100}"); 393is(substr($x, 3, 1), "\x{FF}"); 394is(substr($x, 4, 1), "\x{F3}"); 395 396$x = "\xF1\xF2\xF3"; 397substr($x, 0, -1) = "\x{100}\xFF"; 398is(length($x), 3); 399is($x, "\x{100}\xFF\xF3"); 400is(substr($x, 0, 1), "\x{100}"); 401is(substr($x, 1, 1), "\x{FF}"); 402is(substr($x, 2, 1), "\x{F3}"); 403 404$x = "\xF1\xF2\xF3"; 405substr($x, 0, -2) = "\x{100}\xFF"; 406is(length($x), 4); 407is($x, "\x{100}\xFF\xF2\xF3"); 408is(substr($x, 0, 1), "\x{100}"); 409is(substr($x, 1, 1), "\x{FF}"); 410is(substr($x, 2, 1), "\x{F2}"); 411is(substr($x, 3, 1), "\x{F3}"); 412 413$x = "\xF1\xF2\xF3"; 414substr($x, 0, -3) = "\x{100}\xFF"; 415is(length($x), 5); 416is($x, "\x{100}\xFF\xF1\xF2\xF3"); 417is(substr($x, 0, 1), "\x{100}"); 418is(substr($x, 1, 1), "\x{FF}"); 419is(substr($x, 2, 1), "\x{F1}"); 420is(substr($x, 3, 1), "\x{F2}"); 421is(substr($x, 4, 1), "\x{F3}"); 422 423$x = "\xF1\xF2\xF3"; 424substr($x, 1, -1) = "\x{100}\xFF"; 425is(length($x), 4); 426is($x, "\xF1\x{100}\xFF\xF3"); 427is(substr($x, 0, 1), "\x{F1}"); 428is(substr($x, 1, 1), "\x{100}"); 429is(substr($x, 2, 1), "\x{FF}"); 430is(substr($x, 3, 1), "\x{F3}"); 431 432$x = "\xF1\xF2\xF3"; 433substr($x, -1, -1) = "\x{100}\xFF"; 434is(length($x), 5); 435is($x, "\xF1\xF2\x{100}\xFF\xF3"); 436is(substr($x, 0, 1), "\x{F1}"); 437is(substr($x, 1, 1), "\x{F2}"); 438is(substr($x, 2, 1), "\x{100}"); 439is(substr($x, 3, 1), "\x{FF}"); 440is(substr($x, 4, 1), "\x{F3}"); 441 442# And tests for already-UTF8 one 443 444$x = "\x{101}\x{F2}\x{F3}"; 445substr($x, 0, 1) = "\x{100}"; 446is(length($x), 3); 447is($x, "\x{100}\xF2\xF3"); 448is(substr($x, 0, 1), "\x{100}"); 449is(substr($x, 1, 1), "\x{F2}"); 450is(substr($x, 2, 1), "\x{F3}"); 451 452$x = "\x{101}\x{F2}\x{F3}"; 453substr($x, 0, 1) = "\x{100}\x{FF}"; 454is(length($x), 4); 455is($x, "\x{100}\x{FF}\xF2\xF3"); 456is(substr($x, 0, 1), "\x{100}"); 457is(substr($x, 1, 1), "\x{FF}"); 458is(substr($x, 2, 1), "\x{F2}"); 459is(substr($x, 3, 1), "\x{F3}"); 460 461$x = "\x{101}\x{F2}\x{F3}"; 462substr($x, 0, 2) = "\x{100}\xFF"; 463is(length($x), 3); 464is($x, "\x{100}\xFF\xF3"); 465is(substr($x, 0, 1), "\x{100}"); 466is(substr($x, 1, 1), "\x{FF}"); 467is(substr($x, 2, 1), "\x{F3}"); 468 469$x = "\x{101}\x{F2}\x{F3}"; 470substr($x, 1, 1) = "\x{100}\xFF"; 471is(length($x), 4); 472is($x, "\x{101}\x{100}\xFF\xF3"); 473is(substr($x, 0, 1), "\x{101}"); 474is(substr($x, 1, 1), "\x{100}"); 475is(substr($x, 2, 1), "\x{FF}"); 476is(substr($x, 3, 1), "\x{F3}"); 477 478$x = "\x{101}\x{F2}\x{F3}"; 479substr($x, 2, 1) = "\x{100}\xFF"; 480is(length($x), 4); 481is($x, "\x{101}\xF2\x{100}\xFF"); 482is(substr($x, 0, 1), "\x{101}"); 483is(substr($x, 1, 1), "\x{F2}"); 484is(substr($x, 2, 1), "\x{100}"); 485is(substr($x, 3, 1), "\x{FF}"); 486 487$x = "\x{101}\x{F2}\x{F3}"; 488substr($x, 3, 1) = "\x{100}\xFF"; 489is(length($x), 5); 490is($x, "\x{101}\x{F2}\x{F3}\x{100}\xFF"); 491is(substr($x, 0, 1), "\x{101}"); 492is(substr($x, 1, 1), "\x{F2}"); 493is(substr($x, 2, 1), "\x{F3}"); 494is(substr($x, 3, 1), "\x{100}"); 495is(substr($x, 4, 1), "\x{FF}"); 496 497$x = "\x{101}\x{F2}\x{F3}"; 498substr($x, -1, 1) = "\x{100}\xFF"; 499is(length($x), 4); 500is($x, "\x{101}\xF2\x{100}\xFF"); 501is(substr($x, 0, 1), "\x{101}"); 502is(substr($x, 1, 1), "\x{F2}"); 503is(substr($x, 2, 1), "\x{100}"); 504is(substr($x, 3, 1), "\x{FF}"); 505 506$x = "\x{101}\x{F2}\x{F3}"; 507substr($x, -1, 0) = "\x{100}\xFF"; 508is(length($x), 5); 509is($x, "\x{101}\xF2\x{100}\xFF\xF3"); 510is(substr($x, 0, 1), "\x{101}"); 511is(substr($x, 1, 1), "\x{F2}"); 512is(substr($x, 2, 1), "\x{100}"); 513is(substr($x, 3, 1), "\x{FF}"); 514is(substr($x, 4, 1), "\x{F3}"); 515 516$x = "\x{101}\x{F2}\x{F3}"; 517substr($x, 0, -1) = "\x{100}\xFF"; 518is(length($x), 3); 519is($x, "\x{100}\xFF\xF3"); 520is(substr($x, 0, 1), "\x{100}"); 521is(substr($x, 1, 1), "\x{FF}"); 522is(substr($x, 2, 1), "\x{F3}"); 523 524$x = "\x{101}\x{F2}\x{F3}"; 525substr($x, 0, -2) = "\x{100}\xFF"; 526is(length($x), 4); 527is($x, "\x{100}\xFF\xF2\xF3"); 528is(substr($x, 0, 1), "\x{100}"); 529is(substr($x, 1, 1), "\x{FF}"); 530is(substr($x, 2, 1), "\x{F2}"); 531is(substr($x, 3, 1), "\x{F3}"); 532 533$x = "\x{101}\x{F2}\x{F3}"; 534substr($x, 0, -3) = "\x{100}\xFF"; 535is(length($x), 5); 536is($x, "\x{100}\xFF\x{101}\x{F2}\x{F3}"); 537is(substr($x, 0, 1), "\x{100}"); 538is(substr($x, 1, 1), "\x{FF}"); 539is(substr($x, 2, 1), "\x{101}"); 540is(substr($x, 3, 1), "\x{F2}"); 541is(substr($x, 4, 1), "\x{F3}"); 542 543$x = "\x{101}\x{F2}\x{F3}"; 544substr($x, 1, -1) = "\x{100}\xFF"; 545is(length($x), 4); 546is($x, "\x{101}\x{100}\xFF\xF3"); 547is(substr($x, 0, 1), "\x{101}"); 548is(substr($x, 1, 1), "\x{100}"); 549is(substr($x, 2, 1), "\x{FF}"); 550is(substr($x, 3, 1), "\x{F3}"); 551 552$x = "\x{101}\x{F2}\x{F3}"; 553substr($x, -1, -1) = "\x{100}\xFF"; 554is(length($x), 5); 555is($x, "\x{101}\xF2\x{100}\xFF\xF3"); 556is(substr($x, 0, 1), "\x{101}"); 557is(substr($x, 1, 1), "\x{F2}"); 558is(substr($x, 2, 1), "\x{100}"); 559is(substr($x, 3, 1), "\x{FF}"); 560is(substr($x, 4, 1), "\x{F3}"); 561 562substr($x = "ab", 0, 0, "\x{100}\x{200}"); 563is($x, "\x{100}\x{200}ab"); 564 565substr($x = "\x{100}\x{200}", 0, 0, "ab"); 566is($x, "ab\x{100}\x{200}"); 567 568substr($x = "ab", 1, 0, "\x{100}\x{200}"); 569is($x, "a\x{100}\x{200}b"); 570 571substr($x = "\x{100}\x{200}", 1, 0, "ab"); 572is($x, "\x{100}ab\x{200}"); 573 574substr($x = "ab", 2, 0, "\x{100}\x{200}"); 575is($x, "ab\x{100}\x{200}"); 576 577substr($x = "\x{100}\x{200}", 2, 0, "ab"); 578is($x, "\x{100}\x{200}ab"); 579 580substr($x = "\xFFb", 0, 0, "\x{100}\x{200}"); 581is($x, "\x{100}\x{200}\xFFb"); 582 583substr($x = "\x{100}\x{200}", 0, 0, "\xFFb"); 584is($x, "\xFFb\x{100}\x{200}"); 585 586substr($x = "\xFFb", 1, 0, "\x{100}\x{200}"); 587is($x, "\xFF\x{100}\x{200}b"); 588 589substr($x = "\x{100}\x{200}", 1, 0, "\xFFb"); 590is($x, "\x{100}\xFFb\x{200}"); 591 592substr($x = "\xFFb", 2, 0, "\x{100}\x{200}"); 593is($x, "\xFFb\x{100}\x{200}"); 594 595substr($x = "\x{100}\x{200}", 2, 0, "\xFFb"); 596is($x, "\x{100}\x{200}\xFFb"); 597 598# [perl #20933] 599{ 600 my $s = "ab"; 601 my @r; 602 $r[$_] = \ substr $s, $_, 1 for (0, 1); 603 is(join("", map { $$_ } @r), "ab"); 604} 605 606# [perl #23207] 607{ 608 sub ss { 609 substr($_[0],0,1) ^= substr($_[0],1,1) ^= 610 substr($_[0],0,1) ^= substr($_[0],1,1); 611 } 612 my $x = my $y = 'AB'; ss $x; ss $y; 613 is($x, $y); 614} 615 616# [perl #24605] 617{ 618 my $x = "0123456789\x{500}"; 619 my $y = substr $x, 4; 620 is(substr($x, 7, 1), "7"); 621} 622 623# multiple assignments to lvalue [perl #24346] 624{ 625 my $x = "abcdef"; 626 for (substr($x,1,3)) { 627 is($_, 'bcd'); 628 $_ = 'XX'; 629 is($_, 'XX'); 630 is($x, 'aXXef'); 631 $_ = "\xFF"; 632 is($_, "\xFF"); 633 is($x, "a\xFFef"); 634 $_ = "\xF1\xF2\xF3\xF4\xF5\xF6"; 635 is($_, "\xF1\xF2\xF3\xF4\xF5\xF6"); 636 is($x, "a\xF1\xF2\xF3\xF4\xF5\xF6ef"); 637 $_ = 'YYYY'; 638 is($_, 'YYYY'); 639 is($x, 'aYYYYef'); 640 } 641} 642 643# [perl #24200] string corruption with lvalue sub 644 645{ 646 my $foo = "a"; 647 sub bar: lvalue { substr $foo, 0 } 648 bar = "XXX"; 649 is(bar, 'XXX'); 650 $foo = '123456789'; 651 is(bar, '123456789'); 652} 653 654# [perl #29149] 655{ 656 my $text = "0123456789\xED "; 657 utf8::upgrade($text); 658 my $pos = 5; 659 pos($text) = $pos; 660 my $a = substr($text, $pos, $pos); 661 is(substr($text,$pos,1), $pos); 662 663} 664 665# [perl #23765] 666{ 667 my $a = pack("C", 0xbf); 668 substr($a, -1) &= chr(0xfeff); 669 is($a, "\xbf"); 670} 671 672# [perl #34976] incorrect caching of utf8 substr length 673{ 674 my $a = "abcd\x{100}"; 675 is(substr($a,1,2), 'bc'); 676 is(substr($a,1,1), 'b'); 677} 678