Thoroughly test paragraph mode

For: RT # 133722

1 files changed, 504 insertions, 0 deletions

diff --git a/t/io/paragraph_mode.t b/t/io/paragraph_mode.t
new file mode 100644
index 0000000000..edbb4cb196
--- /dev/null
+++ b/t/io/paragraph_mode.t
@@ -0,0 +1,504 @@
+#!./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;
+}