ext/IO/t/io_file.t

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