Move Encode from ext/ to cpan/
[perl.git] / cpan / Encode / t / enc_eucjp.t
1 # $Id: enc_eucjp.t,v 2.1 2006/05/03 18:24:10 dankogai Exp $
2 # This is the twin of enc_utf8.t .
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') {
11     print "1..0 # Skip: PerlIO was not built\n";
12     exit 0;
13     }
14     if (ord("A") == 193) {
15     print "1..0 # encoding pragma does not support EBCDIC platforms\n";
16     exit(0);
17     }
18     if ($] <= 5.008 and !$Config{perl_patchlevel}){
19     print "1..0 # Skip: Perl 5.8.1 or later required\n";
20     exit 0;
21     }
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) {
33   no warnings 'pack';
34   my $file = filename("f$i");
35   push @f, $file;
36   open(F, ">$file") or die "$0: failed to open '$file' for writing: $!";
37   binmode(F, ":utf8");
38   print F chr($c[$i]);
39   print F pack("C" => $c[$i]);
40   close F;
41 }
42
43 my $t = 1;
44
45 for my $i (0..$#c) {
46   my $file = filename("f$i");
47   open(F, "<$file") or die "$0: failed to open '$file' for reading: $!";
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
55 my $f = filename("f" . @f);
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 {
65     local $^W = 1;
66     local $SIG{__WARN__} = sub { $a = shift };
67     eval { <F> }; # This should get caught.
68 }
69 close F;
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
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
81 END {
82   1 while unlink @f;
83 }