1#!perl -w
2
3use strict;
4use Test::More;
5use Encode;
6
7plan skip_all => 'Unclear how EBCIDC should behave' if ord "A" != 65;
8
9use XS::APItest qw(utf16_to_utf8 utf16_to_utf8_reversed);
10
11for my $ord (0, 10, 13, 78, 255, 256, 0xD7FF, 0xE000, 0xFFFD,
12	     0x10000, 0x10FC00, 0x103FF, 0x10FFFD) {
13    my $chr = chr $ord;
14    for my $prefix ('', "\0", 'Perl rules') {
15	for my $suffix ('', "\0", "Moo!") {
16	    my $string = $prefix . $chr . $suffix;
17	    my $name = sprintf "for chr $ord prefix %d, suffix %d",
18		length $prefix, length $suffix;
19	    my $as_utf8 = $string;
20	    utf8::encode($as_utf8);
21	    is(utf16_to_utf8(encode('UTF-16BE', $string)), $as_utf8,
22	       "utf16_to_utf8 $name");
23	    is(utf16_to_utf8_reversed(encode('UTF-16LE', $string)), $as_utf8,
24	       "utf16_to_utf8_reversed $name");
25	}
26    }
27}
28
29foreach ("\0", 'N', 'Perl rules!') {
30    my $length = length $_;
31    my $got = eval {utf16_to_utf8($_)};
32    like($@, qr/^panic: utf16_to_utf8: odd bytelen $length at/,
33	 "Odd byte length panics for '$_'");
34    is($got, undef, 'hence eval returns undef');
35}
36
37for (["\xD8\0\0\0", 'NULs'],
38     ["\xD8\0\xD8\0", '2 Lows'],
39     ["\xDC\0\0\0", 'High NUL'],
40     ["\xDC\0\xD8\0", 'High Low'],
41     ["\xDC\0\xDC\0", 'High High'],
42    ) {
43    my ($malformed, $name) = @$_;
44    my $got = eval {utf16_to_utf8($malformed)};
45    like($@, qr/^Malformed UTF-16 surrogate at/,
46	 "Malformed surrogate $name croaks for utf16_to_utf8");
47    is($got, undef, 'hence eval returns undef');
48
49    $malformed =~ s/(.)(.)/$2$1/gs;
50    $got = eval {utf16_to_utf8_reversed($malformed)};
51    like($@, qr/^Malformed UTF-16 surrogate at/,
52	 "Malformed surrogate $name croaks for utf16_to_utf8_reversed");
53    is($got, undef, 'hence eval returns undef');
54}
55
56my $in = "NA";
57my $got = eval {utf16_to_utf8_reversed($in, 1)};
58like($@, qr/^panic: utf16_to_utf8_reversed: odd bytelen 1 at/,
59     'Odd byte length panics');
60is($got, undef, 'hence eval returns undef');
61is($in, "NA", 'and input unchanged');
62
63$in = "\xD8\0\xDC\0";
64$got = eval {utf16_to_utf8($in, 2)};
65like($@, qr/^Malformed UTF-16 surrogate at/, 'Lone surrogate croaks');
66(ok(!defined $got, 'hence eval returns undef')) or
67    diag(join ', ', map {ord $_} split //, $got);
68
69done_testing;
70