Commit | Line | Data |
61ad1ccd |
1 | #!./perl -w |
7aa207d6 |
2 | |
c28d6105 |
3 | print "1..36\n"; |
61ad1ccd |
4 | my $test = 0; |
7aa207d6 |
5 | |
5c7da53c |
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 | } |
7aa207d6 |
18 | |
19 | sub test { |
c28d6105 |
20 | my ($enc, $tag, $bom, $nl) = @_; |
5c7da53c |
21 | open my $fh, ">", "utf$$.pl" or die "utf.pl: $!"; |
22 | binmode $fh; |
c28d6105 |
23 | print $fh bytes_to_utf($enc, $tag . ($nl ? "\n" : ''), $bom); |
5c7da53c |
24 | close $fh or die $!; |
2d90ac95 |
25 | my $got = do "./utf$$.pl"; |
61ad1ccd |
26 | $test = $test + 1; |
27 | if (!defined $got) { |
c28d6105 |
28 | print "not ok $test # $enc $tag $bom $nl; got undef\n"; |
61ad1ccd |
29 | } elsif ($got ne $tag) { |
c28d6105 |
30 | print "not ok $test # $enc $tag $bom $nl; got '$got'\n"; |
61ad1ccd |
31 | } else { |
c28d6105 |
32 | print "ok $test # $enc $tag $bom $nl\n"; |
61ad1ccd |
33 | } |
7aa207d6 |
34 | } |
35 | |
386ac4df |
36 | for my $bom (0, 1) { |
37 | for my $enc (qw(utf16le utf16be utf8)) { |
38 | for my $value (123, 1234, 12345) { |
c28d6105 |
39 | for my $nl (1, 0) { |
40 | test($enc, $value, $bom, $nl); |
41 | } |
386ac4df |
42 | } |
43 | } |
44 | } |
7aa207d6 |
45 | |
46 | END { |
2d90ac95 |
47 | 1 while unlink "utf$$.pl"; |
7aa207d6 |
48 | } |