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