Win32: encode/t/perlio.t needs some binmode

[p5sagit/p5-mst-13.2.git] / ext / Encode / t / perlio.t

diff --git a/ext/Encode/t/perlio.t b/ext/Encode/t/perlio.t
index 74e3e7b..936eeb0 100644 (file)
--- a/ext/Encode/t/perlio.t
+++ b/ext/Encode/t/perlio.t
@@ -13,7 +13,8 @@ BEGIN {
        exit 0;
     }
     require Encode;
-    unless ($INC{"PerlIO/encoding.pm"} 
+    eval { require PerlIO::encoding };
+    unless ($INC{"PerlIO/encoding.pm"}
            and PerlIO::encoding->VERSION >= 0.02
           ){
        print "1..0 # Skip:: PerlIO::encoding 0.02 or better required\n";
@@ -27,6 +28,7 @@ use strict;
 use File::Basename;
 use File::Spec;
 use File::Compare;
+use File::Copy;
 use FileHandle;
 
 #use Test::More qw(no_plan);
@@ -49,53 +51,77 @@ open my $fh, "<:utf8", $ufile or die "$ufile : $!";
 my @uline = <$fh>;
 my $utext = join('' => @uline);
 close $fh;
+my $seq = 0;
 
 for my $e (qw/euc-jp shiftjis 7bit-jis iso-2022-jp iso-2022-jp-1/){
     my $sfile = File::Spec->catfile($dir,"$$.sio");
     my $pfile = File::Spec->catfile($dir,"$$.pio");
 
     # first create a file without perlio
-    open $fh, ">", $sfile or die "$sfile :$!";
-    binmode $fh;
-    print $fh &encode($e, $utext, 0);
-    close $fh;
-
+    dump2file($sfile, &encode($e, $utext, 0));
+    
     # then create a file via perlio without autoflush
        
- TODO:{
-       todo_skip "$e: !perlio_ok", 1  unless perlio_ok($e);
+ SKIP:{
+       skip "$e: !perlio_ok", 1  unless perlio_ok($e) or $DEBUG;
        open $fh, ">:encoding($e)", $pfile or die "$sfile : $!";
+       binmode $fh;
        $fh->autoflush(0);
        print $fh $utext;
        close $fh;
-       ok(compare($sfile, $pfile) == 0 => ">:encoding($e)");
+       $seq++;
+       unless (is(compare($sfile, $pfile), 0 => ">:encoding($e)")){
+           copy $sfile, "$sfile.$seq";
+           copy $pfile, "$pfile.$seq";
+       }
     }
        
     # this time print line by line.
     # works even for ISO-2022!
     open $fh, ">:encoding($e)", $pfile or die "$sfile : $!";
+    binmode $fh;
     $fh->autoflush(1);
     for my $l (@uline) {
        print $fh $l;
     }
     close $fh;
-    is(compare($sfile, $pfile), 0 => ">:encoding($e); line-by-line");
+    $seq++;
+    unless(is(compare($sfile, $pfile), 0
+             => ">:encoding($e); by lines")){
+       copy $sfile, "$sfile.$seq";
+       copy $pfile, "$pfile.$seq";
+    }
 
- TODO:{
-       todo_skip "$e: !perlio_ok", 2 unless perlio_ok($e);
+ SKIP:{
+       skip "$e: !perlio_ok", 2 unless perlio_ok($e) or $DEBUG;
        open $fh, "<:encoding($e)", $pfile or die "$pfile : $!";
        $fh->autoflush(0);
        my $dtext = join('' => <$fh>);
        close $fh;
-       ok($utext eq $dtext, "<:encoding($e)");
+       $seq++;
+       unless(ok($utext eq $dtext, "<:encoding($e)")){
+           dump2file("$sfile.$seq", $utext);
+           dump2file("$pfile.$seq", $dtext);
+       }
        $dtext = '';
        open $fh, "<:encoding($e)", $pfile or die "$pfile : $!";
        while(defined(my $l = <$fh>)) {
            $dtext .= $l;
        }
        close $fh;
-       ok($utext eq $dtext, "<:encoding($e); line-by-line");
-    }    
+       $seq++;
+       unless (ok($utext eq $dtext,  "<:encoding($e); by lines")) {
+           dump2file("$sfile.$seq", $utext);
+           dump2file("$pfile.$seq", $dtext);
+       }
+    }
     $DEBUG or unlink ($sfile, $pfile);
 }
 
+sub dump2file{
+    no warnings;
+    open my $fh, ">", $_[0] or die "$_[0]: $!";
+    binmode $fh;
+    print $fh $_[1];
+    close $fh;
+}