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
CommitLineData
f30cbf5a
KW
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
430f723e
KW
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";
f30cbf5a 142
f30cbf5a
KW
143 my $source = $ib;
144 my $source_len = 1;
145 my $should_be = $source;
146
430f723e 147 $ret = eval "$test_func(\$source, \$source_len, \$d, \$source_len, \$source_len, \$poison)";
f30cbf5a 148 is($ret->[0], expected($source, $source_len, $poison, $source_len),
430f723e 149 "$func works when there is no delimiter at all");
f30cbf5a
KW
150 is($ret->[1], $source_len, "Destination length is correct");
151 is($ret->[2], 1, "Source advance is correct");
152
153 $source .= $d;
430f723e 154 $ret = eval "$test_func(\$source, \$source_len, \$d, \$source_len, \$source_len, \$poison)";
f30cbf5a
KW
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;
430f723e 162 $ret = eval "$test_func(\$d, 1, \$d, \$actual_dest_len, \$actual_dest_len, \$poison)";
f30cbf5a
KW
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;
430f723e 173 $ret = eval "$test_func(\$source, \$source_len, \$d, \$source_len, \$source_len, \$poison)";
f30cbf5a 174 is($ret->[0], expected($with_NULL, $len_sans_delim + 1, $poison, $source_len),
430f723e 175 "$func works when delim is in middle of source, plenty of room");
f30cbf5a
KW
176 is($ret->[1], $len_sans_delim, "Destination length is correct");
177 is($ret->[2], $len_sans_delim, "Source advance is correct");
178
430f723e 179 $ret = eval "$test_func(\$source, \$source_len, \$d, \$source_len, \$len_sans_delim, \$poison)";
f30cbf5a 180 is($ret->[0], expected($source, $len_sans_delim, $poison, $source_len),
430f723e 181 "$func works when delim is in middle of source; no room for safety NUL");
f30cbf5a
KW
182 is($ret->[1], $len_sans_delim, "Destination length is correct");
183 is($ret->[2], $len_sans_delim, "Source advance is correct");
184
430f723e 185 $ret = eval "$test_func(\$source, \$source_len, \$d, \$source_len, \$len_sans_delim - 1, \$poison)";
f30cbf5a 186 is($ret->[0], expected($source, $len_sans_delim - 1, $poison, $source_len),
430f723e 187 "$func works when not enough space for copy");
f30cbf5a
KW
188 is($ret->[1], $failure_return, "Destination length is correct");
189 is($ret->[2], $len_sans_delim, "Source advance is correct");
430f723e 190 }
f30cbf5a
KW
191}
192
193done_testing();