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