bump version on modules changed since 5.13.0
[p5sagit/p5-mst-13.2.git] / ext / XS-APItest / t / utf16_to_utf8.t
CommitLineData
30685b56 1#!perl -w
2
3use strict;
4use Test::More 'no_plan';
5use Encode;
6
7use XS::APItest qw(utf16_to_utf8 utf16_to_utf8_reversed);
8
52b9aa85 9for 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 26foreach ("\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
34for (["\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
53my $in = "NA";
26cc780b 54my $got = eval {utf16_to_utf8_reversed($in, 1)};
e0ea5e2d 55like($@, qr/^panic: utf16_to_utf8_reversed: odd bytelen 1 at/,
56 'Odd byte length panics');
57is($got, undef, 'hence eval returns undef');
58is($in, "NA", 'and input unchanged');
01ea242b 59
60$in = "\xD8\0\xDC\0";
61$got = eval {utf16_to_utf8($in, 2)};
62like($@, 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