use XS::APItest qw(utf16_to_utf8 utf16_to_utf8_reversed);
-for my $ord (0, 10, 13, 78, 255, 256, 0xD7FF, 0xE000, 0x10000) {
+for my $ord (0, 10, 13, 78, 255, 256, 0xD7FF, 0xE000, 0xFFFD,
+ 0x10000, 0x10FC00, 0x103FF, 0x10FFFD) {
my $chr = chr $ord;
for my $prefix ('', "\0", 'Perl rules') {
for my $suffix ('', "\0", "Moo!") {
}
}
-# Currently this is special-cased to work. Should it?
-
-is(utf16_to_utf8("\0"), "\0", 'Short string to utf16_to_utf8');
-
-# But anything else is fatal
-
-my $got = eval {utf16_to_utf8('N')};
-like($@, qr/^panic: utf16_to_utf8: odd bytelen 1 at/, 'Odd byte length panics');
-is($got, undef, 'hence eval returns undef');
+foreach ("\0", 'N', 'Perl rules!') {
+ my $length = length $_;
+ my $got = eval {utf16_to_utf8($_)};
+ like($@, qr/^panic: utf16_to_utf8: odd bytelen $length at/,
+ "Odd byte length panics for '$_'");
+ is($got, undef, 'hence eval returns undef');
+}
for (["\xD8\0\0\0", 'NULs'],
["\xD8\0\xD8\0", '2 Lows'],
+ ["\xDC\0\0\0", 'High NUL'],
+ ["\xDC\0\xD8\0", 'High Low'],
+ ["\xDC\0\xDC\0", 'High High'],
) {
my ($malformed, $name) = @$_;
- $got = eval {utf16_to_utf8($malformed)};
+ my $got = eval {utf16_to_utf8($malformed)};
like($@, qr/^Malformed UTF-16 surrogate at/,
"Malformed surrogate $name croaks for utf16_to_utf8");
is($got, undef, 'hence eval returns undef');
"Malformed surrogate $name croaks for utf16_to_utf8_reversed");
is($got, undef, 'hence eval returns undef');
}
+
+my $in = "NA";
+my $got = eval {utf16_to_utf8_reversed($in, 1)};
+like($@, qr/^panic: utf16_to_utf8_reversed: odd bytelen 1 at/,
+ 'Odd byte length panics');
+is($got, undef, 'hence eval returns undef');
+is($in, "NA", 'and input unchanged');
+
+$in = "\xD8\0\xDC\0";
+$got = eval {utf16_to_utf8($in, 2)};
+like($@, qr/^Malformed UTF-16 surrogate at/, 'Lone surrogate croaks');
+(ok(!defined $got, 'hence eval returns undef')) or
+ diag(join ', ', map {ord $_} split //, $got);
+