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