In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/594c64d48c897be7522145d9f634599aae38b149?hp=d681dfadbe84f87244e6602d414cdb00dce19f95>
- Log ----------------------------------------------------------------- commit 594c64d48c897be7522145d9f634599aae38b149 Author: Yves Orton <[email protected]> Date: Sun Sep 13 20:16:07 2009 +0200 much simpler .gitignore for ext/ .gitignores are advisory, they affect the "Untracked files" list and the behaviour of git add $path, and nothing else. A tracked file is tracked, and explicitly adding a file overrules any .gitignore file, so we can make the ext/.gitignore quite restrictive, and assume that any changes will be done by something that will explicitly add the required files. M ext/.gitignore commit c1a7495a9639962ce446532c71ba34cb952935b4 Author: Bo Borgerson <[email protected]> Date: Wed Aug 26 13:03:02 2009 -0400 split: Improve performance in scalar context Improve the performance of split in scalar context M pp.c M t/op/split.t commit a6d8037e26aaceac1a62ab1a36249ff12386c7ff Author: Bo Borgerson <[email protected]> Date: Wed Aug 26 09:47:33 2009 -0400 split: Remove implicit split to @_ Remove the long deprecated feature where split in scalar context writes to @_ M op.c M pod/perldiag.pod M pod/perlfunc.pod M pp.c M t/lib/warnings/op M t/re/pat.t M t/run/fresh_perl.t ----------------------------------------------------------------------- Summary of changes: ext/.gitignore | 116 +++---------------------------------- op.c | 12 +---- pod/perldiag.pod | 6 -- pod/perlfunc.pod | 5 +- pp.c | 164 +++++++++++++++++++++++++++++++++++++-------------- t/lib/warnings/op | 22 ------- t/op/split.t | 98 +++++++++++++++++++++++++++++++- t/re/pat.t | 4 +- t/run/fresh_perl.t | 4 +- 9 files changed, 230 insertions(+), 201 deletions(-) diff --git a/ext/.gitignore b/ext/.gitignore index c80e6ad..7525886 100644 --- a/ext/.gitignore +++ b/ext/.gitignore @@ -1,109 +1,9 @@ -# ignore generated .c files, and other module build traces -*.c -*.bs -blib -pm_to_blib -Makefile -ppport.h -!/Devel-PPPort/module2.c -!/Devel-PPPort/module3.c -!/File-Glob/bsd_glob.c -!/XS-APItest/core.c -!/XS-APItest/exception.c -!/XS-APItest/notcore.c -!/XS-Typemap/stdio.c -/Archive-Extract/Makefile.PL -/Attribute-Handlers/Makefile.PL -/attributes/Makefile.PL -/autodie/Makefile.PL -/AutoLoader/Makefile.PL -/autouse/Makefile.PL -/base/Makefile.PL -/bignum/Makefile.PL -/B-Debug/Makefile.PL -/B-Deparse/Makefile.PL -/B-Lint/Makefile.PL -/CGI/Makefile.PL -/constant/Makefile.PL -/Class-ISA/Makefile.PL -/CPANPLUS-Dist-Build/Makefile.PL -/Data-Dumper/Makefile.PL -/Digest/Makefile.PL -/Devel-SelfStubber/Makefile.PL -/encoding-warnings/Makefile.PL -/ExtUtils-CBuilder/Makefile.PL -/ExtUtils-Command/Makefile.PL -/ExtUtils-Constant/Makefile.PL -/ExtUtils-Install/Makefile.PL -/ExtUtils-Manifest/Makefile.PL -/ExtUtils-MakeMaker/Makefile.PL -/ExtUtils-ParseXS/Makefile.PL -/FileCache/Makefile.PL -/File-Fetch/Makefile.PL -/File-Path/Makefile.PL -/File-Temp/Makefile.PL -/Filter-Simple/Makefile.PL -/Filter-Util-Call/Makefile.PL -/Hash-Util-FieldHash/Makefile.PL -/I18N-LangTags/Makefile.PL -/if/Makefile.PL -/IO-Zlib/Makefile.PL -/IPC-Cmd/Makefile.PL -/IPC-Open2/Makefile.PL -/IPC-Open3/Makefile.PL -/Locale-Maketext/Makefile.PL -/Locale-Maketext-Simple/Makefile.PL -/Log-Message/Makefile.PL -/Log-Message-Simple/Makefile.PL -/Math-BigInt/Makefile.PL -/Math-BigInt-FastCalc/Makefile.PL -/Math-BigRat/Makefile.PL -/Math-Complex/Makefile.PL -/Memoize/Makefile.PL -/Module-Build/Makefile.PL -/Module-Load/Makefile.PL -/Module-Load-Conditional/Makefile.PL -/Module-Loaded/Makefile.PL -/mro/Makefile.PL -/Net-Ping/Makefile.PL -/NEXT/Makefile.PL -/Object-Accessor/Makefile.PL -/Opcode/Makefile.PL -/Package-Constants/Makefile.PL -/Params-Check/Makefile.PL -/parent/Makefile.PL -/Parse-CPAN-Meta/Makefile.PL -/PerlIO-encoding/Makefile.PL -/PerlIO-scalar/Makefile.PL -/PerlIO-via/Makefile.PL -/PerlIO-via-QuotedPrint/Makefile.PL -/Pod-Escapes/Makefile.PL -/Pod-LaTeX/Makefile.PL -/Pod-Parser/Makefile.PL -/Pod-Perldoc/Makefile.PL -/Pod-Plainer/Makefile.PL -/Pod-Simple/Makefile.PL -/SelfLoader/Makefile.PL -/Shell/Makefile.PL -/Switch/Makefile.PL -/Sys-Hostname/Makefile.PL -/Term-ANSIColor/Makefile.PL -/Term-Cap/Makefile.PL -/Term-UI/Makefile.PL -/Test-Harness/Makefile.PL -/Test/Makefile.PL -/Text-Balanced/Makefile.PL -/Text-ParseWords/Makefile.PL -/Text-Soundex/Makefile.PL -/Text-Tabs/Makefile.PL -/Thread-Queue/Makefile.PL -/Thread-Semaphore/Makefile.PL -/Tie-File/Makefile.PL -/Tie-Memoize/Makefile.PL -/Tie-RefHash/Makefile.PL -/Time-Local/Makefile.PL -/Unicode-Collate/Makefile.PL +* +!*.pm +!*.pl +!*.xs +!*.t +!*.h +!*/t/* +!*/lib/* -# ignore all vim swap files but the one bundled in Module::Pluggable for testing -*.swp -!/Module-Pluggable/t/lib/EditorJunk/Plugin/Bar.pm.swp diff --git a/op.c b/op.c index c6f38fa..729c25f 100644 --- a/op.c +++ b/op.c @@ -872,12 +872,8 @@ Perl_scalar(pTHX_ OP *o) for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling) scalar(kid); break; - case OP_SPLIT: - if ((kid = cLISTOPo->op_first) && kid->op_type == OP_PUSHRE) { - if (!kPMOP->op_pmreplrootu.op_pmreplroot) - deprecate_old("implicit split to @_"); - } /* FALL THROUGH */ + case OP_SPLIT: case OP_MATCH: case OP_QR: case OP_SUBST: @@ -1191,12 +1187,6 @@ Perl_scalarvoid(pTHX_ OP *o) /* FALL THROUGH */ case OP_SCALAR: return scalar(o); - case OP_SPLIT: - if ((kid = cLISTOPo->op_first) && kid->op_type == OP_PUSHRE) { - if (!kPMOP->op_pmreplrootu.op_pmreplroot) - deprecate_old("implicit split to @_"); - } - break; } if (useless && ckWARN(WARN_VOID)) Perl_warner(aTHX_ packWARN(WARN_VOID), "Useless use of %s in void context", useless); diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 9447ba4..1f7bc0b 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -4742,12 +4742,6 @@ to access the filehandle slot within a typeglob. operator. Since C<split> always tries to match the pattern repeatedly, the C</g> has no effect. -=item Use of implicit split to @_ is deprecated - -(D deprecated, W syntax) It makes a lot of work for the compiler when you -clobber a subroutine's argument list, so it's better if you assign the results -of a split() explicitly to an array (or list). - =item Use of inherited AUTOLOAD for non-method %s() is deprecated (D deprecated) As an (ahem) accidental feature, C<AUTOLOAD> subroutines diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index fd28b00..776aaf2 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -5471,10 +5471,7 @@ Splits the string EXPR into a list of strings and returns that list. By default, empty leading fields are preserved, and empty trailing ones are deleted. (If all fields are empty, they are considered to be trailing.) -In scalar context, returns the number of fields found. In scalar and void -context it splits into the C<@_> array. Use of split in scalar and void -context is deprecated, however, because it clobbers your subroutine -arguments. +In scalar context, returns the number of fields found. If EXPR is omitted, splits the C<$_> string. If PATTERN is also omitted, splits on whitespace (after skipping any leading whitespace). Anything diff --git a/pp.c b/pp.c index 930bc53..e3b7798 100644 --- a/pp.c +++ b/pp.c @@ -4882,11 +4882,13 @@ PP(pp_split) I32 iters = 0; const STRLEN slen = do_utf8 ? utf8_length((U8*)s, (U8*)strend) : (STRLEN)(strend - s); I32 maxiters = slen + 10; + I32 trailing_empty = 0; const char *orig; const I32 origlimit = limit; I32 realarray = 0; I32 base; const I32 gimme = GIMME_V; + const bool gimme_scalar = (GIMME_V == G_SCALAR); const I32 oldsave = PL_savestack_ix; U32 make_mortal = SVs_TEMP; bool multiline = 0; @@ -4915,8 +4917,6 @@ PP(pp_split) ary = GvAVn(pm->op_pmreplrootu.op_pmtargetgv); } #endif - else if (gimme != G_ARRAY) - ary = GvAVn(PL_defgv); else ary = NULL; if (ary && (gimme != G_ARRAY || (pm->op_pmflags & PMf_ONCE))) { @@ -4987,9 +4987,17 @@ PP(pp_split) if (m >= strend) break; - dstr = newSVpvn_flags(s, m-s, - (do_utf8 ? SVf_UTF8 : 0) | make_mortal); - XPUSHs(dstr); + if (gimme_scalar) { + iters++; + if (m-s == 0) + trailing_empty++; + else + trailing_empty = 0; + } else { + dstr = newSVpvn_flags(s, m-s, + (do_utf8 ? SVf_UTF8 : 0) | make_mortal); + XPUSHs(dstr); + } /* skip the whitespace found last */ if (do_utf8) @@ -5017,9 +5025,18 @@ PP(pp_split) m++; if (m >= strend) break; - dstr = newSVpvn_flags(s, m-s, - (do_utf8 ? SVf_UTF8 : 0) | make_mortal); - XPUSHs(dstr); + + if (gimme_scalar) { + iters++; + if (m-s == 0) + trailing_empty++; + else + trailing_empty = 0; + } else { + dstr = newSVpvn_flags(s, m-s, + (do_utf8 ? SVf_UTF8 : 0) | make_mortal); + XPUSHs(dstr); + } s = m; } } @@ -5032,34 +5049,49 @@ PP(pp_split) or split //, $str, $i; */ - const U32 items = limit - 1; - if (items < slen) - EXTEND(SP, items); - else - EXTEND(SP, slen); + if (!gimme_scalar) { + const U32 items = limit - 1; + if (items < slen) + EXTEND(SP, items); + else + EXTEND(SP, slen); + } if (do_utf8) { while (--limit) { /* keep track of how many bytes we skip over */ m = s; s += UTF8SKIP(s); - dstr = newSVpvn_flags(m, s-m, SVf_UTF8 | make_mortal); + if (gimme_scalar) { + iters++; + if (s-m == 0) + trailing_empty++; + else + trailing_empty = 0; + } else { + dstr = newSVpvn_flags(m, s-m, SVf_UTF8 | make_mortal); - PUSHs(dstr); + PUSHs(dstr); + } if (s >= strend) break; } } else { while (--limit) { - dstr = newSVpvn(s, 1); + if (gimme_scalar) { + iters++; + } else { + dstr = newSVpvn(s, 1); - s++; - if (make_mortal) - sv_2mortal(dstr); + if (make_mortal) + sv_2mortal(dstr); - PUSHs(dstr); + PUSHs(dstr); + } + + s++; if (s >= strend) break; @@ -5081,9 +5113,17 @@ PP(pp_split) ; if (m >= strend) break; - dstr = newSVpvn_flags(s, m-s, - (do_utf8 ? SVf_UTF8 : 0) | make_mortal); - XPUSHs(dstr); + if (gimme_scalar) { + iters++; + if (m-s == 0) + trailing_empty++; + else + trailing_empty = 0; + } else { + dstr = newSVpvn_flags(s, m-s, + (do_utf8 ? SVf_UTF8 : 0) | make_mortal); + XPUSHs(dstr); + } /* The rx->minlen is in characters but we want to step * s ahead by bytes. */ if (do_utf8) @@ -5097,9 +5137,17 @@ PP(pp_split) (m = fbm_instr((unsigned char*)s, (unsigned char*)strend, csv, multiline ? FBMrf_MULTILINE : 0)) ) { - dstr = newSVpvn_flags(s, m-s, - (do_utf8 ? SVf_UTF8 : 0) | make_mortal); - XPUSHs(dstr); + if (gimme_scalar) { + iters++; + if (m-s == 0) + trailing_empty++; + else + trailing_empty = 0; + } else { + dstr = newSVpvn_flags(s, m-s, + (do_utf8 ? SVf_UTF8 : 0) | make_mortal); + XPUSHs(dstr); + } /* The rx->minlen is in characters but we want to step * s ahead by bytes. */ if (do_utf8) @@ -5129,9 +5177,18 @@ PP(pp_split) strend = s + (strend - m); } m = RX_OFFS(rx)[0].start + orig; - dstr = newSVpvn_flags(s, m-s, - (do_utf8 ? SVf_UTF8 : 0) | make_mortal); - XPUSHs(dstr); + + if (gimme_scalar) { + iters++; + if (m-s == 0) + trailing_empty++; + else + trailing_empty = 0; + } else { + dstr = newSVpvn_flags(s, m-s, + (do_utf8 ? SVf_UTF8 : 0) | make_mortal); + XPUSHs(dstr); + } if (RX_NPARENS(rx)) { I32 i; for (i = 1; i <= (I32)RX_NPARENS(rx); i++) { @@ -5141,37 +5198,54 @@ PP(pp_split) /* japhy (07/27/01) -- the (m && s) test doesn't catch parens that didn't match -- they should be set to undef, not the empty string */ - if (m >= orig && s >= orig) { - dstr = newSVpvn_flags(s, m-s, - (do_utf8 ? SVf_UTF8 : 0) - | make_mortal); + if (gimme_scalar) { + iters++; + if (m-s == 0) + trailing_empty++; + else + trailing_empty = 0; + } else { + if (m >= orig && s >= orig) { + dstr = newSVpvn_flags(s, m-s, + (do_utf8 ? SVf_UTF8 : 0) + | make_mortal); + } + else + dstr = &PL_sv_undef; /* undef, not "" */ + XPUSHs(dstr); } - else - dstr = &PL_sv_undef; /* undef, not "" */ - XPUSHs(dstr); + } } s = RX_OFFS(rx)[0].end + orig; } } - iters = (SP - PL_stack_base) - base; + if (!gimme_scalar) { + iters = (SP - PL_stack_base) - base; + } if (iters > maxiters) DIE(aTHX_ "Split loop"); /* keep field after final delim? */ if (s < strend || (iters && origlimit)) { - const STRLEN l = strend - s; - dstr = newSVpvn_flags(s, l, (do_utf8 ? SVf_UTF8 : 0) | make_mortal); - XPUSHs(dstr); + if (!gimme_scalar) { + const STRLEN l = strend - s; + dstr = newSVpvn_flags(s, l, (do_utf8 ? SVf_UTF8 : 0) | make_mortal); + XPUSHs(dstr); + } iters++; } else if (!origlimit) { - while (iters > 0 && (!TOPs || !SvANY(TOPs) || SvCUR(TOPs) == 0)) { - if (TOPs && !make_mortal) - sv_2mortal(TOPs); - iters--; - *SP-- = &PL_sv_undef; + if (gimme_scalar) { + iters -= trailing_empty; + } else { + while (iters > 0 && (!TOPs || !SvANY(TOPs) || SvCUR(TOPs) == 0)) { + if (TOPs && !make_mortal) + sv_2mortal(TOPs); + *SP-- = &PL_sv_undef; + iters--; + } } } diff --git a/t/lib/warnings/op b/t/lib/warnings/op index 681ec16..0891bd8 100644 --- a/t/lib/warnings/op +++ b/t/lib/warnings/op @@ -3,12 +3,6 @@ Found = in conditional, should be == 1 if $a = 1 ; - Use of implicit split to @_ is deprecated - split ; - - Use of implicit split to @_ is deprecated - $a = split ; - Useless use of time in void context Useless use of a variable in void context Useless use of a constant in void context @@ -112,22 +106,6 @@ EXPECT Found = in conditional, should be == at - line 3. ######## # op.c -use warnings 'deprecated' ; -split ; -no warnings 'deprecated' ; -split ; -EXPECT -Use of implicit split to @_ is deprecated at - line 3. -######## -# op.c -use warnings 'deprecated' ; -$a = split ; -no warnings 'deprecated' ; -$a = split ; -EXPECT -Use of implicit split to @_ is deprecated at - line 3. -######## -# op.c use warnings 'deprecated'; my (@foo, %foo); %main::foo->{"bar"}; diff --git a/t/op/split.t b/t/op/split.t index b3a9741..6b38b43 100644 --- a/t/op/split.t +++ b/t/op/split.t @@ -6,7 +6,7 @@ BEGIN { require './test.pl'; } -plan tests => 136; +plan tests => 250; $FS = ':'; @@ -17,37 +17,61 @@ $_ = 'a:b:c'; is(join(';',$a,$b,$c), 'a;b;c'); @ary = split(/:b:/); +$cnt = split(/:b:/); is(join("$_",@ary), 'aa:b:cc'); +is($cnt, scalar(@ary)); $_ = "abc\n"; my @xyz = (@ary = split(//)); +$cnt = split(//); is(join(".",@ary), "a.b.c.\n"); +is($cnt, scalar(@ary)); $_ = "a:b:c::::"; @ary = split(/:/); +$cnt = split(/:/); is(join(".",@ary), "a.b.c"); +is($cnt, scalar(@ary)); $_ = join(':',split(' '," a b\tc \t d ")); is($_, 'a:b:c:d'); +...@ary = split(' '," a b\tc \t d "); +$cnt = split(' '," a b\tc \t d "); +is($cnt, scalar(@ary)); $_ = join(':',split(/ */,"foo bar bie\tdoll")); is($_ , "f:o:o:b:a:r:b:i:e:\t:d:o:l:l"); +...@ary = split(/ */,"foo bar bie\tdoll"); +$cnt = split(/ */,"foo bar bie\tdoll"); +is($cnt, scalar(@ary)); $_ = join(':', 'foo', split(/ /,'a b c'), 'bar'); is($_, "foo:a:b::c:bar"); +...@ary = split(/ /,'a b c'); +$cnt = split(/ /,'a b c'); +is($cnt, scalar(@ary)); # Can we say how many fields to split to? $_ = join(':', split(' ','1 2 3 4 5 6', 3)); is($_, '1:2:3 4 5 6'); +...@ary = split(' ','1 2 3 4 5 6', 3); +$cnt = split(' ','1 2 3 4 5 6', 3); +is($cnt, scalar(@ary)); # Can we do it as a variable? $x = 4; $_ = join(':', split(' ','1 2 3 4 5 6', $x)); is($_, '1:2:3:4 5 6'); +...@ary = split(' ','1 2 3 4 5 6', $x); +$cnt = split(' ','1 2 3 4 5 6', $x); +is($cnt, scalar(@ary)); # Does the 999 suppress null field chopping? $_ = join(':', split(/:/,'1:2:3:4:5:6:::', 999)); is($_ , '1:2:3:4:5:6:::'); +...@ary = split(/:/,'1:2:3:4:5:6:::', 999); +$cnt = split(/:/,'1:2:3:4:5:6:::', 999); +is($cnt, scalar(@ary)); # Does assignment to a list imply split to one more field than that? $foo = runperl( switches => ['-Dt'], stderr => 1, prog => '($a,$b)=split;' ); @@ -61,10 +85,16 @@ is($_, '1:2 3 4 5 6'); # do subpatterns generate additional fields (without trailing nulls)? $_ = join '|', split(/,|(-)/, "1-10,20,,,"); is($_, "1|-|10||20"); +...@ary = split(/,|(-)/, "1-10,20,,,"); +$cnt = split(/,|(-)/, "1-10,20,,,"); +is($cnt, scalar(@ary)); # do subpatterns generate additional fields (with a limit)? $_ = join '|', split(/,|(-)/, "1-10,20,,,", 10); is($_, "1|-|10||20||||||"); +...@ary = split(/,|(-)/, "1-10,20,,,", 10); +$cnt = split(/,|(-)/, "1-10,20,,,", 10); +is($cnt, scalar(@ary)); # is the 'two undefs' bug fixed? (undef, $a, undef, $b) = qw(1 2 3 4); @@ -79,40 +109,69 @@ is("$a|$b", "2|4"); # check splitting of null string $_ = join('|', split(/x/, '',-1), 'Z'); is($_, "Z"); +...@ary = split(/x/, '',-1); +$cnt = split(/x/, '',-1); +is($cnt, scalar(@ary)); $_ = join('|', split(/x/, '', 1), 'Z'); is($_, "Z"); +...@ary = split(/x/, '', 1); +$cnt = split(/x/, '', 1); +is($cnt, scalar(@ary)); $_ = join('|', split(/(p+)/,'',-1), 'Z'); is($_, "Z"); +...@ary = split(/(p+)/,'',-1); +$cnt = split(/(p+)/,'',-1); +is($cnt, scalar(@ary)); $_ = join('|', split(/.?/, '',-1), 'Z'); is($_, "Z"); +...@ary = split(/.?/, '',-1); +$cnt = split(/.?/, '',-1); +is($cnt, scalar(@ary)); # Are /^/m patterns scanned? $_ = join '|', split(/^a/m, "a b a\na d a", 20); is($_, "| b a\n| d a"); +...@ary = split(/^a/m, "a b a\na d a", 20); +$cnt = split(/^a/m, "a b a\na d a", 20); +is($cnt, scalar(@ary)); # Are /$/m patterns scanned? $_ = join '|', split(/a$/m, "a b a\na d a", 20); is($_, "a b |\na d |"); +...@ary = split(/a$/m, "a b a\na d a", 20); +$cnt = split(/a$/m, "a b a\na d a", 20); +is($cnt, scalar(@ary)); # Are /^/m patterns scanned? $_ = join '|', split(/^aa/m, "aa b aa\naa d aa", 20); is($_, "| b aa\n| d aa"); +...@ary = split(/^aa/m, "aa b aa\naa d aa", 20); +$cnt = split(/^aa/m, "aa b aa\naa d aa", 20); +is($cnt, scalar(@ary)); # Are /$/m patterns scanned? $_ = join '|', split(/aa$/m, "aa b aa\naa d aa", 20); is($_, "aa b |\naa d |"); +...@ary = split(/aa$/m, "aa b aa\naa d aa", 20); +$cnt = split(/aa$/m, "aa b aa\naa d aa", 20); +is($cnt, scalar(@ary)); # Greedyness: $_ = "a : b :c: d"; @ary = split(/\s*:\s*/); +$cnt = split(/\s*:\s*/); is(($res = join(".",@ary)), "a.b.c.d", $res); +is($cnt, scalar(@ary)); # use of match result as pattern (!) is('p:q:r:s', join ':', split('abc' =~ /b/, 'p1q1r1s')); +...@ary = split('abc' =~ /b/, 'p1q1r1s'); +$cnt = split('abc' =~ /b/, 'p1q1r1s'); +is($cnt, scalar(@ary)); # /^/ treated as /^/m $_ = join ':', split /^/, "ab\ncd\nef\n"; @@ -128,18 +187,26 @@ ok(@list1 == @list2 && # zero-width assertion $_ = join ':', split /(?=\w)/, "rm b"; is($_, "r:m :b"); +...@ary = split /(?=\w)/, "rm b"; +$cnt = split /(?=\w)/, "rm b"; +is($cnt, scalar(@ary)); # unicode splittage @ary = map {ord} split //, v1.20.300.4000.50000.4000.300.20.1; +$cnt = split //, v1.20.300.4000.50000.4000.300.20.1; is("@ary", "1 20 300 4000 50000 4000 300 20 1"); +is($cnt, scalar(@ary)); @ary = split(/\x{FE}/, "\x{FF}\x{FE}\x{FD}"); # bug id 20010105.016 +$cnt = split(/\x{FE}/, "\x{FF}\x{FE}\x{FD}"); # bug id 20010105.016 ok(@ary == 2 && $ary[0] eq "\xFF" && $ary[1] eq "\xFD" && $ary[0] eq "\x{FF}" && $ary[1] eq "\x{FD}"); +is($cnt, scalar(@ary)); @ary = split(/(\x{FE}\xFE)/, "\xFF\x{FF}\xFE\x{FE}\xFD\x{FD}"); # variant of 31 +$cnt = split(/(\x{FE}\xFE)/, "\xFF\x{FF}\xFE\x{FE}\xFD\x{FD}"); # variant of 31 ok(@ary == 3 && $ary[0] eq "\xFF\xFF" && $ary[0] eq "\x{FF}\xFF" && @@ -150,16 +217,21 @@ ok(@ary == 3 && $ary[2] eq "\xFD\xFD" && $ary[2] eq "\x{FD}\xFD" && $ary[2] eq "\x{FD}\x{FD}"); +is($cnt, scalar(@ary)); { my @a = map ord, split(//, join("", map chr, (1234, 123, 2345))); + my $c = split(//, join("", map chr, (1234, 123, 2345))); is("@a", "1234 123 2345"); + is($c, scalar(@a)); } { my $x = 'A'; my @a = map ord, split(/$x/, join("", map chr, (1234, ord($x), 2345))); + my $c = split(/$x/, join("", map chr, (1234, ord($x), 2345))); is("@a", "1234 2345"); + is($c, scalar(@a)); } { @@ -171,6 +243,8 @@ ok(@ary == 3 && my $sushi = "\x{b36c}\x{5a8c}\x{ff5b}\x{5079}\x{505b}"; my @charlist = split //, $sushi; + my $charnum = split //, $sushi; + is($charnum, scalar(@charlist)); my $r = ''; foreach my $ch (@charlist) { $r = $r . " " . sprintf "U+%04X", ord($ch); @@ -218,6 +292,8 @@ ok(@ary == 3 && my $a = "ABC\x{263A}"; my @b = split( //, $a ); + my $c = split( //, $a ); + is($c, scalar(@b)); is(scalar @b, 4); @@ -229,8 +305,10 @@ ok(@ary == 3 && { my @a = split(/\xFE/, "\xFF\xFE\xFD"); + my $b = split(/\xFE/, "\xFF\xFE\xFD"); ok(@a == 2 && $a[0] eq "\xFF" && $a[1] eq "\xFD"); + is($b, scalar(@a)); } { @@ -247,6 +325,8 @@ ok(@ary == 3 && { # split /(A)|B/, "1B2" should return (1, undef, 2) my @x = split /(A)|B/, "1B2"; + my $y = split /(A)|B/, "1B2"; + is($y, scalar(@x)); ok($x[0] eq '1' and (not defined $x[1]) and $x[2] eq '2'); } @@ -256,6 +336,8 @@ ok(@ary == 3 && local $SIG{__WARN__} = sub { $warn = join '', @_; chomp $warn }; my $char = "\x{10f1ff}"; my @a = split /\r?\n/, "$char\n"; + my $b = split /\r?\n/, "$char\n"; + is($b, scalar(@a)); ok(@a == 1 && $a[0] eq $char && !defined($warn)); } @@ -267,6 +349,8 @@ ok(@ary == 3 && utf8::upgrade $_ if $u; /(.+)/; my @d = split /[,]/,$1; + my $e = split /[,]/,$1; + is($e, scalar(@d)); is(join (':',@d), 'readin:database:readout', "[perl #18195]"); } } @@ -276,6 +360,8 @@ ok(@ary == 3 && $p="a,b"; utf8::upgrade $p; eval { @a=split(/[, ]+/,$p) }; + eval { $b=split(/[, ]+/,$p) }; + is($b, scalar(@a)); is ("$...@-@a-", '-a b-', '#20912 - split() to array with /[]+/ and utf8'); } @@ -335,16 +421,22 @@ ok(@ary == 3 && chop $str; my @res=split(/\s+/,$str); + my $cnt=split(/\s+/,$str); ok(@res == 2 && join('-',@res) eq "A:-:B", "$msg - /\\s+/"); + is($cnt, scalar(@res), "$msg - /\\s+/ (count)"); my $s2 = "$space$space:A:$space$space:B\x{FFFD}"; chop $s2; my @r2 = split(' ',$s2); + my $c2 = split(' ',$s2); ok(@r2 == 2 && join('-', @r2) eq ":A:-:B", "$msg - ' '"); + is($c2, scalar(@r2), "$msg - ' ' (count)"); my @r3 = split(/\s+/, $s2); + my $c3 = split(/\s+/, $s2); ok(@r3 == 3 && join('-', @r3) eq "-:A:-:B", "$msg - /\\s+/ No.2"); + is($c3, scalar(@r3), "$msg - /\\s+/ No.2 (count)"); } } @@ -352,7 +444,11 @@ ok(@ary == 3 && my $src = "ABC \0 FOO \0 XYZ"; my @s = split(" \0 ", $src); my @r = split(/ \0 /, $src); + my $cs = split(" \0 ", $src); + my $cr = split(/ \0 /, $src); is(scalar(@s), 3); + is($cs, 3); + is($cr, 3); is($s[0], "ABC"); is($s[1], "FOO"); is($s[2]," XYZ"); diff --git a/t/re/pat.t b/t/re/pat.t index 4f4c6f3..f84e07f 100644 --- a/t/re/pat.t +++ b/t/re/pat.t @@ -2386,8 +2386,8 @@ sub run_tests { local $Message = "(??{ .. }) in split doesn't corrupt its stack"; our $i; ok '-1-3-5-' eq join '', split /((??{$i++}))/, '-1-3-5-'; - no warnings 'deprecated', 'syntax'; - split /(?{'WOW'})/, 'abc'; + no warnings 'syntax'; + @_ = split /(?{'WOW'})/, 'abc'; local $" = "|"; iseq "@_", "a|b|c"; } diff --git a/t/run/fresh_perl.t b/t/run/fresh_perl.t index ce9ad5a..f22e170 100644 --- a/t/run/fresh_perl.t +++ b/t/run/fresh_perl.t @@ -57,7 +57,7 @@ foreach my $prog (@prgs) { __END__ ######## -$a = ":="; split /($a)/o, "a:=b:=c"; print "@_" +$a = ":="; @_ = split /($a)/o, "a:=b:=c"; print "@_" EXPECT a := b := c ######## @@ -345,7 +345,7 @@ map {#this newline here tickles the bug $s += $_} (1,2,4); print "eat flaming death\n" unless ($s == 7); ######## -sub foo { local $_ = shift; split; @_ } +sub foo { local $_ = shift; @_ = split; @_ } @x = foo(' x y z '); print "you die joe!\n" unless "@x" eq 'x y z'; ######## -- Perl5 Master Repository
