xref: /openbsd-src/gnu/usr.bin/perl/cpan/Encode/t/enc_module.t (revision 3d61058aa5c692477b6d18acfbbdb653a9930ff9)
1*3d61058aSafresh1# $Id: enc_module.t,v 2.7 2023/11/10 01:10:50 dankogai Exp $
2b39c5158Smillert# This file is in euc-jp
3b39c5158SmillertBEGIN {
4*3d61058aSafresh1    require Config; Config->import();
5b39c5158Smillert    if ($Config{'extensions'} !~ /\bEncode\b/) {
6b39c5158Smillert      print "1..0 # Skip: Encode was not built\n";
7b39c5158Smillert      exit 0;
8b39c5158Smillert    }
9b39c5158Smillert    unless (find PerlIO::Layer 'perlio') {
10b39c5158Smillert    print "1..0 # Skip: PerlIO was not built\n";
11b39c5158Smillert    exit 0;
12b39c5158Smillert    }
13b39c5158Smillert    if (defined ${^UNICODE} and ${^UNICODE} != 0){
14b39c5158Smillert    print "1..0 # Skip: \${^UNICODE} == ${^UNICODE}\n";
15b39c5158Smillert    exit 0;
16b39c5158Smillert    }
17b39c5158Smillert    if (ord("A") == 193) {
189f11ffb7Safresh1    print "1..0 # Skip: encoding pragma does not support EBCDIC platforms\n";
199f11ffb7Safresh1    exit(0);
209f11ffb7Safresh1    }
219f11ffb7Safresh1    if ($] >= 5.025 and !$Config{usecperl}) {
22eac174f2Safresh1    print "1..0 # Skip: encoding pragma not supported in Perl 5.25 or later\n";
23b39c5158Smillert    exit(0);
24b39c5158Smillert    }
25b39c5158Smillert}
26b39c5158Smillertuse lib qw(t ext/Encode/t ../ext/Encode/t); # latter 2 for perl core
27b39c5158Smillertuse Mod_EUCJP;
28e9ce3842Safresh1no warnings "deprecated";
29b39c5158Smillertuse encoding "euc-jp";
30b39c5158Smillertuse Test::More tests => 3;
31b39c5158Smillertuse File::Basename;
32b39c5158Smillertuse File::Spec;
33b39c5158Smillertuse File::Compare qw(compare_text);
34b39c5158Smillert
35b39c5158Smillertmy $DEBUG = shift || 0;
36b39c5158Smillertmy $dir = dirname(__FILE__);
37b39c5158Smillertmy $file0 = File::Spec->catfile($dir,"enc_module.enc");
38b39c5158Smillertmy $file1 = File::Spec->catfile($dir,"$$.enc");
39b39c5158Smillert
40b39c5158Smillertmy $obj = Mod_EUCJP->new;
41b39c5158Smillertlocal $SIG{__WARN__} = sub{ $DEBUG and print STDERR @_ };
42b39c5158Smillert# to silence reopening STD(IN|OUT) w/o closing unless $DEBUG
43b39c5158Smillert
44b39c5158Smillertopen STDOUT, ">", $file1 or die "$file1:$!";
45b39c5158Smillertprint $obj->str, "\n";
46b39c5158Smillert$obj->set("�ƥ���ʸ����");
47b39c5158Smillertprint $obj->str, "\n";
48b39c5158Smillert
49b39c5158Smillert# Please do not move this to a point after the comparison -- Craig Berry
50b39c5158Smillert# and "unless $^O eq 'freebsd'" is needed for FreeBSD (toy-)?thread
51b39c5158Smillert# -- dankogai
52b39c5158Smillertclose STDOUT unless $^O eq 'freebsd';
53b39c5158Smillert
54b39c5158Smillertmy $cmp = compare_text($file0, $file1);
55b39c5158Smillertis($cmp, 0, "encoding vs. STDOUT");
56b39c5158Smillert
57b39c5158Smillertmy @cmp = qw/���ʸ���� �ƥ���ʸ����/;
58b39c5158Smillertopen STDIN, "<", $file0 or die "$file0:$!";
59b39c5158Smillert$obj = Mod_EUCJP->new;
60b39c5158Smillertmy $i = 0;
61b39c5158Smillertwhile(<STDIN>){
62b39c5158Smillert    s/\r?\n\z//;
63b39c5158Smillert    is ($cmp[$i++], $_, "encoding vs. STDIN - $i");
64b39c5158Smillert}
65b39c5158Smillert
66b39c5158Smillertunlink $file1 unless $cmp;
67b39c5158Smillert__END__
68b39c5158Smillert
69