1#!perl -w
2use warnings;
3use strict;
4
5use Test::More;
6use XS::APItest;
7
8sub expected($$$$) {
9    my ($copied,        # What the copy should look like
10        $length,        # but truncated to this,
11        $poison,        # and filled with this so as to catch overruns
12        $actual_dest_length)   # to this total number of bytes
13    = @_;
14
15    return substr($copied, 0, $length) . ($poison x ($actual_dest_length - $length));
16}
17
18my $b = "\\";
19my $poison = '?';
20my $failure_return = 0x7FFF_FFFF;   # I32 max
21my $ret;
22
23# ib = innocent bystander; a character that isn't a delimiter nor an escape
24my $ib = 'y';
25
26foreach my $d ("x", "\0") {     # Try both printable and NUL delimiters
27    my $source = $ib;
28    my $source_len = 1;
29    my $should_be = $source;
30
31    $ret = test_delimcpy($source, $source_len, $d, $source_len, $source_len, $poison);
32    is($ret->[0], expected($source, $source_len, $poison, $source_len),
33       "Works when there is no delimiter at all");
34    is($ret->[1], $source_len, "Destination length is correct");
35    is($ret->[2], 1, "Source advance is correct");
36
37    $source .= $d;
38    $ret = test_delimcpy($source, $source_len, $d, $source_len, $source_len, $poison);
39    is($ret->[0], expected($source, $source_len, $poison, $source_len),
40       "Works when delimiter is just beyond the examined portion");
41    is($ret->[1], $source_len, "Destination length is correct");
42    is($ret->[2], 1, "Source advance is correct");
43
44    $should_be = $ib . $b;
45    $source = $should_be . $d;
46    $source_len = 2;
47    $ret = test_delimcpy($source, $source_len, $d, $source_len, $source_len, $poison);
48    is($ret->[0], expected($source, $source_len, $poison, $source_len),
49       "Works when delimiter is just beyond the examined portion, which"
50     . " ends in a backslash");
51    is($ret->[1], $source_len, "Destination length is correct");
52    is($ret->[2], 2, "Source advance is correct");
53
54    # Delimiter in first byte
55    my $actual_dest_len = 5;
56    $ret = test_delimcpy($d, 1, $d, $actual_dest_len, $actual_dest_len, $poison);
57    is($ret->[0], "\0" . $poison x ($actual_dest_len - 1),
58       "Copied correctly when delimiter is first character");
59    is($ret->[1], 0, "0 bytes copied");
60    is($ret->[2], 0, "0 bytes advanced");
61
62    # Now to more extensive tests.  The source includes escaped delimiters
63    # (which should have one backslash stripped), and finally a delimiter with
64    # an even number of backslashes, so is not escaped
65    my $base_source = $b . $d . $b x 3 . $d . $b x 5 . $d . $b x 2 . $d;
66    $should_be =           $d . $b x 2 . $d . $b x 4 . $d . $b x 2;
67    # byte counts:          |    ||       |    ||||     |    ||   = 11 bytes
68    my $dest_len = 11;
69
70    # The return from this function should be how many bytes did it advance
71    # the source pointer.  This won't include the unescaped delimiter
72    my $source_advance = length($base_source) - 1;
73
74    # Add some trailing non-special charss
75    $source = $base_source . ($ib x 6);
76    $source_len = length $source;
77    $actual_dest_len = $source_advance + 10;
78
79    my $with_NUL = $should_be . "\0";
80    my $trunc_dest_len = length $with_NUL;
81
82    $ret = test_delimcpy($source, $source_len,
83                         $d, $actual_dest_len, $trunc_dest_len+1, $poison);
84    is($ret->[0], expected($with_NUL, $trunc_dest_len, $poison,
85                                                            $actual_dest_len),
86      "Stops at first unescaped delimiter; stripping off the escapes;"
87    . " destination has more than enough space for a safety NUL");
88    is($ret->[1], $dest_len, "Destination length is correct");
89    is($ret->[2], $source_advance, "Source advance is correct");
90
91    $ret = test_delimcpy($source, $source_len, $d,
92                         $actual_dest_len, $trunc_dest_len, $poison);
93    is($ret->[0], expected($with_NUL, $trunc_dest_len, $poison,
94                                                            $actual_dest_len),
95       "As above, but with just enough space for a safety NUL");
96    is($ret->[1], $dest_len, "Destination length is correct");
97    is($ret->[2], $source_advance, "Source advance is correct");
98
99    $trunc_dest_len--;
100    $ret = test_delimcpy($source, $source_len,
101                         $d, $actual_dest_len, $trunc_dest_len,
102                         $poison);
103    is($ret->[0], expected($should_be, $trunc_dest_len, $poison,
104                                                               $actual_dest_len),
105      "As above, but not enough room for the safety NUL");
106    is($ret->[1], $dest_len, "Destination length is correct");
107    is($ret->[2], $source_advance, "Source advance is correct");
108
109    $trunc_dest_len--;
110    $ret = test_delimcpy($source, $source_len,
111                         $d, $actual_dest_len, $trunc_dest_len,
112                         $poison);
113    is($ret->[0], expected($should_be, $trunc_dest_len, $poison,
114                                                            $actual_dest_len),
115       "As above, but not enough room for the final backslash");
116    ok($ret->[1] > $trunc_dest_len,
117       "Error return is correctly > buffer length");
118    is($ret->[2], $source_advance, "Source advance is correct");
119
120    # Keep trying shorter and shorter permissible dest lengths
121    do {
122        $trunc_dest_len--;
123        $ret = test_delimcpy($source, $source_len,
124                             $d, $actual_dest_len, $trunc_dest_len,
125                             $poison);
126        is($ret->[0], expected($should_be, $trunc_dest_len, $poison,
127                                                            $actual_dest_len),
128           "Preceding test but room only for $trunc_dest_len bytes");
129        ok($ret->[1] > $trunc_dest_len,
130           "Error return is correctly > buffer length");
131        is($ret->[2], $source_advance, "Source advance is correct");
132    } while ($trunc_dest_len > 0);
133}
134
135# Repeat a few of the tests with a backslash delimiter, which means there
136# is no possibiliby of an escape.  And this escape-less form can be used to
137# also do a general test on 'delimcpy_no_escape'
138foreach my $d ("x", "\0", '\\') {
139    for my $func (qw(delimcpy delimcpy_no_escape)) {
140        next if $func eq 'delimcpy' && $d ne '\\';
141        my $test_func = "test_$func";
142
143        my $source = $ib;
144        my $source_len = 1;
145        my $should_be = $source;
146
147        $ret = eval "$test_func(\$source, \$source_len, \$d, \$source_len, \$source_len, \$poison)";
148        is($ret->[0], expected($source, $source_len, $poison, $source_len),
149           "$func works when there is no delimiter at all");
150        is($ret->[1], $source_len, "Destination length is correct");
151        is($ret->[2], 1, "Source advance is correct");
152
153        $source .= $d;
154        $ret = eval "$test_func(\$source, \$source_len, \$d, \$source_len, \$source_len, \$poison)";
155        is($ret->[0], expected($source, $source_len, $poison, $source_len),
156        "Works when delimiter is just beyond the examined portion");
157        is($ret->[1], $source_len, "Destination length is correct");
158        is($ret->[2], 1, "Source advance is correct");
159
160        # Delimiter in first byte
161        my $actual_dest_len = 5;
162        $ret = eval "$test_func(\$d, 1, \$d, \$actual_dest_len, \$actual_dest_len, \$poison)";
163        is($ret->[0], "\0" . $poison x ($actual_dest_len - 1),
164        "Copied correctly when delimiter is first character");
165        is($ret->[1], 0, "0 bytes copied");
166        is($ret->[2], 0, "0 bytes advanced");
167
168        $source = $ib x 6;
169        my $len_sans_delim = length $source;
170        my $with_NULL = $source . "\0";
171        $source .= $d . ($ib x 7);
172        $source_len = length $source;
173        $ret = eval "$test_func(\$source, \$source_len, \$d, \$source_len, \$source_len, \$poison)";
174        is($ret->[0], expected($with_NULL, $len_sans_delim + 1, $poison, $source_len),
175           "$func works when delim is in middle of source, plenty of room");
176        is($ret->[1], $len_sans_delim, "Destination length is correct");
177        is($ret->[2], $len_sans_delim, "Source advance is correct");
178
179        $ret = eval "$test_func(\$source, \$source_len, \$d, \$source_len, \$len_sans_delim, \$poison)";
180        is($ret->[0], expected($source, $len_sans_delim, $poison, $source_len),
181           "$func works when delim is in middle of source; no room for safety NUL");
182        is($ret->[1], $len_sans_delim, "Destination length is correct");
183        is($ret->[2], $len_sans_delim, "Source advance is correct");
184
185        $ret = eval "$test_func(\$source, \$source_len, \$d, \$source_len, \$len_sans_delim - 1, \$poison)";
186        is($ret->[0], expected($source, $len_sans_delim - 1, $poison, $source_len),
187           "$func works when not enough space for copy");
188        is($ret->[1], $failure_return, "Destination length is correct");
189        is($ret->[2], $len_sans_delim, "Source advance is correct");
190    }
191}
192
193done_testing();
194