This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix up delimcpy_no_escape()
[perl5.git] / ext / XS-APItest / t / delimcpy.t
1 #!perl -w
2 use warnings;
3 use strict;
4
5 use Test::More;
6 use XS::APItest;
7
8 sub 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
18 my $b = "\\";
19 my $poison = '?';
20 my $failure_return = 0x7FFF_FFFF;   # I32 max
21 my $ret;
22
23 # ib = innocent bystander; a character that isn't a delimiter nor an escape
24 my $ib = 'y';
25
26 foreach 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'
138 foreach 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
193 done_testing();