t/op/substr.t

   1 #!./perl -w
   2
   3 #P = start of string  Q = start of substr  R = end of substr  S = end of string
   4
   5 BEGIN {
   6     chdir 't' if -d 't';
   7     @INC = '../lib';
   8 }
   9 use 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
  24 require './test.pl';
  25
  26 plan(334);
  27
  28 run_tests() unless caller;
  29
  30 my $krunch = "a";
  31
  32 sub run_tests {
  33
  34 $FATAL_MSG = qr/^substr outside of string/;
  35
  36 is(substr($a,0,3), 'abc');   # P=Q R S
  37 is(substr($a,3,3), 'def');   # P Q R S
  38 is(substr($a,6,999), 'xyz'); # P Q S R
  39 $b = substr($a,999,999) ; # warn # P R Q S
  40 is ($w--, 1);
  41 eval{substr($a,999,999) = "" ; };# P R Q S
  42 like ($@, $FATAL_MSG);
  43 is(substr($a,0,-6), 'abc');  # P=Q R S
  44 is(substr($a,-3,1), 'x');    # P Q R S
  45
  46 $[ = 1;
  47
  48 is(substr($a,1,3), 'abc' );  # P=Q R S
  49 is(substr($a,4,3), 'def' );  # P Q R S
  50 is(substr($a,7,999), 'xyz');# P Q S R
  51 $b = substr($a,999,999) ; # warn # P R Q S
  52 is($w--, 1);
  53 eval{substr($a,999,999) = "" ; } ; # P R Q S
  54 like ($@, $FATAL_MSG);
  55 is(substr($a,1,-6), 'abc' );# P=Q R S
  56 is(substr($a,-3,1), 'x' );  # P Q R S
  57
  58 $[ = 0;
  59
  60 substr($a,3,3) = 'XYZ';
  61 is($a, 'abcXYZxyz' );
  62 substr($a,0,2) = '';
  63 is($a, 'cXYZxyz' );
  64 substr($a,0,0) = 'ab';
  65 is($a, 'abcXYZxyz' );
  66 substr($a,0,0) = '12345678';
  67 is($a, '12345678abcXYZxyz' );
  68 substr($a,-3,3) = 'def';
  69 is($a, '12345678abcXYZdef');
  70 substr($a,-3,3) = '<';
  71 is($a, '12345678abcXYZ<' );
  72 substr($a,-1,1) = '12345678';
  73 is($a, '12345678abcXYZ12345678' );
  74
  75 $a = 'abcdefxyz';
  76
  77 is(substr($a,6), 'xyz' );        # P Q R=S
  78 is(substr($a,-3), 'xyz' );       # P Q R=S
  79 $b = substr($a,999,999) ; # warning   # P R=S Q
  80 is($w--, 1);
  81 eval{substr($a,999,999) = "" ; } ;    # P R=S Q
  82 like($@, $FATAL_MSG);
  83 is(substr($a,0), 'abcdefxyz');  # P=Q R=S
  84 is(substr($a,9), '');           # P Q=R=S
  85 is(substr($a,-11), 'abcdefxyz'); # Q P R=S
  86 is(substr($a,-9), 'abcdefxyz');  # P=Q R=S
  87
  88 $a = '54321';
  89
  90 $b = substr($a,-7, 1) ; # warn  # Q R P S
  91 is($w--, 1);
  92 eval{substr($a,-7, 1) = "" ; }; # Q R P S
  93 like($@, $FATAL_MSG);
  94 $b = substr($a,-7,-6) ; # warn  # Q R P S
  95 is($w--, 1);
  96 eval{substr($a,-7,-6) = "" ; }; # Q R P S
  97 like($@, $FATAL_MSG);
  98 is(substr($a,-5,-7), '');  # R P=Q S
  99 is(substr($a, 2,-7), '');  # R P Q S
 100 is(substr($a,-3,-7), '');  # R P Q S
 101 is(substr($a, 2,-5), '');  # P=R Q S
 102 is(substr($a,-3,-5), '');  # P=R Q S
 103 is(substr($a, 2,-4), '');  # P R Q S
 104 is(substr($a,-3,-4), '');  # P R Q S
 105 is(substr($a, 5,-6), '');  # R P Q=S
 106 is(substr($a, 5,-5), '');  # P=R Q S
 107 is(substr($a, 5,-3), '');  # P R Q=S
 108 $b = substr($a, 7,-7) ; # warn  # R P S Q
 109 is($w--, 1);
 110 eval{substr($a, 7,-7) = "" ; }; # R P S Q
 111 like($@, $FATAL_MSG);
 112 $b = substr($a, 7,-5) ; # warn  # P=R S Q
 113 is($w--, 1);
 114 eval{substr($a, 7,-5) = "" ; }; # P=R S Q
 115 like($@, $FATAL_MSG);
 116 $b = substr($a, 7,-3) ; # warn  # P Q S Q
 117 is($w--, 1);
 118 eval{substr($a, 7,-3) = "" ; }; # P Q S Q
 119 like($@, $FATAL_MSG);
 120 $b = substr($a, 7, 0) ; # warn  # P S Q=R
 121 is($w--, 1);
 122 eval{substr($a, 7, 0) = "" ; }; # P S Q=R
 123 like($@, $FATAL_MSG);
 124
 125 is(substr($a,-7,2), '');   # Q P=R S
 126 is(substr($a,-7,4), '54'); # Q P R S
 127 is(substr($a,-7,7), '54321');# Q P R=S
 128 is(substr($a,-7,9), '54321');# Q P S R
 129 is(substr($a,-5,0), '');   # P=Q=R S
 130 is(substr($a,-5,3), '543');# P=Q R S
 131 is(substr($a,-5,5), '54321');# P=Q R=S
 132 is(substr($a,-5,7), '54321');# P=Q S R
 133 is(substr($a,-3,0), '');   # P Q=R S
 134 is(substr($a,-3,3), '321');# P Q R=S
 135 is(substr($a,-2,3), '21'); # P Q S R
 136 is(substr($a,0,-5), '');   # P=Q=R S
 137 is(substr($a,2,-3), '');   # P Q=R S
 138 is(substr($a,0,0), '');    # P=Q=R S
 139 is(substr($a,0,5), '54321');# P=Q R=S
 140 is(substr($a,0,7), '54321');# P=Q S R
 141 is(substr($a,2,0), '');    # P Q=R S
 142 is(substr($a,2,3), '321'); # P Q R=S
 143 is(substr($a,5,0), '');    # P Q=R=S
 144 is(substr($a,5,2), '');    # P Q=S R
 145 is(substr($a,-7,-5), '');  # Q P=R S
 146 is(substr($a,-7,-2), '543');# Q P R S
 147 is(substr($a,-5,-5), '');  # P=Q=R S
 148 is(substr($a,-5,-2), '543');# P=Q R S
 149 is(substr($a,-3,-3), '');  # P Q=R S
 150 is(substr($a,-3,-1), '32');# P Q R S
 151
 152 $a = '';
 153
 154 is(substr($a,-2,2), '');   # Q P=R=S
 155 is(substr($a,0,0), '');    # P=Q=R=S
 156 is(substr($a,0,1), '');    # P=Q=S R
 157 is(substr($a,-2,3), '');   # Q P=S R
 158 is(substr($a,-2), '');     # Q P=R=S
 159 is(substr($a,0), '');      # P=Q=R=S
 160
 161
 162 is(substr($a,0,-1), '');   # R P=Q=S
 163 $b = substr($a,-2, 0) ; # warn  # Q=R P=S
 164 is($w--, 1);
 165 eval{substr($a,-2, 0) = "" ; }; # Q=R P=S
 166 like($@, $FATAL_MSG);
 167
 168 $b = substr($a,-2, 1) ; # warn  # Q R P=S
 169 is($w--, 1);
 170 eval{substr($a,-2, 1) = "" ; }; # Q R P=S
 171 like($@, $FATAL_MSG);
 172
 173 $b = substr($a,-2,-1) ; # warn  # Q R P=S
 174 is($w--, 1);
 175 eval{substr($a,-2,-1) = "" ; }; # Q R P=S
 176 like($@, $FATAL_MSG);
 177
 178 $b = substr($a,-2,-2) ; # warn  # Q=R P=S
 179 is($w--, 1);
 180 eval{substr($a,-2,-2) = "" ; }; # Q=R P=S
 181 like($@, $FATAL_MSG);
 182
 183 $b = substr($a, 1,-2) ; # warn  # R P=S Q
 184 is($w--, 1);
 185 eval{substr($a, 1,-2) = "" ; }; # R P=S Q
 186 like($@, $FATAL_MSG);
 187
 188 $b = substr($a, 1, 1) ; # warn  # P=S Q R
 189 is($w--, 1);
 190 eval{substr($a, 1, 1) = "" ; }; # P=S Q R
 191 like($@, $FATAL_MSG);
 192
 193 $b = substr($a, 1, 0) ;# warn   # P=S Q=R
 194 is($w--, 1);
 195 eval{substr($a, 1, 0) = "" ; }; # P=S Q=R
 196 like($@, $FATAL_MSG);
 197
 198 $b = substr($a,1) ; # warning   # P=R=S Q
 199 is($w--, 1);
 200 eval{substr($a,1) = "" ; };     # P=R=S Q
 201 like($@, $FATAL_MSG);
 202
 203 my $a = 'zxcvbnm';
 204 substr($a,2,0) = '';
 205 is($a, 'zxcvbnm');
 206 substr($a,7,0) = '';
 207 is($a, 'zxcvbnm');
 208 substr($a,5,0) = '';
 209 is($a, 'zxcvbnm');
 210 substr($a,0,2) = 'pq';
 211 is($a, 'pqcvbnm');
 212 substr($a,2,0) = 'r';
 213 is($a, 'pqrcvbnm');
 214 substr($a,8,0) = 'asd';
 215 is($a, 'pqrcvbnmasd');
 216 substr($a,0,2) = 'iop';
 217 is($a, 'ioprcvbnmasd');
 218 substr($a,0,5) = 'fgh';
 219 is($a, 'fghvbnmasd');
 220 substr($a,3,5) = 'jkl';
 221 is($a, 'fghjklsd');
 222 substr($a,3,2) = '1234';
 223 is($a, 'fgh1234lsd');
 224
 225
 226 # with lexicals (and in re-entered scopes)
 227 for (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
 251 is($w, 0);
 252
 253 # check new 4 arg replacement syntax
 254 $a = "abcxyz";
 255 $w = 0;
 256 is(substr($a, 0, 3, ""), "abc");
 257 is($a, "xyz");
 258 is(substr($a, 0, 0, "abc"), "");
 259 is($a, "abcxyz");
 260 is(substr($a, 3, -1, ""), "xy");
 261 is($a, "abcz");
 262
 263 is(substr($a, 3, undef, "xy"), "");
 264 is($a, "abcxyz");
 265 is($w, 3);
 266
 267 $w = 0;
 268
 269 is(substr($a, 3, 9999999, ""), "xyz");
 270 is($a, "abc");
 271 eval{substr($a, -99, 0, "") };
 272 like($@, $FATAL_MSG);
 273 eval{substr($a, 99, 3, "") };
 274 like($@, $FATAL_MSG);
 275
 276 substr($a, 0, length($a), "foo");
 277 is ($a, "foo");
 278 is ($w, 0);
 279
 280 # using 4 arg substr as lvalue is a compile time error
 281 eval 'substr($a,0,0,"") = "abc"';
 282 like ($@, qr/Can't modify substr/);
 283 is ($a, "foo");
 284
 285 $a = "abcdefgh";
 286 is(sub { shift }->(substr($a, 0, 4, "xxxx")), 'abcd');
 287 is($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
 317 require Tie::Scalar;
 318 my %data;
 319 tie $data{'a'}, 'Tie::StdScalar';  # makes $data{'a'} magical
 320 $data{a} = "firstlast";
 321 is(substr($data{'a'}, 0, 5, ""), "first");
 322 is($data{'a'}, "last");
 323
 324 # more utf8
 325
 326 # The following two originally from Ignasi Roca.
 327
 328 $x = "\xF1\xF2\xF3";
 329 substr($x, 0, 1) = "\x{100}"; # Ignasi had \x{FF}
 330 is(length($x), 3);
 331 is($x, "\x{100}\xF2\xF3");
 332 is(substr($x, 0, 1), "\x{100}");
 333 is(substr($x, 1, 1), "\x{F2}");
 334 is(substr($x, 2, 1), "\x{F3}");
 335
 336 $x = "\xF1\xF2\xF3";
 337 substr($x, 0, 1) = "\x{100}\x{FF}"; # Ignasi had \x{FF}
 338 is(length($x), 4);
 339 is($x, "\x{100}\x{FF}\xF2\xF3");
 340 is(substr($x, 0, 1), "\x{100}");
 341 is(substr($x, 1, 1), "\x{FF}");
 342 is(substr($x, 2, 1), "\x{F2}");
 343 is(substr($x, 3, 1), "\x{F3}");
 344
 345 # more utf8 lval exercise
 346
 347 $x = "\xF1\xF2\xF3";
 348 substr($x, 0, 2) = "\x{100}\xFF";
 349 is(length($x), 3);
 350 is($x, "\x{100}\xFF\xF3");
 351 is(substr($x, 0, 1), "\x{100}");
 352 is(substr($x, 1, 1), "\x{FF}");
 353 is(substr($x, 2, 1), "\x{F3}");
 354
 355 $x = "\xF1\xF2\xF3";
 356 substr($x, 1, 1) = "\x{100}\xFF";
 357 is(length($x), 4);
 358 is($x, "\xF1\x{100}\xFF\xF3");
 359 is(substr($x, 0, 1), "\x{F1}");
 360 is(substr($x, 1, 1), "\x{100}");
 361 is(substr($x, 2, 1), "\x{FF}");
 362 is(substr($x, 3, 1), "\x{F3}");
 363
 364 $x = "\xF1\xF2\xF3";
 365 substr($x, 2, 1) = "\x{100}\xFF";
 366 is(length($x), 4);
 367 is($x, "\xF1\xF2\x{100}\xFF");
 368 is(substr($x, 0, 1), "\x{F1}");
 369 is(substr($x, 1, 1), "\x{F2}");
 370 is(substr($x, 2, 1), "\x{100}");
 371 is(substr($x, 3, 1), "\x{FF}");
 372
 373 $x = "\xF1\xF2\xF3";
 374 substr($x, 3, 1) = "\x{100}\xFF";
 375 is(length($x), 5);
 376 is($x, "\xF1\xF2\xF3\x{100}\xFF");
 377 is(substr($x, 0, 1), "\x{F1}");
 378 is(substr($x, 1, 1), "\x{F2}");
 379 is(substr($x, 2, 1), "\x{F3}");
 380 is(substr($x, 3, 1), "\x{100}");
 381 is(substr($x, 4, 1), "\x{FF}");
 382
 383 $x = "\xF1\xF2\xF3";
 384 substr($x, -1, 1) = "\x{100}\xFF";
 385 is(length($x), 4);
 386 is($x, "\xF1\xF2\x{100}\xFF");
 387 is(substr($x, 0, 1), "\x{F1}");
 388 is(substr($x, 1, 1), "\x{F2}");
 389 is(substr($x, 2, 1), "\x{100}");
 390 is(substr($x, 3, 1), "\x{FF}");
 391
 392 $x = "\xF1\xF2\xF3";
 393 substr($x, -1, 0) = "\x{100}\xFF";
 394 is(length($x), 5);
 395 is($x, "\xF1\xF2\x{100}\xFF\xF3");
 396 is(substr($x, 0, 1), "\x{F1}");
 397 is(substr($x, 1, 1), "\x{F2}");
 398 is(substr($x, 2, 1), "\x{100}");
 399 is(substr($x, 3, 1), "\x{FF}");
 400 is(substr($x, 4, 1), "\x{F3}");
 401
 402 $x = "\xF1\xF2\xF3";
 403 substr($x, 0, -1) = "\x{100}\xFF";
 404 is(length($x), 3);
 405 is($x, "\x{100}\xFF\xF3");
 406 is(substr($x, 0, 1), "\x{100}");
 407 is(substr($x, 1, 1), "\x{FF}");
 408 is(substr($x, 2, 1), "\x{F3}");
 409
 410 $x = "\xF1\xF2\xF3";
 411 substr($x, 0, -2) = "\x{100}\xFF";
 412 is(length($x), 4);
 413 is($x, "\x{100}\xFF\xF2\xF3");
 414 is(substr($x, 0, 1), "\x{100}");
 415 is(substr($x, 1, 1), "\x{FF}");
 416 is(substr($x, 2, 1), "\x{F2}");
 417 is(substr($x, 3, 1), "\x{F3}");
 418
 419 $x = "\xF1\xF2\xF3";
 420 substr($x, 0, -3) = "\x{100}\xFF";
 421 is(length($x), 5);
 422 is($x, "\x{100}\xFF\xF1\xF2\xF3");
 423 is(substr($x, 0, 1), "\x{100}");
 424 is(substr($x, 1, 1), "\x{FF}");
 425 is(substr($x, 2, 1), "\x{F1}");
 426 is(substr($x, 3, 1), "\x{F2}");
 427 is(substr($x, 4, 1), "\x{F3}");
 428
 429 $x = "\xF1\xF2\xF3";
 430 substr($x, 1, -1) = "\x{100}\xFF";
 431 is(length($x), 4);
 432 is($x, "\xF1\x{100}\xFF\xF3");
 433 is(substr($x, 0, 1), "\x{F1}");
 434 is(substr($x, 1, 1), "\x{100}");
 435 is(substr($x, 2, 1), "\x{FF}");
 436 is(substr($x, 3, 1), "\x{F3}");
 437
 438 $x = "\xF1\xF2\xF3";
 439 substr($x, -1, -1) = "\x{100}\xFF";
 440 is(length($x), 5);
 441 is($x, "\xF1\xF2\x{100}\xFF\xF3");
 442 is(substr($x, 0, 1), "\x{F1}");
 443 is(substr($x, 1, 1), "\x{F2}");
 444 is(substr($x, 2, 1), "\x{100}");
 445 is(substr($x, 3, 1), "\x{FF}");
 446 is(substr($x, 4, 1), "\x{F3}");
 447
 448 # And tests for already-UTF8 one
 449
 450 $x = "\x{101}\x{F2}\x{F3}";
 451 substr($x, 0, 1) = "\x{100}";
 452 is(length($x), 3);
 453 is($x, "\x{100}\xF2\xF3");
 454 is(substr($x, 0, 1), "\x{100}");
 455 is(substr($x, 1, 1), "\x{F2}");
 456 is(substr($x, 2, 1), "\x{F3}");
 457
 458 $x = "\x{101}\x{F2}\x{F3}";
 459 substr($x, 0, 1) = "\x{100}\x{FF}";
 460 is(length($x), 4);
 461 is($x, "\x{100}\x{FF}\xF2\xF3");
 462 is(substr($x, 0, 1), "\x{100}");
 463 is(substr($x, 1, 1), "\x{FF}");
 464 is(substr($x, 2, 1), "\x{F2}");
 465 is(substr($x, 3, 1), "\x{F3}");
 466
 467 $x = "\x{101}\x{F2}\x{F3}";
 468 substr($x, 0, 2) = "\x{100}\xFF";
 469 is(length($x), 3);
 470 is($x, "\x{100}\xFF\xF3");
 471 is(substr($x, 0, 1), "\x{100}");
 472 is(substr($x, 1, 1), "\x{FF}");
 473 is(substr($x, 2, 1), "\x{F3}");
 474
 475 $x = "\x{101}\x{F2}\x{F3}";
 476 substr($x, 1, 1) = "\x{100}\xFF";
 477 is(length($x), 4);
 478 is($x, "\x{101}\x{100}\xFF\xF3");
 479 is(substr($x, 0, 1), "\x{101}");
 480 is(substr($x, 1, 1), "\x{100}");
 481 is(substr($x, 2, 1), "\x{FF}");
 482 is(substr($x, 3, 1), "\x{F3}");
 483
 484 $x = "\x{101}\x{F2}\x{F3}";
 485 substr($x, 2, 1) = "\x{100}\xFF";
 486 is(length($x), 4);
 487 is($x, "\x{101}\xF2\x{100}\xFF");
 488 is(substr($x, 0, 1), "\x{101}");
 489 is(substr($x, 1, 1), "\x{F2}");
 490 is(substr($x, 2, 1), "\x{100}");
 491 is(substr($x, 3, 1), "\x{FF}");
 492
 493 $x = "\x{101}\x{F2}\x{F3}";
 494 substr($x, 3, 1) = "\x{100}\xFF";
 495 is(length($x), 5);
 496 is($x, "\x{101}\x{F2}\x{F3}\x{100}\xFF");
 497 is(substr($x, 0, 1), "\x{101}");
 498 is(substr($x, 1, 1), "\x{F2}");
 499 is(substr($x, 2, 1), "\x{F3}");
 500 is(substr($x, 3, 1), "\x{100}");
 501 is(substr($x, 4, 1), "\x{FF}");
 502
 503 $x = "\x{101}\x{F2}\x{F3}";
 504 substr($x, -1, 1) = "\x{100}\xFF";
 505 is(length($x), 4);
 506 is($x, "\x{101}\xF2\x{100}\xFF");
 507 is(substr($x, 0, 1), "\x{101}");
 508 is(substr($x, 1, 1), "\x{F2}");
 509 is(substr($x, 2, 1), "\x{100}");
 510 is(substr($x, 3, 1), "\x{FF}");
 511
 512 $x = "\x{101}\x{F2}\x{F3}";
 513 substr($x, -1, 0) = "\x{100}\xFF";
 514 is(length($x), 5);
 515 is($x, "\x{101}\xF2\x{100}\xFF\xF3");
 516 is(substr($x, 0, 1), "\x{101}");
 517 is(substr($x, 1, 1), "\x{F2}");
 518 is(substr($x, 2, 1), "\x{100}");
 519 is(substr($x, 3, 1), "\x{FF}");
 520 is(substr($x, 4, 1), "\x{F3}");
 521
 522 $x = "\x{101}\x{F2}\x{F3}";
 523 substr($x, 0, -1) = "\x{100}\xFF";
 524 is(length($x), 3);
 525 is($x, "\x{100}\xFF\xF3");
 526 is(substr($x, 0, 1), "\x{100}");
 527 is(substr($x, 1, 1), "\x{FF}");
 528 is(substr($x, 2, 1), "\x{F3}");
 529
 530 $x = "\x{101}\x{F2}\x{F3}";
 531 substr($x, 0, -2) = "\x{100}\xFF";
 532 is(length($x), 4);
 533 is($x, "\x{100}\xFF\xF2\xF3");
 534 is(substr($x, 0, 1), "\x{100}");
 535 is(substr($x, 1, 1), "\x{FF}");
 536 is(substr($x, 2, 1), "\x{F2}");
 537 is(substr($x, 3, 1), "\x{F3}");
 538
 539 $x = "\x{101}\x{F2}\x{F3}";
 540 substr($x, 0, -3) = "\x{100}\xFF";
 541 is(length($x), 5);
 542 is($x, "\x{100}\xFF\x{101}\x{F2}\x{F3}");
 543 is(substr($x, 0, 1), "\x{100}");
 544 is(substr($x, 1, 1), "\x{FF}");
 545 is(substr($x, 2, 1), "\x{101}");
 546 is(substr($x, 3, 1), "\x{F2}");
 547 is(substr($x, 4, 1), "\x{F3}");
 548
 549 $x = "\x{101}\x{F2}\x{F3}";
 550 substr($x, 1, -1) = "\x{100}\xFF";
 551 is(length($x), 4);
 552 is($x, "\x{101}\x{100}\xFF\xF3");
 553 is(substr($x, 0, 1), "\x{101}");
 554 is(substr($x, 1, 1), "\x{100}");
 555 is(substr($x, 2, 1), "\x{FF}");
 556 is(substr($x, 3, 1), "\x{F3}");
 557
 558 $x = "\x{101}\x{F2}\x{F3}";
 559 substr($x, -1, -1) = "\x{100}\xFF";
 560 is(length($x), 5);
 561 is($x, "\x{101}\xF2\x{100}\xFF\xF3");
 562 is(substr($x, 0, 1), "\x{101}");
 563 is(substr($x, 1, 1), "\x{F2}");
 564 is(substr($x, 2, 1), "\x{100}");
 565 is(substr($x, 3, 1), "\x{FF}");
 566 is(substr($x, 4, 1), "\x{F3}");
 567
 568 substr($x = "ab", 0, 0, "\x{100}\x{200}");
 569 is($x, "\x{100}\x{200}ab");
 570
 571 substr($x = "\x{100}\x{200}", 0, 0, "ab");
 572 is($x, "ab\x{100}\x{200}");
 573
 574 substr($x = "ab", 1, 0, "\x{100}\x{200}");
 575 is($x, "a\x{100}\x{200}b");
 576
 577 substr($x = "\x{100}\x{200}", 1, 0, "ab");
 578 is($x, "\x{100}ab\x{200}");
 579
 580 substr($x = "ab", 2, 0, "\x{100}\x{200}");
 581 is($x, "ab\x{100}\x{200}");
 582
 583 substr($x = "\x{100}\x{200}", 2, 0, "ab");
 584 is($x, "\x{100}\x{200}ab");
 585
 586 substr($x = "\xFFb", 0, 0, "\x{100}\x{200}");
 587 is($x, "\x{100}\x{200}\xFFb");
 588
 589 substr($x = "\x{100}\x{200}", 0, 0, "\xFFb");
 590 is($x, "\xFFb\x{100}\x{200}");
 591
 592 substr($x = "\xFFb", 1, 0, "\x{100}\x{200}");
 593 is($x, "\xFF\x{100}\x{200}b");
 594
 595 substr($x = "\x{100}\x{200}", 1, 0, "\xFFb");
 596 is($x, "\x{100}\xFFb\x{200}");
 597
 598 substr($x = "\xFFb", 2, 0, "\x{100}\x{200}");
 599 is($x, "\xFFb\x{100}\x{200}");
 600
 601 substr($x = "\x{100}\x{200}", 2, 0, "\xFFb");
 602 is($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 }