[perluniintro vs Encode::Alias] Is KOI8R is an alise for koi8-r?
[p5sagit/p5-mst-13.2.git] / ext / Encode / t / enc_eucjp.t
CommitLineData
8676e7d3 1# $Id: enc_eucjp.t,v 1.4 2003/04/24 17:43:16 dankogai Exp $
cc7dbc11 2# This is the twin of enc_utf8.t .
88632417 3
4BEGIN {
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 }
151b5d36 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 }
88632417 22}
23
24use encoding 'euc-jp';
25
26my @c = (127, 128, 255, 256);
27
28print "1.." . (scalar @c + 1) . "\n";
29
30my @f;
31
32for my $i (0..$#c) {
8676e7d3 33 no warnings 'pack';
88632417 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
42my $t = 1;
43
44for 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
53my $f = "f" . @f;
54
55push @f, $f;
56open(F, ">$f") or die "$0: failed to open '$f' for writing: $!";
57binmode(F, ":raw"); # Output raw bytes.
58print F chr(128); # Output illegal UTF-8.
59close F;
60open(F, $f) or die "$0: failed to open '$f' for reading: $!";
61binmode(F, ":encoding(utf-8)");
62{
63 local $^W = 1;
64 local $SIG{__WARN__} = sub { $a = shift };
65 eval { <F> }; # This should get caught.
66}
cc7dbc11 67close F;
88632417 68print $a =~ qr{^utf8 "\\x80" does not map to Unicode} ?
69 "ok $t - illegal utf8 input\n" : "not ok $t - illegal utf8 input: a = " . unpack("H*", $a) . "\n";
70
71END {
72 1 while unlink @f;
73}