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