Commit | Line | Data |
a84e44cd |
1 | #!./perl -w |
2 | |
35a60386 |
3 | BEGIN { |
4 | unless(grep /blib/, @INC) { |
5 | chdir 't' if -d 't'; |
6 | @INC = '../lib'; |
7 | } |
8 | } |
a84e44cd |
9 | |
10 | use strict; |
35a60386 |
11 | require($ENV{PERL_CORE} ? "./test.pl" : "./t/test.pl"); |
12 | plan(tests => ($^O =~ /MSWin32/ ? 9 : 6)); |
a84e44cd |
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; |