1#!./perl -w 2 3BEGIN { 4 chdir 't' if -d 't'; 5 @INC = qw(. ../lib); 6} 7 8use Config; 9 10require "test.pl"; 11 12my $file = "crlf$$.dat"; 13END { 14 1 while unlink($file); 15} 16 17if (find PerlIO::Layer 'perlio') { 18 plan(tests => 16); 19 ok(open(FOO,">:crlf",$file)); 20 ok(print FOO 'a'.((('a' x 14).qq{\n}) x 2000) || close(FOO)); 21 ok(open(FOO,"<:crlf",$file)); 22 23 my $text; 24 { local $/; $text = <FOO> } 25 is(count_chars($text, "\015\012"), 0); 26 is(count_chars($text, "\n"), 2000); 27 28 binmode(FOO); 29 seek(FOO,0,0); 30 { local $/; $text = <FOO> } 31 is(count_chars($text, "\015\012"), 2000); 32 33 SKIP: 34 { 35 skip("miniperl can't rely on loading PerlIO::scalar") 36 if $ENV{PERL_CORE_MINITEST}; 37 eval 'PerlIO::scalar'; 38 my $fcontents = join "", map {"$_\015\012"} "a".."zzz"; 39 open my $fh, "<:crlf", \$fcontents; 40 local $/ = "xxx"; 41 local $_ = <$fh>; 42 my $pos = tell $fh; # pos must be behind "xxx", before "\nyyy\n" 43 seek $fh, $pos, 0; 44 $/ = "\n"; 45 $s = <$fh>.<$fh>; 46 ok($s eq "\nxxy\n"); 47 } 48 49 ok(close(FOO)); 50 51 # binmode :crlf should not cumulate. 52 # Try it first once and then twice so that even UNIXy boxes 53 # get to exercise this, for DOSish boxes even once is enough. 54 # Try also pushing :utf8 first so that there are other layers 55 # in between (this should not matter: CRLF layers still should 56 # not accumulate). 57 for my $utf8 ('', ':utf8') { 58 for my $binmode (1..2) { 59 open(FOO, ">$file"); 60 # require PerlIO; print PerlIO::get_layers(FOO), "\n"; 61 binmode(FOO, "$utf8:crlf") for 1..$binmode; 62 # require PerlIO; print PerlIO::get_layers(FOO), "\n"; 63 print FOO "Hello\n"; 64 close FOO; 65 open(FOO, "<$file"); 66 binmode(FOO); 67 my $foo = scalar <FOO>; 68 close FOO; 69 print join(" ", "#", map { sprintf("%02x", $_) } unpack("C*", $foo)), 70 "\n"; 71 ok($foo =~ /\x0d\x0a$/); 72 ok($foo !~ /\x0d\x0d/); 73 } 74 } 75} 76else { 77 skip_all("No perlio, so no :crlf"); 78} 79 80sub count_chars { 81 my($text, $chars) = @_; 82 my $seen = 0; 83 $seen++ while $text =~ /$chars/g; 84 return $seen; 85} 86