ext/IO/t/io_file.t

   1 #!./perl -w
   2
   3 BEGIN { chdir 't' if -d 't'; }
   4
   5 use strict;
   6 use lib '../lib';
   7 use Test::More tests => 9;
   8
   9 my $Class       = 'IO::File';
  10 my $All_Chars   = join '', "\r\n", map( chr, 1..255 ), "zzz\n\r";
  11 my $File        = 'bin.'.$$;
  12 my $Expect      = quotemeta $All_Chars;
  13
  14 use_ok( $Class );
  15 can_ok( $Class,                 "binmode" );
  16
  17 ### file the file with binary data;
  18 ### use standard open to make sure we can compare binmodes
  19 ### on both.
  20 {   my $tmp;
  21     open $tmp, ">$File" or die "Could not open '$File': $!";
  22     binmode $tmp;
  23     print $tmp $All_Chars;
  24     close $tmp;
  25 }
  26
  27 ### now read in the file, once without binmode, once with.
  28 ### without binmode should fail at least on win32...
  29 if( $^O =~ /MSWin32/ ) {
  30     my $fh = $Class->new;
  31
  32     isa_ok( $fh,                $Class );
  33     ok( $fh->open($File),       "   Opened '$File'" );
  34
  35     my $cont = do { local $/; <$fh> };
  36     unlike( $cont, qr/$Expect/, "   Content match fails without binmode" );
  37 }
  38
  39 ### now with binmode, it must pass
  40 {   my $fh = $Class->new;
  41
  42     isa_ok( $fh,                $Class );
  43     ok( $fh->open($File),       "   Opened '$File' $!" );
  44     ok( $fh->binmode,           "   binmode enabled" );
  45
  46     my $cont = do { local $/; <$fh> };
  47     like( $cont, qr/$Expect/,   "   Content match passes with binmode" );
  48 }
  49
  50 unlink $File;