split was leaving PL_sv_undef in unused ary slots

[perl5.git] / t / op / split.t

diff --git a/t/op/split.t b/t/op/split.t
index bcefcfa..ceaea00 100644 (file)
--- a/t/op/split.t
+++ b/t/op/split.t
@@ -3,10 +3,11 @@
 BEGIN {
     chdir 't' if -d 't';
     require './test.pl';
+    require './charset_tools.pl';
     set_up_inc('../lib');
 }
 
-plan tests => 131;
+plan tests => 161;
 
 $FS = ':';
 
@@ -206,8 +207,8 @@ $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
+@ary = split(/\x{FE}/, "\x{FF}\x{FE}\x{FD}"); # bug id 20010105.016 (#5088)
+$cnt = split(/\x{FE}/, "\x{FF}\x{FE}\x{FD}"); # bug id 20010105.016 (#5088)
 ok(@ary == 2 &&
    $ary[0] eq "\xFF"   && $ary[1] eq "\xFD" &&
    $ary[0] eq "\x{FF}" && $ary[1] eq "\x{FD}");
@@ -243,7 +244,7 @@ is($cnt, scalar(@ary));
 }
 
 {
-    # bug id 20000427.003 
+    # bug id 20000427.003 (#3173) 
 
     use warnings;
     use strict;
@@ -264,15 +265,11 @@ is($cnt, scalar(@ary));
 {
     my $s = "\x20\x40\x{80}\x{100}\x{80}\x40\x20";
 
-  SKIP: {
-    if ($::IS_EBCDIC) {
-       skip("EBCDIC", 1);
-    } else {
-       # bug id 20000426.003
+  {
+       # bug id 20000426.003 (#3166)
 
        my ($a, $b, $c) = split(/\x40/, $s);
        ok($a eq "\x20" && $b eq "\x{80}\x{100}\x{80}" && $c eq $a);
-    }
   }
 
     my ($a, $b) = split(/\x{100}/, $s);
@@ -281,13 +278,9 @@ is($cnt, scalar(@ary));
     my ($a, $b) = split(/\x{80}\x{100}\x{80}/, $s);
     ok($a eq "\x20\x40" && $b eq "\x40\x20");
 
-  SKIP: {
-    if ($::IS_EBCDIC) {
-       skip("EBCDIC", 1);
-    }  else {
+  {
        my ($a, $b) = split(/\x40\x{80}/, $s);
        ok($a eq "\x20" && $b eq "\x{100}\x{80}\x40\x20");
-    }
   }
 
     my ($a, $b, $c) = split(/[\x40\x{80}]+/, $s);
@@ -295,7 +288,7 @@ is($cnt, scalar(@ary));
 }
 
 {
-    # 20001205.014
+    # 20001205.014 (#4844)
 
     my $a = "ABC\x{263A}";
 
@@ -492,16 +485,14 @@ is($cnt, scalar(@ary));
     my @results;
     my $expr;
     $expr = ' a b c ';
-    @results = split "\x20", $expr if $::IS_ASCII;
-    @results = split "\x40", $expr if $::IS_EBCDIC;
+    @results = split uni_to_native("\x20"), $expr;
     is @results, 3,
         "RT #116086: split on string of single hex-20: captured 3 elements";
     is $results[0], 'a',
         "RT #116086: split on string of single hex-20: first element is non-empty";
 
     $expr = " a \tb c ";
-    @results = split "\x20", $expr if $::IS_ASCII;
-    @results = split "\x40", $expr if $::IS_EBCDIC;
+    @results = split uni_to_native("\x20"), $expr;
     is @results, 3,
         "RT #116086: split on string of single hex-20: captured 3 elements";
     is $results[0], 'a',
@@ -532,3 +523,101 @@ is "@a", '1 2 3', 'assignment to split-to-array (pmtarget/package array)';
 }
 (@{\@a} = split //, "abc") = 1..10;
 is "@a", '1 2 3', 'assignment to split-to-array (stacked)';
+
+# check that re-evals work
+
+{
+    my $c = 0;
+    @a = split /-(?{ $c++ })/, "a-b-c";
+    is "@a", "a b c", "compile-time re-eval";
+    is $c, 2, "compile-time re-eval count";
+
+    my $sep = '-';
+    $c = 0;
+    @a = split /$sep(?{ $c++ })/, "a-b-c";
+    is "@a", "a b c", "run-time re-eval";
+    is $c, 2, "run-time re-eval count";
+}
+
+# check that that my/local @array = split works
+
+{
+    my $s = "a:b:c";
+
+    local @a = qw(x y z);
+    {
+        local @a = split /:/, $s;
+        is "@a", "a b c", "local split inside";
+    }
+    is "@a", "x y z", "local split outside";
+
+    my @b = qw(x y z);
+    {
+        my @b = split /:/, $s;
+        is "@b", "a b c", "my split inside";
+    }
+    is "@b", "x y z", "my split outside";
+}
+
+# check that the (@a = split) optimisation works in scalar/list context
+
+{
+    my $s = "a:b:c:d:e";
+    my @outer;
+    my $outer;
+    my @lex;
+    local our @pkg;
+
+    $outer = (@lex = split /:/, $s);
+    is "@lex",   "a b c d e", "array split: scalar cx lex: inner";
+    is $outer,   5,           "array split: scalar cx lex: outer";
+
+    @outer = (@lex = split /:/, $s);
+    is "@lex",   "a b c d e", "array split: list cx lex: inner";
+    is "@outer", "a b c d e", "array split: list cx lex: outer";
+
+    $outer = (@pkg = split /:/, $s);
+    is "@pkg",   "a b c d e", "array split: scalar cx pkg inner";
+    is $outer,   5,           "array split: scalar cx pkg outer";
+
+    @outer = (@pkg = split /:/, $s);
+    is "@pkg",   "a b c d e", "array split: list cx pkg inner";
+    is "@outer", "a b c d e", "array split: list cx pkg outer";
+
+    $outer = (my @a1 = split /:/, $s);
+    is "@a1",    "a b c d e", "array split: scalar cx my lex: inner";
+    is $outer,   5,           "array split: scalar cx my lex: outer";
+
+    @outer = (my @a2 = split /:/, $s);
+    is "@a2",    "a b c d e", "array split: list cx my lex: inner";
+    is "@outer", "a b c d e", "array split: list cx my lex: outer";
+
+    $outer = (local @pkg = split /:/, $s);
+    is "@pkg",   "a b c d e", "array split: scalar cx local pkg inner";
+    is $outer,   5,           "array split: scalar cx local pkg outer";
+
+    @outer = (local @pkg = split /:/, $s);
+    is "@pkg",   "a b c d e", "array split: list cx local pkg inner";
+    is "@outer", "a b c d e", "array split: list cx local pkg outer";
+
+    $outer = (@{\@lex} = split /:/, $s);
+    is "@lex",   "a b c d e", "array split: scalar cx lexref inner";
+    is $outer,   5,           "array split: scalar cx lexref outer";
+
+    @outer = (@{\@pkg} = split /:/, $s);
+    is "@pkg",   "a b c d e", "array split: list cx pkgref inner";
+    is "@outer", "a b c d e", "array split: list cx pkgref outer";
+
+
+}
+
+# splitting directly to an array wasn't filling unused AvARRAY slots with
+# NULL
+
+{
+    my @a;
+    @a = split(/-/,"-");
+    $a[1] = 'b';
+    ok eval { $a[0] = 'a'; 1; }, "array split filling AvARRAY: assign 0";
+    is "@a", "a b", "array split filling AvARRAY: result";
+}