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