Commit | Line | Data |
---|---|---|
d3db65ff NIS |
1 | #!./perl -w |
2 | ||
3 | BEGIN { | |
4 | chdir 't' if -d 't'; | |
5 | @INC = qw(. ../lib); | |
ecb8e4d9 | 6 | require "./test.pl"; require "charset_tools.pl"; |
e05e9c3d | 7 | skip_all_without_perlio(); |
d3db65ff NIS |
8 | } |
9 | ||
10 | use Config; | |
11 | ||
d3db65ff | 12 | |
62a28c97 | 13 | my $file = tempfile(); |
ecb8e4d9 KW |
14 | my $crlf = uni_to_native("\015\012"); |
15 | my $crcr = uni_to_native("\x0d\x0d"); | |
d3db65ff | 16 | |
f10c05c1 KW |
17 | my $ungetc_count = 8200; # Somewhat over the likely buffer size |
18 | ||
e05e9c3d | 19 | { |
f10c05c1 | 20 | plan(tests => 16 + 2 * $ungetc_count); |
14b1a0c4 RGS |
21 | ok(open(FOO,">:crlf",$file)); |
22 | ok(print FOO 'a'.((('a' x 14).qq{\n}) x 2000) || close(FOO)); | |
23 | ok(open(FOO,"<:crlf",$file)); | |
887ede57 | 24 | |
14b1a0c4 RGS |
25 | my $text; |
26 | { local $/; $text = <FOO> } | |
ecb8e4d9 | 27 | is(count_chars($text, $crlf), 0); |
14b1a0c4 | 28 | is(count_chars($text, "\n"), 2000); |
887ede57 | 29 | |
14b1a0c4 RGS |
30 | binmode(FOO); |
31 | seek(FOO,0,0); | |
32 | { local $/; $text = <FOO> } | |
ecb8e4d9 | 33 | is(count_chars($text, $crlf), 2000); |
887ede57 | 34 | |
14b1a0c4 RGS |
35 | SKIP: |
36 | { | |
c14649af FC |
37 | skip_if_miniperl("miniperl can't rely on loading PerlIO::scalar", |
38 | 2 * $ungetc_count + 1); | |
39 | skip("no PerlIO::scalar", 2 * $ungetc_count + 1) | |
40 | unless $Config{extensions} =~ m!\bPerlIO/scalar\b!; | |
14b1a0c4 | 41 | require PerlIO::scalar; |
ecb8e4d9 | 42 | my $fcontents = join "", map {"$_$crlf"} "a".."zzz"; |
14b1a0c4 RGS |
43 | open my $fh, "<:crlf", \$fcontents; |
44 | local $/ = "xxx"; | |
45 | local $_ = <$fh>; | |
46 | my $pos = tell $fh; # pos must be behind "xxx", before "\nxxy\n" | |
47 | seek $fh, $pos, 0; | |
48 | $/ = "\n"; | |
49 | $s = <$fh>.<$fh>; | |
bd1869dc | 50 | is($s, "\nxxy\n"); |
f10c05c1 KW |
51 | |
52 | for my $i (0 .. $ungetc_count - 1) { | |
53 | my $j = $i % 256; | |
54 | is($fh->ungetc($j), $j, "ungetc of $j returns itself"); | |
55 | } | |
56 | ||
57 | for (my $i = $ungetc_count - 1; $i >= 0; $i--) { | |
58 | my $j = $i % 256; | |
59 | is(ord($fh->getc()), $j, "getc gets back $j"); | |
60 | } | |
14b1a0c4 | 61 | } |
e949e37c | 62 | |
14b1a0c4 | 63 | ok(close(FOO)); |
8229d19f | 64 | |
14b1a0c4 RGS |
65 | # binmode :crlf should not cumulate. |
66 | # Try it first once and then twice so that even UNIXy boxes | |
67 | # get to exercise this, for DOSish boxes even once is enough. | |
68 | # Try also pushing :utf8 first so that there are other layers | |
69 | # in between (this should not matter: CRLF layers still should | |
70 | # not accumulate). | |
71 | for my $utf8 ('', ':utf8') { | |
72 | for my $binmode (1..2) { | |
73 | open(FOO, ">$file"); | |
74 | # require PerlIO; print PerlIO::get_layers(FOO), "\n"; | |
75 | binmode(FOO, "$utf8:crlf") for 1..$binmode; | |
76 | # require PerlIO; print PerlIO::get_layers(FOO), "\n"; | |
77 | print FOO "Hello\n"; | |
78 | close FOO; | |
79 | open(FOO, "<$file"); | |
80 | binmode(FOO); | |
81 | my $foo = scalar <FOO>; | |
82 | close FOO; | |
83 | print join(" ", "#", map { sprintf("%02x", $_) } unpack("C*", $foo)), | |
84 | "\n"; | |
ecb8e4d9 KW |
85 | like($foo, qr/$crlf$/); |
86 | unlike($foo, qr/$crcr/); | |
14b1a0c4 RGS |
87 | } |
88 | } | |
d3db65ff | 89 | } |
d3db65ff | 90 | |
887ede57 | 91 | sub count_chars { |
14b1a0c4 RGS |
92 | my($text, $chars) = @_; |
93 | my $seen = 0; | |
94 | $seen++ while $text =~ /$chars/g; | |
95 | return $seen; | |
887ede57 | 96 | } |