perl
view release on metacpan or search on metacpan
t/io/paragraph_mode.t view on Meta::CPAN
#!./perl
BEGIN {
chdir 't' if -d 't';
require './test.pl';
set_up_inc('../lib');
}
plan tests => 80;
my ($OUT, $filename, @chunks, @expected, $msg);
{
# We start with files whose "paragraphs" contain no internal newlines.
@chunks = (
join('' => ( 1..3 )),
join('' => ( 4..6 )),
join('' => ( 7..9 )),
10
);
{
$msg = "'Well behaved' file: >= 2 newlines between text blocks; no internal newlines; 3 final newlines";
($OUT, $filename) = open_tempfile();
print $OUT "$_\n" for (
$chunks[0],
("") x 1,
$chunks[1],
("") x 2,
$chunks[2],
("") x 3,
);
print $OUT $chunks[3];
close $OUT or die;
@expected = (
"$chunks[0]\n\n",
"$chunks[1]\n\n",
"$chunks[2]\n\n",
$chunks[3],
);
local $/ = '';
perform_tests($filename, \@expected, $msg);
}
{
$msg = "'Well behaved' file: >= 2 newlines between text blocks; no internal newlines; 0 final newline";
($OUT, $filename) = open_tempfile();
print $OUT "$_\n" for (
$chunks[0],
("") x 1,
$chunks[1],
("") x 2,
$chunks[2],
("") x 3,
$chunks[3],
);
close $OUT or die;
@expected = (
"$chunks[0]\n\n",
"$chunks[1]\n\n",
"$chunks[2]\n\n",
"$chunks[3]\n",
);
local $/ = '';
perform_tests($filename, \@expected, $msg);
}
{
$msg = "'Well behaved' file: >= 2 newlines between text blocks; no internal newlines; 1 final newline";
($OUT, $filename) = open_tempfile();
print $OUT "$_\n" for (
$chunks[0],
("") x 1,
$chunks[1],
("") x 2,
$chunks[2],
("") x 3,
$chunks[3],
("") x 1,
);
close $OUT or die;
@expected = (
"$chunks[0]\n\n",
"$chunks[1]\n\n",
"$chunks[2]\n\n",
"$chunks[3]\n\n",
);
local $/ = '';
perform_tests($filename, \@expected, $msg);
}
{
$msg = "'Well behaved' file: >= 2 newlines between text blocks; no internal newlines; 2 final newlines";
($OUT, $filename) = open_tempfile();
print $OUT "$_\n" for (
$chunks[0],
("") x 1,
$chunks[1],
("") x 2,
$chunks[2],
("") x 3,
$chunks[3],
("") x 2,
);
close $OUT or die;
@expected = (
"$chunks[0]\n\n",
"$chunks[1]\n\n",
"$chunks[2]\n\n",
"$chunks[3]\n\n",
);
local $/ = '';
perform_tests($filename, \@expected, $msg);
}
}
{
# We continue with files whose "paragraphs" contain internal newlines.
@chunks = (
join('' => ( 1, 2, "\n", 3 )),
join('' => ( 4, 5, " \n", 6 )),
join('' => ( 7, 8, " \t\n", 9 )),
10
);
{
$msg = "'Misbehaving' file: >= 2 newlines between text blocks; no internal newlines; 3 final newlines";
($OUT, $filename) = open_tempfile();
print $OUT "$_\n" for (
$chunks[0],
("") x 1,
$chunks[1],
("") x 2,
$chunks[2],
("") x 3,
);
print $OUT $chunks[3];
close $OUT or die;
@expected = (
"$chunks[0]\n\n",
"$chunks[1]\n\n",
"$chunks[2]\n\n",
$chunks[3],
);
local $/ = '';
perform_tests($filename, \@expected, $msg);
}
{
$msg = "'Misbehaving' file: >= 2 newlines between text blocks; no internal newlines; 0 final newline";
($OUT, $filename) = open_tempfile();
print $OUT "$_\n" for (
$chunks[0],
("") x 1,
$chunks[1],
("") x 2,
$chunks[2],
("") x 3,
$chunks[3],
);
close $OUT or die;
@expected = (
"$chunks[0]\n\n",
"$chunks[1]\n\n",
"$chunks[2]\n\n",
"$chunks[3]\n",
);
local $/ = '';
perform_tests($filename, \@expected, $msg);
}
{
$msg = "'Misbehaving' file: >= 2 newlines between text blocks; no internal newlines; 1 final newline";
($OUT, $filename) = open_tempfile();
print $OUT "$_\n" for (
$chunks[0],
("") x 1,
$chunks[1],
("") x 2,
$chunks[2],
("") x 3,
$chunks[3],
("") x 1,
);
close $OUT or die;
@expected = (
"$chunks[0]\n\n",
"$chunks[1]\n\n",
"$chunks[2]\n\n",
"$chunks[3]\n\n",
);
local $/ = '';
perform_tests($filename, \@expected, $msg);
}
{
$msg = "'Misbehaving' file: >= 2 newlines between text blocks; no internal newlines; 2 final newlines";
($OUT, $filename) = open_tempfile();
print $OUT "$_\n" for (
$chunks[0],
("") x 1,
$chunks[1],
("") x 2,
$chunks[2],
("") x 3,
$chunks[3],
("") x 2,
);
close $OUT or die;
@expected = (
"$chunks[0]\n\n",
"$chunks[1]\n\n",
"$chunks[2]\n\n",
"$chunks[3]\n\n",
);
local $/ = '';
perform_tests($filename, \@expected, $msg);
}
}
{
# We continue with files which start with newlines
# but whose "paragraphs" contain no internal newlines.
# We'll set our expectation that the leading newlines will get trimmed off
# and everything else will proceed normally.
@chunks = (
join('' => ( 1..3 )),
join('' => ( 4..6 )),
join('' => ( 7..9 )),
10
);
{
$msg = "'Badly behaved' file: leading newlines; 3 final newlines";
($OUT, $filename) = open_tempfile();
print $OUT "\n\n\n";
print $OUT "$_\n" for (
$chunks[0],
("") x 1,
$chunks[1],
("") x 2,
$chunks[2],
("") x 3,
);
print $OUT $chunks[3];
close $OUT or die;
@expected = (
"$chunks[0]\n\n",
"$chunks[1]\n\n",
"$chunks[2]\n\n",
$chunks[3],
);
local $/ = '';
perform_tests($filename, \@expected, $msg);
}
{
$msg = "'Badly behaved' file: leading newlines; 0 final newline";
($OUT, $filename) = open_tempfile();
print $OUT "\n\n\n";
print $OUT "$_\n" for (
$chunks[0],
("") x 1,
$chunks[1],
("") x 2,
$chunks[2],
("") x 3,
$chunks[3],
);
close $OUT or die;
@expected = (
"$chunks[0]\n\n",
"$chunks[1]\n\n",
"$chunks[2]\n\n",
"$chunks[3]\n",
);
local $/ = '';
perform_tests($filename, \@expected, $msg);
}
{
$msg = "'Badly behaved' file: leading newlines; 1 final newline";
($OUT, $filename) = open_tempfile();
print $OUT "\n\n\n";
print $OUT "$_\n" for (
$chunks[0],
("") x 1,
$chunks[1],
("") x 2,
$chunks[2],
("") x 3,
$chunks[3],
("") x 1,
);
close $OUT or die;
@expected = (
"$chunks[0]\n\n",
"$chunks[1]\n\n",
"$chunks[2]\n\n",
"$chunks[3]\n\n",
);
local $/ = '';
perform_tests($filename, \@expected, $msg);
}
{
$msg = "'Badly behaved' file: leading newlines; 2 final newlines";
($OUT, $filename) = open_tempfile();
print $OUT "\n\n\n";
print $OUT "$_\n" for (
$chunks[0],
("") x 1,
$chunks[1],
("") x 2,
$chunks[2],
("") x 3,
$chunks[3],
("") x 2,
);
close $OUT or die;
@expected = (
"$chunks[0]\n\n",
"$chunks[1]\n\n",
"$chunks[2]\n\n",
"$chunks[3]\n\n",
);
local $/ = '';
perform_tests($filename, \@expected, $msg);
}
}
{
# We continue with files which start with newlines
# and whose "paragraphs" contain internal newlines.
# We'll set our expectation that the leading newlines will get trimmed off
# and everything else will proceed normally.
@chunks = (
join('' => ( 1, 2, "\n", 3 )),
join('' => ( 4, 5, " \n", 6 )),
join('' => ( 7, 8, " \t\n", 9 )),
10
);
{
$msg = "'Very badly behaved' file: leading newlines; internal newlines; 3 final newlines";
($OUT, $filename) = open_tempfile();
print $OUT "\n\n\n";
print $OUT "$_\n" for (
$chunks[0],
("") x 1,
$chunks[1],
("") x 2,
$chunks[2],
("") x 3,
);
print $OUT $chunks[3];
close $OUT or die;
@expected = (
"$chunks[0]\n\n",
"$chunks[1]\n\n",
"$chunks[2]\n\n",
$chunks[3],
);
local $/ = '';
perform_tests($filename, \@expected, $msg);
}
{
$msg = "'Very badly behaved' file: leading newlines; internal newlines; 0 final newline";
($OUT, $filename) = open_tempfile();
print $OUT "\n\n\n";
print $OUT "$_\n" for (
$chunks[0],
("") x 1,
$chunks[1],
("") x 2,
$chunks[2],
("") x 3,
$chunks[3],
);
close $OUT or die;
@expected = (
"$chunks[0]\n\n",
"$chunks[1]\n\n",
"$chunks[2]\n\n",
"$chunks[3]\n",
);
local $/ = '';
perform_tests($filename, \@expected, $msg);
}
{
$msg = "'Very badly behaved' file: leading newlines; internal newlines; 1 final newline";
($OUT, $filename) = open_tempfile();
print $OUT "\n\n\n";
print $OUT "$_\n" for (
$chunks[0],
("") x 1,
$chunks[1],
("") x 2,
$chunks[2],
("") x 3,
$chunks[3],
("") x 1,
);
close $OUT or die;
@expected = (
"$chunks[0]\n\n",
"$chunks[1]\n\n",
"$chunks[2]\n\n",
"$chunks[3]\n\n",
);
local $/ = '';
perform_tests($filename, \@expected, $msg);
}
{
$msg = "'Very badly behaved' file: leading newlines; internal newlines; 2 final newlines";
($OUT, $filename) = open_tempfile();
print $OUT "\n\n\n";
print $OUT "$_\n" for (
$chunks[0],
("") x 1,
$chunks[1],
("") x 2,
$chunks[2],
("") x 3,
$chunks[3],
("") x 2,
);
close $OUT or die;
@expected = (
"$chunks[0]\n\n",
"$chunks[1]\n\n",
"$chunks[2]\n\n",
"$chunks[3]\n\n",
);
local $/ = '';
perform_tests($filename, \@expected, $msg);
}
}
########## SUBROUTINES ##########
sub open_tempfile {
my $filename = tempfile();
open my $OUT, '>', $filename or die;
binmode $OUT;
return ($OUT, $filename);
}
sub perform_tests {
my ($filename, $expected, $msg) = @_;
open my $IN, '<', $filename or die;
my @got = <$IN>;
my $success = 1;
for (my $i=0; $i<=$#${expected}; $i++) {
if ($got[$i] ne $expected->[$i]) {
$success = 0;
last;
}
}
ok($success, $msg);
seek $IN, 0, 0;
for (my $i=0; $i<=$#${expected}; $i++) {
is(<$IN>, $expected->[$i], "Got expected record $i");
}
close $IN or die;
}
( run in 1.779 second using v1.01-cache-2.11-cpan-5e09290becf )