t/op/substr.t

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