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