Support building nonxs extensions from cpan/ on Unix.
[perl.git] / ext / Encode / t / perlio.t
1 BEGIN {
2     require Config; import Config;
3     if ($Config{'extensions'} !~ /\bEncode\b/) {
4       print "1..0 # Skip: Encode was not built\n";
5       exit 0;
6     }
7     if (ord("A") == 193) {
8     print "1..0 # Skip: EBCDIC\n";
9     exit 0;
10     }
11     unless (PerlIO::Layer->find('perlio')){
12         print "1..0 # Skip: PerlIO required\n";
13         exit 0;
14     }
15     $| = 1;
16 }
17
18 use strict;
19 use File::Basename;
20 use File::Spec;
21 use File::Compare qw(compare_text);
22 use File::Copy;
23 use FileHandle;
24
25 #use Test::More qw(no_plan);
26 use Test::More tests => 38;
27
28 our $DEBUG = 0;
29
30 use Encode (":all");
31 {
32     no warnings;
33     @ARGV and $DEBUG = shift;
34     #require Encode::JP::JIS7;
35     #require Encode::KR::2022_KR;
36     #$Encode::JP::JIS7::DEBUG = $DEBUG;
37 }
38
39 my $seq = 0;
40 my $dir = dirname(__FILE__);
41
42 my %e = 
43     (
44      jisx0208 => [ qw/euc-jp shiftjis 7bit-jis iso-2022-jp iso-2022-jp-1/],
45      ksc5601  => [ qw/euc-kr/],
46      gb2312   => [ qw/euc-cn hz/],
47     );
48
49 $/ = "\x0a"; # may fix VMS problem for test #28 and #29
50
51 for my $src (sort keys %e) {
52     my $ufile = File::Spec->catfile($dir,"$src.utf");
53     open my $fh, "<:utf8", $ufile or die "$ufile : $!";
54     my @uline = <$fh>;
55     my $utext = join('' => @uline);
56     close $fh;
57
58     for my $e (@{$e{$src}}){
59     my $sfile = File::Spec->catfile($dir,"$$.sio");
60     my $pfile = File::Spec->catfile($dir,"$$.pio");
61     
62     # first create a file without perlio
63     dump2file($sfile, &encode($e, $utext, 0));
64     
65     # then create a file via perlio without autoflush
66
67     SKIP:{
68         skip "$e: !perlio_ok", 4 unless (perlio_ok($e) or $DEBUG);
69         no warnings 'uninitialized';
70         open $fh, ">:encoding($e)", $pfile or die "$sfile : $!";
71         $fh->autoflush(0);
72         print $fh $utext;
73         close $fh;
74         $seq++;
75         is(compare_text($sfile, $pfile), 0 => ">:encoding($e)");
76         if ($DEBUG){
77         copy $sfile, "$sfile.$seq";
78         copy $pfile, "$pfile.$seq";
79         }
80         
81         # this time print line by line.
82         # works even for ISO-2022 but not ISO-2022-KR
83         open $fh, ">:encoding($e)", $pfile or die "$sfile : $!";
84         $fh->autoflush(1);
85         for my $l (@uline) {
86         print $fh $l;
87         }
88         close $fh;
89         $seq++;
90         is(compare_text($sfile, $pfile), 0 => ">:encoding($e) by lines");
91         if ($DEBUG){
92         copy $sfile, "$sfile.$seq";
93         copy $pfile, "$pfile.$seq";
94         }
95         my $dtext;
96         open $fh, "<:encoding($e)", $pfile or die "$pfile : $!";
97         $fh->autoflush(0);
98         $dtext = join('' => <$fh>);
99         close $fh;
100         $seq++;
101         ok($utext eq $dtext, "<:encoding($e)");
102         if ($DEBUG){
103         dump2file("$sfile.$seq", $utext);
104         dump2file("$pfile.$seq", $dtext);
105         }
106         if (perlio_ok($e) or $DEBUG){
107         $dtext = '';
108         open $fh, "<:encoding($e)", $pfile or die "$pfile : $!";
109         while(defined(my $l = <$fh>)) {
110             $dtext .= $l;
111         }
112         close $fh;
113         }
114         $seq++;
115         ok($utext eq $dtext,  "<:encoding($e) by lines");
116         if ($DEBUG){
117         dump2file("$sfile.$seq", $utext);
118         dump2file("$pfile.$seq", $dtext);
119         }
120     }
121      if ( ! $DEBUG ) {
122             1 while unlink ($sfile);
123             1 while unlink ($pfile);
124         }
125     }
126 }
127
128 # BOM Test
129
130 SKIP:{
131     my $pev = PerlIO::encoding->VERSION;
132     skip "PerlIO::encoding->VERSION = $pev <= 0.07 ", 6
133     unless ($pev >= 0.07 or $DEBUG);
134
135     my $file = File::Spec->catfile($dir,"jisx0208.utf");
136     open my $fh, "<:utf8", $file or die "$file : $!";
137     my $str = join('' => <$fh>);
138     close $fh;
139     my %bom = (
140            'UTF-16BE' => pack('n', 0xFeFF),
141            'UTF-16LE' => pack('v', 0xFeFF),
142            'UTF-32BE' => pack('N', 0xFeFF),
143            'UTF-32LE' => pack('V', 0xFeFF),
144           );
145     # reading
146     for my $utf (sort keys %bom){
147     my $bomed = $bom{$utf} . encode($utf, $str);
148     my $sfile = File::Spec->catfile($dir,".${utf}_${seq}_$$");
149     dump2file($sfile, $bomed);
150     my $utf_nobom = $utf; $utf_nobom =~ s/(LE|BE)$//o;
151     # reading
152     open $fh, "<:encoding($utf_nobom)", $sfile or die "$sfile : $!";
153     my $cmp = join '' => <$fh>;
154     close $fh;
155     is($str, $cmp, "<:encoding($utf_nobom) eq $utf");
156     unlink $sfile;  $seq++;
157     }
158     # writing
159     for my $utf_nobom (qw/UTF-16 UTF-32/){
160     my $utf = $utf_nobom . 'BE';
161     my $sfile = File::Spec->catfile($dir,".${utf_nobom}_${seq}_$$");
162     my $bomed = $bom{$utf} . encode($utf, $str);
163     open  $fh, ">:encoding($utf_nobom)", $sfile or die "$sfile : $!";
164     print $fh $str;
165     close $fh;
166     open my $fh, "<:bytes", $sfile or die "$sfile : $!";
167     read $fh, my $cmp, -s $sfile;
168     close $fh;
169     use bytes ();
170     ok($bomed eq $cmp, ">:encoding($utf_nobom) eq $utf");
171     unlink $sfile; $seq++;
172     }
173 }
174 sub dump2file{
175     no warnings;
176     open my $fh, ">", $_[0] or die "$_[0]: $!";
177     binmode $fh;
178     print $fh $_[1];
179     close $fh;
180 }