This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #38456] binmode FH, ":crlf" only modifies top crlf layer
authorLeon Timmermans <fawaka@gmail.com>
Thu, 20 Jan 2011 22:32:28 +0000 (23:32 +0100)
committerFather Chrysostomos <sprout@cpan.org>
Fri, 28 Jan 2011 05:41:55 +0000 (21:41 -0800)
When pushed on top of the stack, crlf will no longer enable crlf layers
lower in the stack. This will prevent unexpected results.

perlio.c
t/io/layers.t

index 130671d..07e297e 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -4513,7 +4513,7 @@ PerlIOCrlf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
        * any given moment at most one CRLF-capable layer being enabled
        * in the whole layer stack. */
         PerlIO *g = PerlIONext(f);
-        while (PerlIOValid(g)) {
+        if (PerlIOValid(g)) {
              PerlIOl *b = PerlIOBase(g);
              if (b && b->tab == &PerlIO_crlf) {
                   if (!(b->flags & PERLIO_F_CRLF))
@@ -4521,8 +4521,7 @@ PerlIOCrlf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab)
                   S_inherit_utf8_flag(g);
                   PerlIO_pop(aTHX_ f);
                   return code;
-             }           
-             g = PerlIONext(g);
+             }
         }
     }
     S_inherit_utf8_flag(f);
index dea3d09..b0bcf1e 100644 (file)
@@ -43,7 +43,7 @@ if (${^UNICODE} & 1) {
 } else {
     $UTF8_STDIN = 0;
 }
-my $NTEST = 45 - (($DOSISH || !$FASTSTDIO) ? 7 : 0) - ($DOSISH ? 5 : 0)
+my $NTEST = 55 - (($DOSISH || !$FASTSTDIO) ? 7 : 0) - ($DOSISH ? 7 : 0)
     + $UTF8_STDIN;
 
 sub PerlIO::F_UTF8 () { 0x00008000 } # from perliol.h
@@ -105,7 +105,7 @@ SKIP: {
            # 5 tests potentially skipped because
            # DOSISH systems already have a CRLF layer
            # which will make new ones not stick.
-           @$expected = grep { $_ ne 'crlf' } @$expected;
+           splice @$expected, 1, 1 if $expected->[1] eq 'crlf';
        }
        my $n = scalar @$expected;
        is(scalar @$result, $n, "$id - layers == $n");
@@ -132,13 +132,25 @@ SKIP: {
          [ qw(stdio crlf) ],
          "open :crlf");
 
+    binmode(F, ":crlf");
+
+    check([ PerlIO::get_layers(F) ],
+         [ qw(stdio crlf) ],
+         "binmode :crlf");
+
     binmode(F, ":encoding(cp1047)"); 
 
     check([ PerlIO::get_layers(F) ],
          [ qw[stdio crlf encoding(cp1047) utf8] ],
          ":encoding(cp1047)");
+
+    binmode(F, ":crlf");
+
+    check([ PerlIO::get_layers(F) ],
+         [ qw[stdio crlf encoding(cp1047) utf8 crlf utf8] ],
+         ":encoding(cp1047):crlf");
     
-    binmode(F, ":pop");
+    binmode(F, ":pop:pop");
 
     check([ PerlIO::get_layers(F) ],
          [ qw(stdio crlf) ],