t/comp/utf.t

   1 #!./perl -w
   2
   3 print "1..36\n";
   4 my $test = 0;
   5
   6 my %templates = (
   7                  utf8 => 'C0U',
   8                  utf16be => 'n',
   9                  utf16le => 'v',
  10                 );
  11
  12 sub bytes_to_utf {
  13     my ($enc, $content, $do_bom) = @_;
  14     my $template = $templates{$enc};
  15     die "Unsupported encoding $enc" unless $template;
  16     return pack "$template*", ($do_bom ? 0xFEFF : ()), unpack "C*", $content;
  17 }
  18
  19 sub test {
  20     my ($enc, $tag, $bom, $nl) = @_;
  21     open my $fh, ">", "utf$$.pl" or die "utf.pl: $!";
  22     binmode $fh;
  23     print $fh bytes_to_utf($enc, $tag . ($nl ? "\n" : ''), $bom);
  24     close $fh or die $!;
  25     my $got = do "./utf$$.pl";
  26     $test = $test + 1;
  27     if (!defined $got) {
  28         print "not ok $test # $enc $tag $bom $nl; got undef\n";
  29     } elsif ($got ne $tag) {
  30         print "not ok $test # $enc $tag $bom $nl; got '$got'\n";
  31     } else {
  32         print "ok $test # $enc $tag $bom $nl\n";
  33     }
  34 }
  35
  36 for my $bom (0, 1) {
  37     for my $enc (qw(utf16le utf16be utf8)) {
  38         for my $value (123, 1234, 12345) {
  39             for my $nl (1, 0) {
  40                 test($enc, $value, $bom, $nl);
  41             }
  42         }
  43     }
  44 }
  45
  46 END {
  47     1 while unlink "utf$$.pl";
  48 }