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