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