Commit | Line | Data |
06fb145c |
1 | BEGIN { |
2 | require Config; import Config; |
3 | if ($Config{'extensions'} !~ /\bEncode\b/) { |
4 | print "1..0 # Skip: Encode was not built\n"; |
5 | exit 0; |
6 | } |
7 | unless (find PerlIO::Layer 'perlio') { |
8 | print "1..0 # Skip: PerlIO was not built\n"; |
9 | exit 0; |
10 | } |
11 | if (ord("A") == 193) { |
12 | print "1..0 # encoding pragma does not support EBCDIC platforms\n"; |
13 | exit(0); |
14 | } |
15 | } |
16 | |
17 | use encoding 'utf8'; |
18 | |
19 | my @c = (127, 128, 255, 256); |
20 | |
21 | print "1.." . (scalar @c + 1) . "\n"; |
22 | |
23 | my @f; |
24 | |
25 | for my $i (0..$#c) { |
26 | push @f, "f$i"; |
27 | open(F, ">f$i") or die "$0: failed to open 'f$i' for writing: $!"; |
28 | binmode(F, ":utf8"); |
29 | print F chr($c[$i]); |
30 | close F; |
31 | } |
32 | |
33 | my $t = 1; |
34 | |
35 | for my $i (0..$#c) { |
36 | open(F, "<f$i") or die "$0: failed to open 'f$i' for reading: $!"; |
37 | binmode(F, ":utf8"); |
38 | my $c = <F>; |
39 | my $o = ord($c); |
40 | print $o == $c[$i] ? "ok $t\n" : "not ok $t # $o != $c[$i]\n"; |
41 | $t++; |
42 | } |
43 | |
44 | my $f = "f4"; |
45 | |
46 | push @f, $f; |
47 | open(F, ">$f") or die "$0: failed to open '$f' for writing: $!"; |
48 | binmode(F, ":raw"); # Output raw bytes. |
49 | print F chr(128); # Output illegal UTF-8. |
50 | close F; |
51 | open(F, $f) or die "$0: failed to open '$f' for reading: $!"; |
52 | binmode(F, ":encoding(utf-8)"); |
53 | { |
54 | local $^W = 1; |
55 | local $SIG{__WARN__} = sub { $a = shift }; |
56 | eval { <F> }; # This should get caught. |
57 | } |
58 | print $a =~ qr{^utf8 "\\x80" does not map to Unicode} ? |
59 | "ok $t\n" : "not ok $t: $a\n"; |
60 | |
61 | END { |
62 | 1 while unlink @f; |
63 | } |