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 | } |
011b2d2f |
15 | unless (PerlIO::Layer->find('perlio')){ |
16 | print "1..0 # Skip: PerlIO required\n"; |
17 | exit 0; |
18 | } |
85982a32 |
19 | $| = 1; |
20 | } |
21 | |
22 | use strict; |
23 | use File::Basename; |
24 | use File::Spec; |
0ab8f81e |
25 | use File::Compare qw(compare_text); |
6d1c0808 |
26 | use File::Copy; |
85982a32 |
27 | use FileHandle; |
28 | |
29 | #use Test::More qw(no_plan); |
0ab8f81e |
30 | use Test::More tests => 28; |
85982a32 |
31 | |
32 | our $DEBUG = 0; |
33 | |
0ab8f81e |
34 | use Encode (":all"); |
85982a32 |
35 | { |
36 | no warnings; |
37 | @ARGV and $DEBUG = shift; |
0ab8f81e |
38 | #require Encode::JP::JIS7; |
39 | #require Encode::KR::2022_KR; |
40 | #$Encode::JP::JIS7::DEBUG = $DEBUG; |
85982a32 |
41 | } |
42 | |
85982a32 |
43 | |
0ab8f81e |
44 | |
6d1c0808 |
45 | my $seq = 0; |
0ab8f81e |
46 | my $dir = dirname(__FILE__); |
85982a32 |
47 | |
0ab8f81e |
48 | my %e = |
49 | ( |
50 | jisx0208 => [ qw/euc-jp shiftjis 7bit-jis iso-2022-jp iso-2022-jp-1/], |
51 | #ksc5601 => [ qw/euc-kr iso-2022-kr/], |
52 | ksc5601 => [ qw/euc-kr/], |
53 | #gb2312 => [ qw/euc-cn hz/], |
54 | gb2312 => [ qw/euc-cn/], |
55 | ); |
85982a32 |
56 | |
f74b3917 |
57 | $/ = "\x0a"; # may fix VMS problem for test #28 and #29 |
c00aecee |
58 | |
0ab8f81e |
59 | for my $src(sort keys %e) { |
ef175861 |
60 | my $ufile = File::Spec->catfile($dir,"$src.utf"); |
0ab8f81e |
61 | open my $fh, "<:utf8", $ufile or die "$ufile : $!"; |
62 | my @uline = <$fh>; |
63 | my $utext = join('' => @uline); |
85982a32 |
64 | close $fh; |
85982a32 |
65 | |
0ab8f81e |
66 | for my $e (@{$e{$src}}){ |
67 | my $sfile = File::Spec->catfile($dir,"$$.sio"); |
68 | my $pfile = File::Spec->catfile($dir,"$$.pio"); |
69 | |
70 | # first create a file without perlio |
71 | dump2file($sfile, &encode($e, $utext, 0)); |
72 | |
73 | # then create a file via perlio without autoflush |
74 | |
75 | TODO:{ |
76 | #local $TODO = "$e: !perlio_ok" unless (perlio_ok($e) or $DEBUG); |
77 | todo_skip "$e: !perlio_ok", 4 unless (perlio_ok($e) or $DEBUG); |
78 | no warnings 'uninitialized'; |
79 | open $fh, ">:encoding($e)", $pfile or die "$sfile : $!"; |
80 | $fh->autoflush(0); |
81 | print $fh $utext; |
82 | close $fh; |
83 | $seq++; |
84 | is(compare_text($sfile, $pfile), 0 => ">:encoding($e)"); |
85 | if ($DEBUG){ |
86 | copy $sfile, "$sfile.$seq"; |
87 | copy $pfile, "$pfile.$seq"; |
88 | } |
89 | |
90 | # this time print line by line. |
91 | # works even for ISO-2022 but not ISO-2022-KR |
92 | open $fh, ">:encoding($e)", $pfile or die "$sfile : $!"; |
93 | $fh->autoflush(1); |
94 | for my $l (@uline) { |
95 | print $fh $l; |
96 | } |
97 | close $fh; |
98 | $seq++; |
99 | is(compare_text($sfile, $pfile), 0 => ">:encoding($e) by lines"); |
100 | if ($DEBUG){ |
101 | copy $sfile, "$sfile.$seq"; |
102 | copy $pfile, "$pfile.$seq"; |
103 | } |
104 | my $dtext; |
105 | open $fh, "<:encoding($e)", $pfile or die "$pfile : $!"; |
106 | $fh->autoflush(0); |
107 | $dtext = join('' => <$fh>); |
108 | close $fh; |
109 | $seq++; |
110 | ok($utext eq $dtext, "<:encoding($e)"); |
111 | if ($DEBUG){ |
112 | dump2file("$sfile.$seq", $utext); |
113 | dump2file("$pfile.$seq", $dtext); |
114 | } |
115 | if (perlio_ok($e) or $DEBUG){ |
116 | $dtext = ''; |
117 | open $fh, "<:encoding($e)", $pfile or die "$pfile : $!"; |
118 | while(defined(my $l = <$fh>)) { |
119 | $dtext .= $l; |
120 | } |
121 | close $fh; |
122 | } |
123 | $seq++; |
124 | ok($utext eq $dtext, "<:encoding($e) by lines"); |
125 | if ($DEBUG){ |
126 | dump2file("$sfile.$seq", $utext); |
127 | dump2file("$pfile.$seq", $dtext); |
128 | } |
6d1c0808 |
129 | } |
0ab8f81e |
130 | $DEBUG or unlink ($sfile, $pfile); |
6d1c0808 |
131 | } |
85982a32 |
132 | } |
0ab8f81e |
133 | |
85982a32 |
134 | |
6d1c0808 |
135 | sub dump2file{ |
136 | no warnings; |
137 | open my $fh, ">", $_[0] or die "$_[0]: $!"; |
138 | binmode $fh; |
139 | print $fh $_[1]; |
140 | close $fh; |
141 | } |