diff options
author | Leon Timmermans <fawaka@gmail.com> | 2011-01-20 23:32:28 +0100 |
---|---|---|
committer | Father Chrysostomos <sprout@cpan.org> | 2011-01-27 21:41:55 -0800 |
commit | 7826b36fbbf24cfa659558ee5af3de424faa2d5a (patch) | |
tree | e472d8bcec37bdbe52252dc078353e63793c67f5 /t/io | |
parent | 364c63cff540b8186bf5b6dcf366e1270ba5020e (diff) | |
download | perl-7826b36fbbf24cfa659558ee5af3de424faa2d5a.tar.gz |
[perl #38456] binmode FH, ":crlf" only modifies top crlf layer
When pushed on top of the stack, crlf will no longer enable crlf layers
lower in the stack. This will prevent unexpected results.
Diffstat (limited to 't/io')
-rw-r--r-- | t/io/layers.t | 18 |
1 files changed, 15 insertions, 3 deletions
diff --git a/t/io/layers.t b/t/io/layers.t index dea3d0998d..b0bcf1ef6e 100644 --- a/t/io/layers.t +++ b/t/io/layers.t @@ -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) ], |