[perl #64062] split should return captured delimiters

[Ron Schmidt via RT]

Please find attached new, revised, hopefully more spec conformant, 
patches.

One of the two patches includes new tests with some appropriate 
revisions demonstrating the ability to address Mr. Duff’s concerns.  
Specifically:

split_test(
    'abc::def::ghi::'.split(/(\:)/, all => True, 3),
    ['abc', ':', '', ':', 'def::ghi::'],
    'split with capture obeyed limit'
);


Index: t/spec/S32-str/split-simple.t
===================================================================
--- t/spec/S32-str/split-simple.t       (revision 26126)
+++ t/spec/S32-str/split-simple.t       (working copy)
@@ -2,7 +2,7 @@
 use Test;
 
 # L<S29/Str/"=item split">
-plan 45;
+plan 52;
 
 =begin description
 
@@ -81,14 +81,37 @@
 ok (''.split('')).elems == 0, q{''.split('') returns empty list};
 ok (split('', '')).elems == 0, q{''.split('') returns empty list};
 
-# split should return capture
-my @split = 'abc def ghi'.split(/(\s+)/);
-#?rakudo todo "split should return captures"
-#?DOES 3
-{
-    ok @split.elems == 5, q{split returns captured delimiter} ;
-    ok @split[1] eq ' ', q{split captured single space};
-    ok @split[3] eq ' ', q{split captured multiple spaces};
-}
+# split should return capture with all flag set
+split_test(
+    'abc def  ghi'.split(/(\s+)/, all => True),
+    ['abc', ' ', 'def', '  ', 'ghi'],
+    'split returns captured spaces'
+);
 
+# split should NOT return capture without all flag
+split_test(
+    'abc def  ghi'.split(/(\s+)/),
+    ['abc', 'def', 'ghi'],
+    'split ignores captures without all flag'
+);
+
+ok  'abc def  ghi'.split(/(\s+)/, :all(True)).[1] ~~ Match,
+    'capture returns match object not string';
+
+split_test(
+    'abc::def::ghi::'.split(/(\:)/, all => True, 3),
+    ['abc', ':', '', ':', 'def::ghi::'],
+    'split with capture obeyed limit'
+);
+
+split_test(
+    'AZZAZ'.split(/(Z)/, :all(True), 9),
+    ['A', 'Z', '', 'Z', 'A', 'Z', ''],
+    'end cases with trailing capture and too big limit'
+);
+
+my Match $mat = 'AZYAZ'.split(/(Z)(Y)/, :all(True))[1];
+ok  $mat eq 'ZY' && $mat[0] eq 'Z' && $mat[1] eq 'Y',
+    'basic test of match with multiple captures';
+
 # vim: ft=perl6

diff --git a/src/setting/Any-str.pm b/src/setting/Any-str.pm
index 27c2080..a898064 100644
--- a/src/setting/Any-str.pm
+++ b/src/setting/Any-str.pm
@@ -50,13 +50,23 @@ class Any is also {
         $char
     }
 
-    our List multi method split(Code $delimiter, $limit = *) {
+    our List multi method split(Code $delimiter, $limit = *, :$all = False) {
         my $s = ~self;
         my $l = $limit ~~ Whatever ?? Inf !! $limit;
         my $keep = '';
+        
         return gather {
-            while $l > 1 && $s ~~ $delimiter {
+            # <ws> still off (rt 60366) and maybe not easy fix just now 3/31/09
+            # second test is hack to prevent <?wb> or <ws> from hanging 
+            while $l > 1 and $s ne '' and $s ~~ $delimiter {
                 take $keep ~ $s.substr(0, $/.from);
+                if $all and (@($/) or %($/)) {
+                    my Match $mat = $/.clone;
+                    # work around too close binding of match to underly string
+                    $mat[ $_ ] = $mat[ $_ ].clone for 0 .. (@().elems -1);
+                    $mat{ $_ } = $mat{ $_ }.clone for %().keys;
+                    take $mat;   
+                }
                 if $/.from == $/.to {
                     $keep = $s.substr($/.to, 1);
                     $s.=substr($/.to + 1);
@@ -66,12 +76,15 @@ class Any is also {
                 }
                 $l--;
             }
-            take $keep ~ $s if $l > 0;
+            unless $l <= 0 or ($keep eq '' and $s eq '' and $l == 0) {
+                take $keep ~ $s    
+            }
         }
     }
 
     # TODO: substitute with '$delimiter as Str' once coercion is implemented
-    our List multi method split($delimiter, $limit = *) {
+    # :$all = False just keeps MMD happy for now ...
+    our List multi method split($delimiter, $limit = *, :$all = False) {
         my Int $prev = 0;
         my $l = $limit ~~ Whatever ?? Inf !! $limit;
         my $s = ~self;