| 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;
|
|---|