1#!./perl 2 3BEGIN { 4 chdir 't' if -d 't'; 5 require './test.pl'; 6 require './charset_tools.pl'; 7 set_up_inc('../lib'); 8} 9 10plan tests => 176; 11 12$FS = ':'; 13 14$_ = 'a:b:c'; 15 16($a,$b,$c) = split($FS,$_); 17 18is(join(';',$a,$b,$c), 'a;b;c', 'Split a simple string into scalars.'); 19 20@ary = split(/:b:/); 21$cnt = split(/:b:/); 22is(join("$_",@ary), 'aa:b:cc'); 23is($cnt, scalar(@ary)); 24 25$_ = "abc\n"; 26my @xyz = (@ary = split(//)); 27$cnt = split(//); 28is(join(".",@ary), "a.b.c.\n"); 29is($cnt, scalar(@ary)); 30 31$_ = "a:b:c::::"; 32@ary = split(/:/); 33$cnt = split(/:/); 34is(join(".",@ary), "a.b.c"); 35is($cnt, scalar(@ary)); 36 37$_ = join(':',split(' '," a b\tc \t d ")); 38is($_, 'a:b:c:d'); 39@ary = split(' '," a b\tc \t d "); 40$cnt = split(' '," a b\tc \t d "); 41is($cnt, scalar(@ary)); 42 43$_ = join(':',split(/ */,"foo bar bie\tdoll")); 44is($_ , "f:o:o:b:a:r:b:i:e:\t:d:o:l:l"); 45@ary = split(/ */,"foo bar bie\tdoll"); 46$cnt = split(/ */,"foo bar bie\tdoll"); 47is($cnt, scalar(@ary)); 48 49$_ = join(':', 'foo', split(/ /,'a b c'), 'bar'); 50is($_, "foo:a:b::c:bar"); 51@ary = split(/ /,'a b c'); 52$cnt = split(/ /,'a b c'); 53is($cnt, scalar(@ary)); 54 55# Can we say how many fields to split to? 56$_ = join(':', split(' ','1 2 3 4 5 6', 3)); 57is($_, '1:2:3 4 5 6', "Split into a specified number of fields, defined by a literal"); 58@ary = split(' ','1 2 3 4 5 6', 3); 59$cnt = split(' ','1 2 3 4 5 6', 3); 60is($cnt, scalar(@ary), "Check element count from previous test"); 61 62# Can we do it as a variable? 63$x = 4; 64$_ = join(':', split(' ','1 2 3 4 5 6', $x)); 65is($_, '1:2:3:4 5 6', "Split into a specified number of fields, defined by a scalar variable"); 66@ary = split(' ','1 2 3 4 5 6', $x); 67$cnt = split(' ','1 2 3 4 5 6', $x); 68is($cnt, scalar(@ary), "Check element count from previous test"); 69 70# Does the 999 suppress null field chopping? 71$_ = join(':', split(/:/,'1:2:3:4:5:6:::', 999)); 72is($_ , '1:2:3:4:5:6:::'); 73@ary = split(/:/,'1:2:3:4:5:6:::', 999); 74$cnt = split(/:/,'1:2:3:4:5:6:::', 999); 75is($cnt, scalar(@ary)); 76 77# Splitting without pattern 78$_ = "1 2 3 4"; 79$_ = join(':', split); 80is($_ , '1:2:3:4', "Split and join without specifying a split pattern"); 81 82# Does assignment to a list imply split to one more field than that? 83$foo = runperl( switches => ['-Dt'], stderr => 1, prog => '($a,$b)=split;' ); 84ok($foo =~ /DEBUGGING/ || $foo =~ /const\n?\Q(IV(3))\E/); 85 86# Can we say how many fields to split to when assigning to a list? 87($a,$b) = split(' ','1 2 3 4 5 6', 2); 88$_ = join(':',$a,$b); 89is($_, '1:2 3 4 5 6', "Storing split output into list of scalars"); 90 91# do subpatterns generate additional fields (without trailing nulls)? 92$_ = join '|', split(/,|(-)/, "1-10,20,,,"); 93is($_, "1|-|10||20"); 94@ary = split(/,|(-)/, "1-10,20,,,"); 95$cnt = split(/,|(-)/, "1-10,20,,,"); 96is($cnt, scalar(@ary)); 97 98# do subpatterns generate additional fields (with a limit)? 99$_ = join '|', split(/,|(-)/, "1-10,20,,,", 10); 100is($_, "1|-|10||20||||||"); 101@ary = split(/,|(-)/, "1-10,20,,,", 10); 102$cnt = split(/,|(-)/, "1-10,20,,,", 10); 103is($cnt, scalar(@ary)); 104 105# is the 'two undefs' bug fixed? 106(undef, $a, undef, $b) = qw(1 2 3 4); 107is("$a|$b", "2|4"); 108 109# .. even for locals? 110{ 111 local(undef, $a, undef, $b) = qw(1 2 3 4); 112 is("$a|$b", "2|4"); 113} 114 115# check splitting of null string 116$_ = join('|', split(/x/, '',-1), 'Z'); 117is($_, "Z"); 118@ary = split(/x/, '',-1); 119$cnt = split(/x/, '',-1); 120is($cnt, scalar(@ary)); 121 122$_ = join('|', split(/x/, '', 1), 'Z'); 123is($_, "Z"); 124@ary = split(/x/, '', 1); 125$cnt = split(/x/, '', 1); 126is($cnt, scalar(@ary)); 127 128$_ = join('|', split(/(p+)/,'',-1), 'Z'); 129is($_, "Z"); 130@ary = split(/(p+)/,'',-1); 131$cnt = split(/(p+)/,'',-1); 132is($cnt, scalar(@ary)); 133 134$_ = join('|', split(/.?/, '',-1), 'Z'); 135is($_, "Z"); 136@ary = split(/.?/, '',-1); 137$cnt = split(/.?/, '',-1); 138is($cnt, scalar(@ary)); 139 140 141# Are /^/m patterns scanned? 142$_ = join '|', split(/^a/m, "a b a\na d a", 20); 143is($_, "| b a\n| d a"); 144@ary = split(/^a/m, "a b a\na d a", 20); 145$cnt = split(/^a/m, "a b a\na d a", 20); 146is($cnt, scalar(@ary)); 147 148# Are /$/m patterns scanned? 149$_ = join '|', split(/a$/m, "a b a\na d a", 20); 150is($_, "a b |\na d |"); 151@ary = split(/a$/m, "a b a\na d a", 20); 152$cnt = split(/a$/m, "a b a\na d a", 20); 153is($cnt, scalar(@ary)); 154 155# Are /^/m patterns scanned? 156$_ = join '|', split(/^aa/m, "aa b aa\naa d aa", 20); 157is($_, "| b aa\n| d aa"); 158@ary = split(/^aa/m, "aa b aa\naa d aa", 20); 159$cnt = split(/^aa/m, "aa b aa\naa d aa", 20); 160is($cnt, scalar(@ary)); 161 162# Are /$/m patterns scanned? 163$_ = join '|', split(/aa$/m, "aa b aa\naa d aa", 20); 164is($_, "aa b |\naa d |"); 165@ary = split(/aa$/m, "aa b aa\naa d aa", 20); 166$cnt = split(/aa$/m, "aa b aa\naa d aa", 20); 167is($cnt, scalar(@ary)); 168 169# Greedyness: 170$_ = "a : b :c: d"; 171@ary = split(/\s*:\s*/); 172$cnt = split(/\s*:\s*/); 173is(($res = join(".",@ary)), "a.b.c.d", $res); 174is($cnt, scalar(@ary)); 175 176# use of match result as pattern (!) 177is('p:q:r:s', join ':', split('abc' =~ /b/, 'p1q1r1s')); 178@ary = split('abc' =~ /b/, 'p1q1r1s'); 179$cnt = split('abc' =~ /b/, 'p1q1r1s'); 180is($cnt, scalar(@ary)); 181 182# /^/ treated as /^/m 183$_ = join ':', split /^/, "ab\ncd\nef\n"; 184is($_, "ab\n:cd\n:ef\n","check that split /^/ is treated as split /^/m"); 185 186$_ = join ':', split /\A/, "ab\ncd\nef\n"; 187is($_, "ab\ncd\nef\n","check that split /\A/ is NOT treated as split /^/m"); 188 189# see if @a = @b = split(...) optimization works 190@list1 = @list2 = split ('p',"a p b c p"); 191ok(@list1 == @list2 && 192 "@list1" eq "@list2" && 193 @list1 == 2 && 194 "@list1" eq "a b c "); 195 196# zero-width assertion 197$_ = join ':', split /(?=\w)/, "rm b"; 198is($_, "r:m :b"); 199@ary = split /(?=\w)/, "rm b"; 200$cnt = split /(?=\w)/, "rm b"; 201is($cnt, scalar(@ary)); 202 203# unicode splittage 204 205@ary = map {ord} split //, v1.20.300.4000.50000.4000.300.20.1; 206$cnt = split //, v1.20.300.4000.50000.4000.300.20.1; 207is("@ary", "1 20 300 4000 50000 4000 300 20 1"); 208is($cnt, scalar(@ary)); 209 210@ary = split(/\x{FE}/, "\x{FF}\x{FE}\x{FD}"); # bug id 20010105.016 (#5088) 211$cnt = split(/\x{FE}/, "\x{FF}\x{FE}\x{FD}"); # bug id 20010105.016 (#5088) 212ok(@ary == 2 && 213 $ary[0] eq "\xFF" && $ary[1] eq "\xFD" && 214 $ary[0] eq "\x{FF}" && $ary[1] eq "\x{FD}"); 215is($cnt, scalar(@ary)); 216 217@ary = split(/(\x{FE}\xFE)/, "\xFF\x{FF}\xFE\x{FE}\xFD\x{FD}"); # variant of 31 218$cnt = split(/(\x{FE}\xFE)/, "\xFF\x{FF}\xFE\x{FE}\xFD\x{FD}"); # variant of 31 219ok(@ary == 3 && 220 $ary[0] eq "\xFF\xFF" && 221 $ary[0] eq "\x{FF}\xFF" && 222 $ary[0] eq "\x{FF}\x{FF}" && 223 $ary[1] eq "\xFE\xFE" && 224 $ary[1] eq "\x{FE}\xFE" && 225 $ary[1] eq "\x{FE}\x{FE}" && 226 $ary[2] eq "\xFD\xFD" && 227 $ary[2] eq "\x{FD}\xFD" && 228 $ary[2] eq "\x{FD}\x{FD}"); 229is($cnt, scalar(@ary)); 230 231{ 232 my @a = map ord, split(//, join("", map chr, (1234, 123, 2345))); 233 my $c = split(//, join("", map chr, (1234, 123, 2345))); 234 is("@a", "1234 123 2345"); 235 is($c, scalar(@a)); 236} 237 238{ 239 my $x = 'A'; 240 my @a = map ord, split(/$x/, join("", map chr, (1234, ord($x), 2345))); 241 my $c = split(/$x/, join("", map chr, (1234, ord($x), 2345))); 242 is("@a", "1234 2345"); 243 is($c, scalar(@a)); 244} 245 246{ 247 # bug id 20000427.003 (#3173) 248 249 use warnings; 250 use strict; 251 252 my $sushi = "\x{b36c}\x{5a8c}\x{ff5b}\x{5079}\x{505b}"; 253 254 my @charlist = split //, $sushi; 255 my $charnum = split //, $sushi; 256 is($charnum, scalar(@charlist)); 257 my $r = ''; 258 foreach my $ch (@charlist) { 259 $r = $r . " " . sprintf "U+%04X", ord($ch); 260 } 261 262 is($r, " U+B36C U+5A8C U+FF5B U+5079 U+505B"); 263} 264 265{ 266 my $s = "\x20\x40\x{80}\x{100}\x{80}\x40\x20"; 267 268 { 269 # bug id 20000426.003 (#3166) 270 271 my ($a, $b, $c) = split(/\x40/, $s); 272 ok($a eq "\x20" && $b eq "\x{80}\x{100}\x{80}" && $c eq $a); 273 } 274 275 my ($a, $b) = split(/\x{100}/, $s); 276 ok($a eq "\x20\x40\x{80}" && $b eq "\x{80}\x40\x20"); 277 278 my ($a, $b) = split(/\x{80}\x{100}\x{80}/, $s); 279 ok($a eq "\x20\x40" && $b eq "\x40\x20"); 280 281 { 282 my ($a, $b) = split(/\x40\x{80}/, $s); 283 ok($a eq "\x20" && $b eq "\x{100}\x{80}\x40\x20"); 284 } 285 286 my ($a, $b, $c) = split(/[\x40\x{80}]+/, $s); 287 ok($a eq "\x20" && $b eq "\x{100}" && $c eq "\x20"); 288} 289 290{ 291 # 20001205.014 (#4844) 292 293 my $a = "ABC\x{263A}"; 294 295 my @b = split( //, $a ); 296 my $c = split( //, $a ); 297 is($c, scalar(@b)); 298 299 is(scalar @b, 4); 300 301 ok(length($b[3]) == 1 && $b[3] eq "\x{263A}"); 302 303 $a =~ s/^A/Z/; 304 ok(length($a) == 4 && $a eq "ZBC\x{263A}"); 305} 306 307{ 308 my @a = split(/\xFE/, "\xFF\xFE\xFD"); 309 my $b = split(/\xFE/, "\xFF\xFE\xFD"); 310 311 ok(@a == 2 && $a[0] eq "\xFF" && $a[1] eq "\xFD"); 312 is($b, scalar(@a)); 313} 314 315{ 316 # check that PMf_WHITE is cleared after \s+ is used 317 # reported in <20010627113312.RWGY6087.viemta06@localhost> 318 my $r; 319 foreach my $pat ( qr/\s+/, qr/ll/ ) { 320 $r = join ':' => split($pat, "hello cruel world"); 321 } 322 is($r, "he:o cruel world"); 323} 324 325 326{ 327 # split /(A)|B/, "1B2" should return (1, undef, 2) 328 my @x = split /(A)|B/, "1B2"; 329 my $y = split /(A)|B/, "1B2"; 330 is($y, scalar(@x)); 331 ok($x[0] eq '1' and (not defined $x[1]) and $x[2] eq '2'); 332} 333 334{ 335 # [perl #17064] 336 my $warn; 337 local $SIG{__WARN__} = sub { $warn = join '', @_; chomp $warn }; 338 my $char = "\x{10f1ff}"; 339 my @a = split /\r?\n/, "$char\n"; 340 my $b = split /\r?\n/, "$char\n"; 341 is($b, scalar(@a)); 342 ok(@a == 1 && $a[0] eq $char && !defined($warn)); 343} 344 345{ 346 # [perl #18195] 347 for my $u (0, 1) { 348 for my $a (0, 1) { 349 $_ = 'readin,database,readout'; 350 utf8::upgrade $_ if $u; 351 /(.+)/; 352 my @d = split /[,]/,$1; 353 my $e = split /[,]/,$1; 354 is($e, scalar(@d)); 355 is(join (':',@d), 'readin:database:readout', "[perl #18195]"); 356 } 357 } 358} 359 360{ 361 $p="a,b"; 362 utf8::upgrade $p; 363 eval { @a=split(/[, ]+/,$p) }; 364 eval { $b=split(/[, ]+/,$p) }; 365 is($b, scalar(@a)); 366 is ("$@-@a-", '-a b-', '#20912 - split() to array with /[]+/ and utf8'); 367} 368 369{ 370 # LATIN SMALL LETTER A WITH DIAERESIS, CYRILLIC SMALL LETTER I 371 for my $pattern ("\N{U+E4}", "\x{0437}") { 372 utf8::upgrade $pattern; 373 my @res; 374 for my $str ("a${pattern}b", "axb", "a${pattern}b") { 375 @split = split /$pattern/, $str; 376 push @res, scalar(@split); 377 } 378 is($res[0], 2); 379 is($res[1], 1); 380 is($res[2], 2, '#123469 - split with utf8 pattern after handling non-utf8 EXPR'); 381 } 382} 383 384{ 385 is (\@a, \@{"a"}, '@a must be global for following test'); 386 $p=""; 387 $n = @a = split /,/,$p; 388 is ($n, 0, '#21765 - pmreplroot hack used to return undef for 0 iters'); 389} 390 391{ 392 # [perl #28938] 393 # assigning off the end of the array after a split could leave garbage 394 # in the inner elements 395 396 my $x; 397 @a = split /,/, ',,,,,'; 398 $a[3]=1; 399 $x = \$a[2]; 400 is (ref $x, 'SCALAR', '#28938 - garbage after extend'); 401} 402 403{ 404 my $src = "ABC \0 FOO \0 XYZ"; 405 my @s = split(" \0 ", $src); 406 my @r = split(/ \0 /, $src); 407 my $cs = split(" \0 ", $src); 408 my $cr = split(/ \0 /, $src); 409 is(scalar(@s), 3); 410 is($cs, 3); 411 is($cr, 3); 412 is($s[0], "ABC"); 413 is($s[1], "FOO"); 414 is($s[2]," XYZ"); 415 is(join(':',@s), join(':',@r)); 416} 417 418{ 419 use constant BANG => {}; 420 () = split m/,/, "", BANG; 421 ok(1); 422} 423 424{ 425 # Bug #69875 426 # 'Hybrid' scalar-and-array context 427 scalar(our @PATH = split /::/, "Font::GlyphNames"); 428 # 'my' doesn't trigger the bug 429 is "@PATH", "Font GlyphNames", "hybrid scalar-and-array context"; 430} 431 432{ 433 my @results; 434 my $expr= "foo bar"; 435 my $cond; 436 437 @results= split(0||" ", $expr); 438 is @results, 2, 'split(0||" ") is treated like split(" ")'; #' 439 440 $cond= 0; 441 @results= split $cond ? " " : qr/ /, $expr; 442 is @results, 3, 'split($cond ? " " : qr/ /, $expr) works as expected (like qr/ /)'; 443 $cond= 1; 444 @results= split $cond ? " " : qr/ /, $expr; 445 is @results, 2, 'split($cond ? " " : qr/ /, $expr) works as expected (like " ")'; 446 447 $expr = ' a b c '; 448 @results = split /\s/, $expr; 449 is @results, 4, 450 "split on regex of single space metacharacter: captured 4 elements"; 451 is $results[0], '', 452 "split on regex of single space metacharacter: first element is empty string"; 453 454 @results = split / /, $expr; 455 is @results, 4, 456 "split on regex of single whitespace: captured 4 elements"; 457 is $results[0], '', 458 "split on regex of single whitespace: first element is empty string"; 459 460 @results = split " ", $expr; 461 is @results, 3, 462 "split on string of single whitespace: captured 3 elements"; 463 is $results[0], 'a', 464 "split on string of single whitespace: first element is non-empty"; 465 466 $expr = " a \tb c "; 467 @results = split " ", $expr; 468 is @results, 3, 469 "split on string of single whitespace: captured 3 elements"; 470 is $results[0], 'a', 471 "split on string of single whitespace: first element is non-empty; multiple contiguous space characters"; 472 473 my @seq; 474 for my $cond (0,1,0,1,0) { 475 $expr = " foo "; 476 @results = split $cond ? qr/ / : " ", $expr; 477 push @seq, scalar(@results) . ":" . $results[-1]; 478 } 479 is join(" ", @seq), "1:foo 3:foo 1:foo 3:foo 1:foo", 480 qq{split(\$cond ? qr/ / : " ", "$exp") behaves as expected over repeated similar patterns}; 481} 482 483SKIP: { 484 # RT #130907: unicode_strings feature doesn't work with split ' ' 485 486 my ($sp) = grep /\s/u, map chr, reverse 128 .. 255 # prefer \xA0 over \x85 487 or skip 'no unicode whitespace found in high-8-bit range', 9; 488 489 for (["$sp$sp. /", "leading unicode whitespace"], 490 [".$sp$sp/", "unicode whitespace separator"], 491 [". /$sp$sp", "trailing unicode whitespace"]) { 492 my ($str, $desc) = @$_; 493 use feature "unicode_strings"; 494 my @got = split " ", $str; 495 is @got, 2, "whitespace split: $desc: field count"; 496 is $got[0], '.', "whitespace split: $desc: field 0"; 497 is $got[1], '/', "whitespace split: $desc: field 1"; 498 } 499} 500 501{ 502 # 'RT #116086: split "\x20" does not work as documented'; 503 my @results; 504 my $expr; 505 $expr = ' a b c '; 506 @results = split uni_to_native("\x20"), $expr; 507 is @results, 3, 508 "RT #116086: split on string of single hex-20: captured 3 elements"; 509 is $results[0], 'a', 510 "RT #116086: split on string of single hex-20: first element is non-empty"; 511 512 $expr = " a \tb c "; 513 @results = split uni_to_native("\x20"), $expr; 514 is @results, 3, 515 "RT #116086: split on string of single hex-20: captured 3 elements"; 516 is $results[0], 'a', 517 "RT #116086: split on string of single hex-20: first element is non-empty; multiple contiguous space characters"; 518} 519 520# Nasty interaction between split and use constant 521use constant nought => 0; 522($a,$b,$c) = split //, $foo, nought; 523is nought, 0, 'split does not mangle 0 constants'; 524 525*aaa = *bbb; 526$aaa[1] = "foobarbaz"; 527$aaa[1] .= ""; 528@aaa = split //, $bbb[1]; 529is "@aaa", "f o o b a r b a z", 530 'split-to-array does not free its own argument'; 531 532() = @a = split //, "abc"; 533is "@a", "a b c", '() = split-to-array'; 534 535(@a = split //, "abc") = 1..10; 536is "@a", '1 2 3', 'assignment to split-to-array (pmtarget/package array)'; 537{ 538 my @a; 539 (@a = split //, "abc") = 1..10; 540 is "@a", '1 2 3', 'assignment to split-to-array (targ/lexical)'; 541} 542(@{\@a} = split //, "abc") = 1..10; 543is "@a", '1 2 3', 'assignment to split-to-array (stacked)'; 544 545# check that re-evals work 546 547{ 548 my $c = 0; 549 @a = split /-(?{ $c++ })/, "a-b-c"; 550 is "@a", "a b c", "compile-time re-eval"; 551 is $c, 2, "compile-time re-eval count"; 552 553 my $sep = '-'; 554 $c = 0; 555 @a = split /$sep(?{ $c++ })/, "a-b-c"; 556 is "@a", "a b c", "run-time re-eval"; 557 is $c, 2, "run-time re-eval count"; 558} 559 560# check that my/local @array = split works 561 562{ 563 my $s = "a:b:c"; 564 565 local @a = qw(x y z); 566 { 567 local @a = split /:/, $s; 568 is "@a", "a b c", "local split inside"; 569 } 570 is "@a", "x y z", "local split outside"; 571 572 my @b = qw(x y z); 573 { 574 my @b = split /:/, $s; 575 is "@b", "a b c", "my split inside"; 576 } 577 is "@b", "x y z", "my split outside"; 578} 579 580# check that the (@a = split) optimisation works in scalar/list context 581 582{ 583 my $s = "a:b:c:d:e"; 584 my @outer; 585 my $outer; 586 my @lex; 587 local our @pkg; 588 589 $outer = (@lex = split /:/, $s); 590 is "@lex", "a b c d e", "array split: scalar cx lex: inner"; 591 is $outer, 5, "array split: scalar cx lex: outer"; 592 593 @outer = (@lex = split /:/, $s); 594 is "@lex", "a b c d e", "array split: list cx lex: inner"; 595 is "@outer", "a b c d e", "array split: list cx lex: outer"; 596 597 $outer = (@pkg = split /:/, $s); 598 is "@pkg", "a b c d e", "array split: scalar cx pkg inner"; 599 is $outer, 5, "array split: scalar cx pkg outer"; 600 601 @outer = (@pkg = split /:/, $s); 602 is "@pkg", "a b c d e", "array split: list cx pkg inner"; 603 is "@outer", "a b c d e", "array split: list cx pkg outer"; 604 605 $outer = (my @a1 = split /:/, $s); 606 is "@a1", "a b c d e", "array split: scalar cx my lex: inner"; 607 is $outer, 5, "array split: scalar cx my lex: outer"; 608 609 @outer = (my @a2 = split /:/, $s); 610 is "@a2", "a b c d e", "array split: list cx my lex: inner"; 611 is "@outer", "a b c d e", "array split: list cx my lex: outer"; 612 613 $outer = (local @pkg = split /:/, $s); 614 is "@pkg", "a b c d e", "array split: scalar cx local pkg inner"; 615 is $outer, 5, "array split: scalar cx local pkg outer"; 616 617 @outer = (local @pkg = split /:/, $s); 618 is "@pkg", "a b c d e", "array split: list cx local pkg inner"; 619 is "@outer", "a b c d e", "array split: list cx local pkg outer"; 620 621 $outer = (@{\@lex} = split /:/, $s); 622 is "@lex", "a b c d e", "array split: scalar cx lexref inner"; 623 is $outer, 5, "array split: scalar cx lexref outer"; 624 625 @outer = (@{\@pkg} = split /:/, $s); 626 is "@pkg", "a b c d e", "array split: list cx pkgref inner"; 627 is "@outer", "a b c d e", "array split: list cx pkgref outer"; 628 629 630} 631 632# splitting directly to an array wasn't filling unused AvARRAY slots with 633# NULL 634 635{ 636 my @a; 637 @a = split(/-/,"-"); 638 $a[1] = 'b'; 639 ok eval { $a[0] = 'a'; 1; }, "array split filling AvARRAY: assign 0"; 640 is "@a", "a b", "array split filling AvARRAY: result"; 641} 642 643# splitting an empty utf8 string gave an assert failure 644{ 645 my $s = "\x{100}"; 646 chop $s; 647 my @a = split ' ', $s; 648 is (+@a, 0, "empty utf8 string"); 649} 650 651fresh_perl_is(<<'CODE', '', {}, "scalar split stack overflow"); 652map{int"";split//.0>60for"0000000000000000"}split// for"00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000" 653CODE 654 655# RT #132334: /o modifier no longer has side effects on split 656{ 657 my @records = ( 658 { separator => '0', effective => '', text => 'ab' }, 659 { separator => ';', effective => ';', text => 'a;b' }, 660 ); 661 662 for (@records) { 663 my ($separator, $effective, $text) = @$_{qw(separator effective text)}; 664 $separator =~ s/0//o; 665 is($separator,$effective,"Going to split '$text' with '$separator'"); 666 my @result = split($separator,$text); 667 ok(eq_array(\@result,['a','b']), "Resulting in ('a','b')"); 668 } 669} 670