t/io/crlf.t

   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 {
  14     1 while unlink($file);
  15 }
  16
  17 if (find PerlIO::Layer 'perlio') {
  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));
  22
  23     my $text;
  24     { local $/; $text = <FOO> }
  25     is(count_chars($text, "\015\012"), 0);
  26     is(count_chars($text, "\n"), 2000);
  27
  28     binmode(FOO);
  29     seek(FOO,0,0);
  30     { local $/; $text = <FOO> }
  31     is(count_chars($text, "\015\012"), 2000);
  32
  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     }
  49
  50     ok(close(FOO));
  51
  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     }
  76 }
  77 else {
  78     skip_all("No perlio, so no :crlf");
  79 }
  80
  81 sub count_chars {
  82     my($text, $chars) = @_;
  83     my $seen = 0;
  84     $seen++ while $text =~ /$chars/g;
  85     return $seen;
  86 }