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; |
6d1c0808 |
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; |
6d1c0808 |
31 | use File::Copy; |
85982a32 |
32 | use FileHandle; |
33 | |
34 | #use Test::More qw(no_plan); |
35 | use Test::More tests => 20; |
36 | |
37 | our $DEBUG = 0; |
38 | |
39 | { |
40 | no warnings; |
41 | @ARGV and $DEBUG = shift; |
42 | require Encode::JP::JIS7; |
43 | $Encode::JP::JIS7::DEBUG = $DEBUG; |
44 | } |
45 | |
46 | Encode->import(":all"); |
47 | |
48 | my $dir = dirname(__FILE__); |
49 | my $ufile = File::Spec->catfile($dir,"jisx0208.ref"); |
50 | open my $fh, "<:utf8", $ufile or die "$ufile : $!"; |
51 | my @uline = <$fh>; |
52 | my $utext = join('' => @uline); |
53 | close $fh; |
6d1c0808 |
54 | my $seq = 0; |
85982a32 |
55 | |
56 | for my $e (qw/euc-jp shiftjis 7bit-jis iso-2022-jp iso-2022-jp-1/){ |
57 | my $sfile = File::Spec->catfile($dir,"$$.sio"); |
58 | my $pfile = File::Spec->catfile($dir,"$$.pio"); |
59 | |
60 | # first create a file without perlio |
6d1c0808 |
61 | dump2file($sfile, &encode($e, $utext, 0)); |
62 | |
85982a32 |
63 | # then create a file via perlio without autoflush |
64 | |
6d1c0808 |
65 | SKIP:{ |
66 | skip "$e: !perlio_ok", 1 unless perlio_ok($e) or $DEBUG; |
85982a32 |
67 | open $fh, ">:encoding($e)", $pfile or die "$sfile : $!"; |
68 | $fh->autoflush(0); |
69 | print $fh $utext; |
70 | close $fh; |
6d1c0808 |
71 | $seq++; |
72 | unless (is(compare($sfile, $pfile), 0 => ">:encoding($e)")){ |
73 | copy $sfile, "$sfile.$seq"; |
74 | copy $pfile, "$pfile.$seq"; |
75 | } |
85982a32 |
76 | } |
77 | |
78 | # this time print line by line. |
79 | # works even for ISO-2022! |
80 | open $fh, ">:encoding($e)", $pfile or die "$sfile : $!"; |
81 | $fh->autoflush(1); |
82 | for my $l (@uline) { |
83 | print $fh $l; |
84 | } |
85 | close $fh; |
6d1c0808 |
86 | $seq++; |
87 | unless(is(compare($sfile, $pfile), 0 |
88 | => ">:encoding($e); by lines")){ |
89 | copy $sfile, "$sfile.$seq"; |
90 | copy $pfile, "$pfile.$seq"; |
91 | } |
85982a32 |
92 | |
6d1c0808 |
93 | SKIP:{ |
94 | skip "$e: !perlio_ok", 2 unless perlio_ok($e) or $DEBUG; |
85982a32 |
95 | open $fh, "<:encoding($e)", $pfile or die "$pfile : $!"; |
96 | $fh->autoflush(0); |
97 | my $dtext = join('' => <$fh>); |
98 | close $fh; |
6d1c0808 |
99 | $seq++; |
100 | unless(ok($utext eq $dtext, "<:encoding($e)")){ |
101 | dump2file("$sfile.$seq", $utext); |
102 | dump2file("$pfile.$seq", $dtext); |
103 | } |
85982a32 |
104 | $dtext = ''; |
105 | open $fh, "<:encoding($e)", $pfile or die "$pfile : $!"; |
106 | while(defined(my $l = <$fh>)) { |
107 | $dtext .= $l; |
108 | } |
109 | close $fh; |
6d1c0808 |
110 | $seq++; |
111 | unless (ok($utext eq $dtext, "<:encoding($e); by lines")) { |
112 | dump2file("$sfile.$seq", $utext); |
113 | dump2file("$pfile.$seq", $dtext); |
114 | } |
115 | } |
85982a32 |
116 | $DEBUG or unlink ($sfile, $pfile); |
117 | } |
118 | |
6d1c0808 |
119 | sub dump2file{ |
120 | no warnings; |
121 | open my $fh, ">", $_[0] or die "$_[0]: $!"; |
122 | binmode $fh; |
123 | print $fh $_[1]; |
124 | close $fh; |
125 | } |