ext/XS-APItest/t/utf16_to_utf8.t

   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
   9 for my $ord (0, 10, 13, 78, 255, 256, 0xD7FF, 0xE000, 0xFFFD,
  10              0x10000, 0x10FC00, 0x103FF, 0x10FFFD) {
  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
  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 }
  33
  34 for (["\xD8\0\0\0", 'NULs'],
  35      ["\xD8\0\xD8\0", '2 Lows'],
  36      ["\xDC\0\0\0", 'High NUL'],
  37      ["\xDC\0\xD8\0", 'High Low'],
  38      ["\xDC\0\xDC\0", 'High High'],
  39     ) {
  40     my ($malformed, $name) = @$_;
  41     my $got = eval {utf16_to_utf8($malformed)};
  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 }
  52
  53 my $in = "NA";
  54 my $got = eval {utf16_to_utf8_reversed($in, 1)};
  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');
  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