Commit | Line | Data |
85982a32 |
1 | BEGIN { |
2 | if ($ENV{'PERL_CORE'}){ |
3 | chdir 't'; |
4 | unshift @INC, '../lib'; |
5 | } |
6 | require Config; import Config; |
7 | if ($Config{'extensions'} !~ /\bEncode\b/) { |
8 | print "1..0 # Skip: Encode was not built\n"; |
9 | exit 0; |
10 | } |
11 | if (ord("A") == 193) { |
12 | print "1..0 # Skip: EBCDIC\n"; |
13 | exit 0; |
14 | } |
15 | require Encode; |
ca777f1c |
16 | eval { require PerlIO::encoding }; |
17 | unless ($INC{"PerlIO/encoding.pm"} |
85982a32 |
18 | and PerlIO::encoding->VERSION >= 0.02 |
19 | ){ |
20 | print "1..0 # Skip:: PerlIO::encoding 0.02 or better required\n"; |
21 | exit 0; |
22 | } |
23 | # warn "PerlIO::encoding->VERSION == ", PerlIO::encoding->VERSION, "\n"; |
24 | $| = 1; |
25 | } |
26 | |
27 | use strict; |
28 | use File::Basename; |
29 | use File::Spec; |
30 | use File::Compare; |
31 | use FileHandle; |
32 | |
33 | #use Test::More qw(no_plan); |
34 | use Test::More tests => 20; |
35 | |
36 | our $DEBUG = 0; |
37 | |
38 | { |
39 | no warnings; |
40 | @ARGV and $DEBUG = shift; |
41 | require Encode::JP::JIS7; |
42 | $Encode::JP::JIS7::DEBUG = $DEBUG; |
43 | } |
44 | |
45 | Encode->import(":all"); |
46 | |
47 | my $dir = dirname(__FILE__); |
48 | my $ufile = File::Spec->catfile($dir,"jisx0208.ref"); |
49 | open my $fh, "<:utf8", $ufile or die "$ufile : $!"; |
50 | my @uline = <$fh>; |
51 | my $utext = join('' => @uline); |
52 | close $fh; |
53 | |
54 | for my $e (qw/euc-jp shiftjis 7bit-jis iso-2022-jp iso-2022-jp-1/){ |
55 | my $sfile = File::Spec->catfile($dir,"$$.sio"); |
56 | my $pfile = File::Spec->catfile($dir,"$$.pio"); |
57 | |
58 | # first create a file without perlio |
59 | open $fh, ">", $sfile or die "$sfile :$!"; |
60 | binmode $fh; |
61 | print $fh &encode($e, $utext, 0); |
62 | close $fh; |
63 | |
64 | # then create a file via perlio without autoflush |
65 | |
e66821e8 |
66 | # TODO:{ |
67 | # local $TODO = "perlio broken"; |
68 | # todo_skip "$e: !perlio_ok", 1 unless perlio_ok($e); |
85982a32 |
69 | open $fh, ">:encoding($e)", $pfile or die "$sfile : $!"; |
70 | $fh->autoflush(0); |
71 | print $fh $utext; |
72 | close $fh; |
73 | ok(compare($sfile, $pfile) == 0 => ">:encoding($e)"); |
e66821e8 |
74 | # } |
85982a32 |
75 | |
76 | # this time print line by line. |
77 | # works even for ISO-2022! |
78 | open $fh, ">:encoding($e)", $pfile or die "$sfile : $!"; |
79 | $fh->autoflush(1); |
80 | for my $l (@uline) { |
81 | print $fh $l; |
82 | } |
83 | close $fh; |
84 | is(compare($sfile, $pfile), 0 => ">:encoding($e); line-by-line"); |
85 | |
e66821e8 |
86 | # TODO:{ |
87 | # local $TODO = "perlio broken"; |
88 | # todo_skip "$e: !perlio_ok", 2 unless perlio_ok($e); |
85982a32 |
89 | open $fh, "<:encoding($e)", $pfile or die "$pfile : $!"; |
90 | $fh->autoflush(0); |
91 | my $dtext = join('' => <$fh>); |
92 | close $fh; |
93 | ok($utext eq $dtext, "<:encoding($e)"); |
94 | $dtext = ''; |
95 | open $fh, "<:encoding($e)", $pfile or die "$pfile : $!"; |
96 | while(defined(my $l = <$fh>)) { |
97 | $dtext .= $l; |
98 | } |
99 | close $fh; |
100 | ok($utext eq $dtext, "<:encoding($e); line-by-line"); |
e66821e8 |
101 | # } |
85982a32 |
102 | $DEBUG or unlink ($sfile, $pfile); |
103 | } |
104 | |