Commit | Line | Data |
d1256cb1 |
1 | # $Id: enc_eucjp.t,v 2.1 2006/05/03 18:24:10 dankogai Exp $ |
cc7dbc11 |
2 | # This is the twin of enc_utf8.t . |
88632417 |
3 | |
4 | BEGIN { |
5 | require Config; import Config; |
6 | if ($Config{'extensions'} !~ /\bEncode\b/) { |
7 | print "1..0 # Skip: Encode was not built\n"; |
8 | exit 0; |
9 | } |
10 | unless (find PerlIO::Layer 'perlio') { |
d1256cb1 |
11 | print "1..0 # Skip: PerlIO was not built\n"; |
12 | exit 0; |
88632417 |
13 | } |
14 | if (ord("A") == 193) { |
d1256cb1 |
15 | print "1..0 # encoding pragma does not support EBCDIC platforms\n"; |
16 | exit(0); |
88632417 |
17 | } |
151b5d36 |
18 | if ($] <= 5.008 and !$Config{perl_patchlevel}){ |
d1256cb1 |
19 | print "1..0 # Skip: Perl 5.8.1 or later required\n"; |
20 | exit 0; |
151b5d36 |
21 | } |
88632417 |
22 | } |
23 | |
24 | use encoding 'euc-jp'; |
25 | |
26 | my @c = (127, 128, 255, 256); |
27 | |
28 | print "1.." . (scalar @c + 1) . "\n"; |
29 | |
30 | my @f; |
31 | |
32 | for my $i (0..$#c) { |
8676e7d3 |
33 | no warnings 'pack'; |
3cd78934 |
34 | my $file = filename("f$i"); |
35 | push @f, $file; |
36 | open(F, ">$file") or die "$0: failed to open '$file' for writing: $!"; |
88632417 |
37 | binmode(F, ":utf8"); |
38 | print F chr($c[$i]); |
fa6f41cf |
39 | print F pack("C" => $c[$i]); |
88632417 |
40 | close F; |
41 | } |
42 | |
43 | my $t = 1; |
44 | |
45 | for my $i (0..$#c) { |
3cd78934 |
46 | my $file = filename("f$i"); |
47 | open(F, "<$file") or die "$0: failed to open '$file' for reading: $!"; |
88632417 |
48 | binmode(F, ":utf8"); |
49 | my $c = <F>; |
50 | my $o = ord($c); |
51 | print $o == $c[$i] ? "ok $t - utf8 I/O $c[$i]\n" : "not ok $t - utf8 I/O $c[$i]: $o != $c[$i]\n"; |
52 | $t++; |
53 | } |
54 | |
3cd78934 |
55 | my $f = filename("f" . @f); |
88632417 |
56 | |
57 | push @f, $f; |
58 | open(F, ">$f") or die "$0: failed to open '$f' for writing: $!"; |
59 | binmode(F, ":raw"); # Output raw bytes. |
60 | print F chr(128); # Output illegal UTF-8. |
61 | close F; |
62 | open(F, $f) or die "$0: failed to open '$f' for reading: $!"; |
63 | binmode(F, ":encoding(utf-8)"); |
64 | { |
d1256cb1 |
65 | local $^W = 1; |
66 | local $SIG{__WARN__} = sub { $a = shift }; |
67 | eval { <F> }; # This should get caught. |
88632417 |
68 | } |
cc7dbc11 |
69 | close F; |
88632417 |
70 | print $a =~ qr{^utf8 "\\x80" does not map to Unicode} ? |
71 | "ok $t - illegal utf8 input\n" : "not ok $t - illegal utf8 input: a = " . unpack("H*", $a) . "\n"; |
72 | |
3cd78934 |
73 | # On VMS temporary file names like "f0." may be more readable than "f0" since |
74 | # "f0" could be a logical name pointing elsewhere. |
75 | sub filename { |
76 | my $name = shift; |
77 | $name .= '.' if $^O eq 'VMS'; |
78 | return $name; |
79 | } |
80 | |
88632417 |
81 | END { |
82 | 1 while unlink @f; |
83 | } |