Commit | Line | Data |
fa6f41cf |
1 | # $Id: enc_eucjp.t,v 1.1 2003/01/21 22:19:14 dankogai Exp $ |
88632417 |
2 | # This is the twin of enc_utf8.t, the only difference is that |
3 | # this has "use encoding 'euc-jp'". |
4 | |
5 | BEGIN { |
fa6f41cf |
6 | if ($] <= 5.008){ |
7 | print "1..0 # Skip: Perl 5.8.1 or later required\n"; |
8 | exit 0; |
9 | } |
88632417 |
10 | require Config; import Config; |
11 | if ($Config{'extensions'} !~ /\bEncode\b/) { |
12 | print "1..0 # Skip: Encode was not built\n"; |
13 | exit 0; |
14 | } |
15 | unless (find PerlIO::Layer 'perlio') { |
16 | print "1..0 # Skip: PerlIO was not built\n"; |
17 | exit 0; |
18 | } |
19 | if (ord("A") == 193) { |
20 | print "1..0 # encoding pragma does not support EBCDIC platforms\n"; |
21 | exit(0); |
22 | } |
23 | } |
24 | |
25 | use encoding 'euc-jp'; |
26 | |
27 | my @c = (127, 128, 255, 256); |
28 | |
29 | print "1.." . (scalar @c + 1) . "\n"; |
30 | |
31 | my @f; |
32 | |
33 | for my $i (0..$#c) { |
34 | push @f, "f$i"; |
35 | open(F, ">f$i") or die "$0: failed to open 'f$i' for writing: $!"; |
36 | binmode(F, ":utf8"); |
37 | print F chr($c[$i]); |
fa6f41cf |
38 | print F pack("C" => $c[$i]); |
88632417 |
39 | close F; |
40 | } |
41 | |
42 | my $t = 1; |
43 | |
44 | for my $i (0..$#c) { |
45 | open(F, "<f$i") or die "$0: failed to open 'f$i' for reading: $!"; |
46 | binmode(F, ":utf8"); |
47 | my $c = <F>; |
48 | my $o = ord($c); |
49 | print $o == $c[$i] ? "ok $t - utf8 I/O $c[$i]\n" : "not ok $t - utf8 I/O $c[$i]: $o != $c[$i]\n"; |
50 | $t++; |
51 | } |
52 | |
53 | my $f = "f" . @f; |
54 | |
55 | push @f, $f; |
56 | open(F, ">$f") or die "$0: failed to open '$f' for writing: $!"; |
57 | binmode(F, ":raw"); # Output raw bytes. |
58 | print F chr(128); # Output illegal UTF-8. |
59 | close F; |
60 | open(F, $f) or die "$0: failed to open '$f' for reading: $!"; |
61 | binmode(F, ":encoding(utf-8)"); |
62 | { |
63 | local $^W = 1; |
64 | local $SIG{__WARN__} = sub { $a = shift }; |
65 | eval { <F> }; # This should get caught. |
66 | } |
67 | print $a =~ qr{^utf8 "\\x80" does not map to Unicode} ? |
68 | "ok $t - illegal utf8 input\n" : "not ok $t - illegal utf8 input: a = " . unpack("H*", $a) . "\n"; |
69 | |
70 | END { |
71 | 1 while unlink @f; |
72 | } |