Add API test for delimcpy()

It turns out that the existing implementation has some bugs, so some of
the tests are marked TODO.

3 files changed, 217 insertions, 1 deletions

diff --git a/ext/XS-APItest/APItest.pm b/ext/XS-APItest/APItest.pm
index 2fda1fc6cc..fc47450445 100644
--- a/ext/XS-APItest/APItest.pm
+++ b/ext/XS-APItest/APItest.pm
@@ -5,7 +5,7 @@ use strict;
 use warnings;
 use Carp;
 
-our $VERSION = '1.12';
+our $VERSION = '1.13';
 
 require XSLoader;
 
diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs
index 5d0d0e3586..cc31a390e2 100644
--- a/ext/XS-APItest/APItest.xs
+++ b/ext/XS-APItest/APItest.xs
@@ -6795,6 +6795,32 @@ test_toTITLE_utf8(SV * p, int type)
     OUTPUT:
         RETVAL
 
+AV *
+test_delimcpy(SV * from_sv, STRLEN trunc_from, char delim, STRLEN to_len, STRLEN trunc_to, char poison = '?')
+    PREINIT:
+        char * from;
+        I32 retlen;
+        char * from_pos_after_copy;
+        char * to;
+    CODE:
+        from = SvPV_nolen(from_sv);
+        Newx(to, to_len, char);
+	PoisonWith(to, to_len, char, poison);
+        assert(trunc_from <= SvCUR(from_sv));
+        /* trunc_to allows us to throttle the output size available */
+        assert(trunc_to <= to_len);
+        from_pos_after_copy = delimcpy(to, to + trunc_to,
+                                       from, from + trunc_from,
+                                       delim, &retlen);
+        RETVAL = newAV();
+        sv_2mortal((SV*)RETVAL);
+        av_push(RETVAL, newSVpvn(to, to_len));
+        av_push(RETVAL, newSVuv(retlen));
+        av_push(RETVAL, newSVuv(from_pos_after_copy - from));
+        Safefree(to);
+    OUTPUT:
+        RETVAL
+
 SV *
 test_Gconvert(SV * number, SV * num_digits)
     PREINIT:
diff --git a/ext/XS-APItest/t/delimcpy.t b/ext/XS-APItest/t/delimcpy.t
new file mode 100644
index 0000000000..e72c9903b4
--- /dev/null
+++ b/ext/XS-APItest/t/delimcpy.t
@@ -0,0 +1,190 @@
+#!perl -w
+use warnings;
+use strict;
+
+use Test::More;
+use XS::APItest;
+
+sub expected($$$$) {
+    my ($copied,        # What the copy should look like
+        $length,        # but truncated to this,
+        $poison,        # and filled with this so as to catch overruns
+        $actual_dest_length)   # to this total number of bytes
+    = @_;
+
+    return substr($copied, 0, $length) . ($poison x ($actual_dest_length - $length));
+}
+
+my $b = "\\";
+my $poison = '?';
+my $failure_return = 0x7FFF_FFFF;   # I32 max
+my $ret;
+
+# ib = innocent bystander; a character that isn't a delimiter nor an escape
+my $ib = 'y';
+
+foreach my $d ("x", "\0") {     # Try both printable and NUL delimiters
+    my $source = $ib;
+    my $source_len = 1;
+    my $should_be = $source;
+
+    $ret = test_delimcpy($source, $source_len, $d, $source_len, $source_len, $poison);
+    is($ret->[0], expected($source, $source_len, $poison, $source_len),
+       "Works when there is no delimiter at all");
+    is($ret->[1], $source_len, "Destination length is correct");
+    is($ret->[2], 1, "Source advance is correct");
+
+    $source .= $d;
+    $ret = test_delimcpy($source, $source_len, $d, $source_len, $source_len, $poison);
+    is($ret->[0], expected($source, $source_len, $poison, $source_len),
+       "Works when delimiter is just beyond the examined portion");
+    is($ret->[1], $source_len, "Destination length is correct");
+    is($ret->[2], 1, "Source advance is correct");
+
+    $should_be = $ib . $b;
+    $source = $should_be . $d;
+    $source_len = 2;
+    $ret = test_delimcpy($source, $source_len, $d, $source_len, $source_len, $poison);
+    is($ret->[0], expected($source, $source_len, $poison, $source_len),
+       "Works when delimiter is just beyond the examined portion, which"
+     . " ends in a backslash");
+    is($ret->[1], $source_len, "Destination length is correct");
+    is($ret->[2], 2, "Source advance is correct");
+
+    # Delimiter in first byte
+    my $actual_dest_len = 5;
+    $ret = test_delimcpy($d, 1, $d, $actual_dest_len, $actual_dest_len, $poison);
+    is($ret->[0], "\0" . $poison x ($actual_dest_len - 1),
+       "Copied correctly when delimiter is first character");
+    is($ret->[1], 0, "0 bytes copied");
+    is($ret->[2], 0, "0 bytes advanced");
+
+    # Now to more extensive tests.  The source includes escaped delimiters
+    # (which should have one backslash stripped), and finally a delimiter with
+    # an even number of backslashes, so is not escaped
+    my $base_source = $b . $d . $b x 3 . $d . $b x 5 . $d . $b x 2 . $d;
+    $should_be =           $d . $b x 2 . $d . $b x 4 . $d . $b x 2;
+    # byte counts:          |    ||       |    ||||     |    ||   = 11 bytes
+    my $dest_len = 11;
+
+    # The return from this function should be how many bytes did it advance
+    # the source pointer.  This won't include the unescaped delimiter
+    my $source_advance = length($base_source) - 1;
+
+    # Add some trailing non-special charss
+    $source = $base_source . ($ib x 6);
+    $source_len = length $source;
+    $actual_dest_len = $source_advance + 10;
+
+    my $with_NUL = $should_be . "\0";
+    my $trunc_dest_len = length $with_NUL;
+
+    $ret = test_delimcpy($source, $source_len,
+                         $d, $actual_dest_len, $trunc_dest_len+1, $poison);
+    is($ret->[0], expected($with_NUL, $trunc_dest_len, $poison,
+                                                            $actual_dest_len),
+      "Stops at first unescaped delimiter; stripping off the escapes;"
+    . " destination has more than enough space for a safety NUL");
+    is($ret->[1], $dest_len, "Destination length is correct");
+    is($ret->[2], $source_advance, "Source advance is correct");
+
+    $ret = test_delimcpy($source, $source_len, $d,
+                         $actual_dest_len, $trunc_dest_len, $poison);
+    is($ret->[0], expected($with_NUL, $trunc_dest_len, $poison,
+                                                            $actual_dest_len),
+       "As above, but with just enough space for a safety NUL");
+    is($ret->[1], $dest_len, "Destination length is correct");
+    is($ret->[2], $source_advance, "Source advance is correct");
+
+    $trunc_dest_len--;
+    $ret = test_delimcpy($source, $source_len,
+                         $d, $actual_dest_len, $trunc_dest_len,
+                         $poison);
+    is($ret->[0], expected($should_be, $trunc_dest_len, $poison,
+                                                               $actual_dest_len),
+      "As above, but not enough room for the safety NUL");
+    is($ret->[1], $dest_len, "Destination length is correct");
+    is($ret->[2], $source_advance, "Source advance is correct");
+
+    $trunc_dest_len--;
+    $ret = test_delimcpy($source, $source_len,
+                         $d, $actual_dest_len, $trunc_dest_len,
+                         $poison);
+    is($ret->[0], expected($should_be, $trunc_dest_len, $poison,
+                                                            $actual_dest_len),
+       "As above, but not enough room for the final backslash");
+    ok($ret->[1] > $trunc_dest_len,
+       "Error return is correctly > buffer length");
+    is($ret->[2], $source_advance, "Source advance is correct");
+
+    # Keep trying shorter and shorter permissible dest lengths
+    do {
+        $trunc_dest_len--;
+        $ret = test_delimcpy($source, $source_len,
+                             $d, $actual_dest_len, $trunc_dest_len,
+                             $poison);
+        is($ret->[0], expected($should_be, $trunc_dest_len, $poison,
+                                                            $actual_dest_len),
+           "Preceding test but room only for $trunc_dest_len bytes");
+        ok($ret->[1] > $trunc_dest_len,
+           "Error return is correctly > buffer length");
+        is($ret->[2], $source_advance, "Source advance is correct");
+    } while ($trunc_dest_len > 0);
+}
+
+TODO: {
+    # Repeat a few of the tests with a backslash delimiter, which means there
+    # is no possibiliby of an escape
+
+        local $TODO = 'current code is broken when the delimiter is a backslash';
+        my $d = "\\";
+        my $source = $ib;
+        my $source_len = 1;
+        my $should_be = $source;
+
+        $ret = test_delimcpy($source, $source_len, $d, $source_len, $source_len, $poison);
+        is($ret->[0], expected($source, $source_len, $poison, $source_len),
+           "delimcpy works when there is no delimiter at all");
+        is($ret->[1], $source_len, "Destination length is correct");
+        is($ret->[2], 1, "Source advance is correct");
+
+        $source .= $d;
+        $ret = test_delimcpy($source, $source_len, $d, $source_len, $source_len, $poison);
+        is($ret->[0], expected($source, $source_len, $poison, $source_len),
+        "Works when delimiter is just beyond the examined portion");
+        is($ret->[1], $source_len, "Destination length is correct");
+        is($ret->[2], 1, "Source advance is correct");
+
+        # Delimiter in first byte
+        my $actual_dest_len = 5;
+        $ret = test_delimcpy($d, 1, $d, $actual_dest_len, $actual_dest_len, $poison);
+        is($ret->[0], "\0" . $poison x ($actual_dest_len - 1),
+        "Copied correctly when delimiter is first character");
+        is($ret->[1], 0, "0 bytes copied");
+        is($ret->[2], 0, "0 bytes advanced");
+
+        $source = $ib x 6;
+        my $len_sans_delim = length $source;
+        my $with_NULL = $source . "\0";
+        $source .= $d . ($ib x 7);
+        $source_len = length $source;
+        $ret = test_delimcpy($source, $source_len, $d, $source_len, $source_len, $poison);
+        is($ret->[0], expected($with_NULL, $len_sans_delim + 1, $poison, $source_len),
+           "delimcpy works when delim is in middle of source, plenty of room");
+        is($ret->[1], $len_sans_delim, "Destination length is correct");
+        is($ret->[2], $len_sans_delim, "Source advance is correct");
+
+        $ret = test_delimcpy($source, $source_len, $d, $source_len, $len_sans_delim, $poison);
+        is($ret->[0], expected($source, $len_sans_delim, $poison, $source_len),
+           "delimcpy works when delim is in middle of source; no room for safety NUL");
+        is($ret->[1], $len_sans_delim, "Destination length is correct");
+        is($ret->[2], $len_sans_delim, "Source advance is correct");
+
+        $ret = test_delimcpy($source, $source_len, $d, $source_len, $len_sans_delim - 1, $poison);
+        is($ret->[0], expected($source, $len_sans_delim - 1, $poison, $source_len),
+           "delimcpy works when not enough space for copy");
+        is($ret->[1], $failure_return, "Destination length is correct");
+        is($ret->[2], $len_sans_delim, "Source advance is correct");
+}
+
+done_testing();