Make (hopefully) the Windows CR CR LF bug go away

by making the CRLF layer repel any other CRLF layers.
In other words: binmode(FH, ":crlf") in e.g. Win32
is effectively a no-op since there already is one
CRLF layer in the stack by default.

p4raw-id: //depot/perl@20674

2 files changed, 41 insertions, 10 deletions

diff --git a/t/io/crlf.t b/t/io/crlf.t
index 084be211fd..2ee7b83191 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));
@@ -47,6 +47,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 <FOO>;
+	 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");
diff --git a/t/io/layers.t b/t/io/layers.t
index 31bb13b0d1..904ef93fa2 100644
--- a/t/io/layers.t
+++ b/t/io/layers.t
@@ -25,8 +25,6 @@ BEGIN {
     $PERLIO = exists $ENV{PERLIO} ? $ENV{PERLIO} : "(undef)";
 }
 
-plan tests => 43;
-
 use Config;
 
 my $DOSISH    = $^O =~ /^(?:MSWin32|os2|dos|NetWare|mint)$/ ? 1 : 0;
@@ -34,6 +32,10 @@ my $DOSISH    = $^O =~ /^(?:MSWin32|os2|dos|NetWare|mint)$/ ? 1 : 0;
 my $NONSTDIO  = exists $ENV{PERLIO} && $ENV{PERLIO} ne 'stdio'     ? 1 : 0;
 my $FASTSTDIO = $Config{d_faststdio} && $Config{usefaststdio}      ? 1 : 0;
 
+my $NTEST = 43 - (($DOSISH || !$FASTSTDIO) ? 7 : 0) - ($DOSISH ? 5 : 0);
+
+plan tests => $NTEST;
+
 print <<__EOH__;
 # PERLIO    = $PERLIO
 # DOSISH    = $DOSISH
@@ -42,7 +44,7 @@ print <<__EOH__;
 __EOH__
 
 SKIP: {
-    skip("This perl does not have Encode", 43)
+    skip("This perl does not have Encode", $NTEST)
 	unless " $Config{extensions} " =~ / Encode /;
 
     sub check {
@@ -80,8 +82,14 @@ SKIP: {
 		   $result->[0] eq "unix" &&
 		   $result->[1] eq "crlf";
 	}
+	if ($DOSISH && grep { $_ eq 'crlf' } @$expected) {
+	    # 5 tests potentially skipped because
+	    # DOSISH systems already have a CRLF layer
+	    # which will make new ones not stick.
+	    @$expected = grep { $_ ne 'crlf' } @$expected;
+	}
 	my $n = scalar @$expected;
-	is($n, scalar @$expected, "$id - layers = $n");
+	is($n, scalar @$expected, "$id - layers == $n");
 	for (my $i = 0; $i < $n; $i++) {
 	    my $j = $expected->[$i];
 	    if (ref $j eq 'CODE') {
@@ -122,7 +130,6 @@ SKIP: {
 	  [ "stdio" ],
 	  ":raw");
 
-    binmode(F, ":pop") if $DOSISH; # Drop one extra :crlf.
     binmode(F, ":utf8");
 
     check([ PerlIO::get_layers(F) ],
@@ -149,9 +156,8 @@ SKIP: {
 
     binmode(F, ":raw :encoding(latin1)"); # "latin1" will be canonized
 
-    SKIP: {
-	skip("too complex layer coreography", 7) if $DOSISH || !$FASTSTDIO;
-
+    # 7 tests potentially skipped.
+    unless ($DOSISH || !$FASTSTDIO) {
 	my @results = PerlIO::get_layers(F, details => 1);
 
 	# Get rid of the args and the flags.