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