X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fio%2Fcrlf.t;h=be514003a5c46c3aa79190423f8a26873dc6056b;hb=98641f606c65e71cca89f9a694e2796b5a21cbd8;hp=96f7ed7833594ee3be970c0feaae7366b4427b89;hpb=31d12d11428d1c60a1eda9dedfa22782c4331ecb;p=p5sagit%2Fp5-mst-13.2.git diff --git a/t/io/crlf.t b/t/io/crlf.t index 96f7ed7..be51400 100644 --- a/t/io/crlf.t +++ b/t/io/crlf.t @@ -11,11 +11,11 @@ require "test.pl"; my $file = "crlf$$.dat"; END { - unlink($file); + 1 while unlink($file); } if (find PerlIO::Layer 'perlio') { - plan(tests => 8); + plan(tests => 16); ok(open(FOO,">:crlf",$file)); ok(print FOO 'a'.((('a' x 14).qq{\n}) x 2000) || close(FOO)); ok(open(FOO,"<:crlf",$file)); @@ -32,8 +32,11 @@ if (find PerlIO::Layer 'perlio') { SKIP: { - if ($^X =~ /\bminiperl\b/) { skip(q/miniperl can't load PerlIO layers/) } - my $fcontents = join "", map {"$_\r\n"} "a".."zzz"; + skip("miniperl can't rely on loading PerlIO::scalar") + if $ENV{PERL_CORE_MINITEST}; + skip("no PerlIO::scalar") unless $Config{extensions} =~ m!\bPerlIO/scalar\b!; + require PerlIO::scalar; + my $fcontents = join "", map {"$_\015\012"} "a".."zzz"; open my $fh, "<:crlf", \$fcontents; local $/ = "xxx"; local $_ = <$fh>; @@ -45,6 +48,31 @@ if (find PerlIO::Layer 'perlio') { } ok(close(FOO)); + + # binmode :crlf should not cumulate. + # Try it first once and then twice so that even UNIXy boxes + # get to exercise this, for DOSish boxes even once is enough. + # Try also pushing :utf8 first so that there are other layers + # in between (this should not matter: CRLF layers still should + # not accumulate). + for my $utf8 ('', ':utf8') { + for my $binmode (1..2) { + open(FOO, ">$file"); + # require PerlIO; print PerlIO::get_layers(FOO), "\n"; + binmode(FOO, "$utf8:crlf") for 1..$binmode; + # require PerlIO; print PerlIO::get_layers(FOO), "\n"; + print FOO "Hello\n"; + close FOO; + open(FOO, "<$file"); + binmode(FOO); + my $foo = scalar ; + close FOO; + print join(" ", "#", map { sprintf("%02x", $_) } unpack("C*", $foo)), + "\n"; + ok($foo =~ /\x0d\x0a$/); + ok($foo !~ /\x0d\x0d/); + } + } } else { skip_all("No perlio, so no :crlf");