Correct typo

[perl5.git] / t / op / heredoc.t

diff --git a/t/op/heredoc.t b/t/op/heredoc.t
index dadf105..0a7bb06 100644 (file)
--- a/t/op/heredoc.t
+++ b/t/op/heredoc.t
@@ -1,14 +1,13 @@
 # tests for heredocs besides what is tested in base/lex.t
 
 BEGIN {
-   chdir 't' if -d 't';
-   @INC = '../lib';
-   require './test.pl';
+    chdir 't' if -d 't';
+    require './test.pl';
+    set_up_inc('../lib');
 }
 
 use strict;
-plan(tests => 40);
-
+plan(tests => 137);
 
 # heredoc without newline (#65838)
 {
@@ -34,13 +33,13 @@ HEREDOC
     );
 
     fresh_perl_is(
-        "print <<;\n$string\n",
+        qq(print <<"";\n$string\n),
         $string,
         { switches => ['-X'] },
         "blank-terminated heredoc at EOF"
     );
     fresh_perl_is(
-        "print <<\n$string\n",
+        qq(print <<""\n$string\n),
         $string,
         { switches => ['-X'] },
         "blank-terminated heredoc at EOF and no semicolon"
@@ -76,7 +75,7 @@ HEREDOC
     # that building with ASAN will reveal the bug and any related regressions.
     for (1..31) {
         fresh_perl_like(
-            "print <<;\n" . "x" x $_,
+            qq(print <<"";\n) . "x" x $_,
             qr/find string terminator/,
             { switches => ['-X'] },
             "empty string terminator still needs a newline (length $_)"
@@ -98,4 +97,139 @@ HEREDOC
         {},
         "don't use an invalid oldoldbufptr"
     );
+
+    # also read freed memory, but got an invalid oldoldbufptr in a different way
+    fresh_perl_like(
+        qq(<<""\n\$          \n),
+        # valgrind and asan reports an error between these two lines
+        qr/^Final \$/,
+        {},
+        "don't use an invalid oldoldbufptr (some more)"
+    );
+
+    # [perl #125540] this asserted or crashed
+    fresh_perl_like(
+       q(map d<<<<""),
+       qr/Can't find string terminator "" anywhere before EOF at - line 1\./,
+       {},
+       "Don't assert parsing a here-doc if we hit EOF early"
+    );
+
+    # [perl #129064] heap-buffer-overflow S_scan_heredoc
+    fresh_perl_like(
+        qq(<<`\\),
+        # valgrind and asan reports an error between these two lines
+        qr/^Unterminated delimiter for here document/,
+        {},
+        "delimcpy(): handle last char being backslash properly"
+    );
+}
+
+
+# indented here-docs
+{
+    my $string = 'some data';
+
+    my %delimiters = (
+        q{EOF}     => "EOF",
+        q{'EOF'}   => "EOF",
+        q{"EOF"}   => "EOF",
+        q{\EOF}    => "EOF",
+        q{' EOF'}  => " EOF",
+        q{'EOF '}  => "EOF ",
+        q{' EOF '} => " EOF ",
+        q{" EOF"}  => " EOF",
+        q{"EOF "}  => "EOF ",
+        q{" EOF "} => " EOF ",
+        q{''}      => "",
+        q{""}      => "",
+    );
+
+    my @modifiers = ("~", "~ ");
+
+    my @script_ends = ("", "\n");
+
+    my @tests;
+
+    for my $start_delim (sort keys %delimiters) {
+        my $end_delim = $delimiters{$start_delim};
+
+        for my $modifier (@modifiers) {
+            # For now, "<<~ EOF" and "<<~ \EOF" aren't allowed
+            next if $modifier =~ /\s/ && $start_delim !~ /('|")/n;
+
+            for my $script_end (@script_ends) {
+                # Normal heredoc
+                my $test =   "print <<$modifier$start_delim\n  $string\n"
+                           . "  $end_delim$script_end";
+                unshift @tests, [
+                    $test,
+                    $string,
+                    "Indented here-doc: <<$modifier$start_delim with end delim '$end_delim'" . ($script_end ? "\\n" : ""),
+                ];
+
+                # Eval'd heredoc
+                my $safe_start_delim = $start_delim =~ s/'/\\'/gr;
+                my $eval = "
+                    \$_ = '';
+                    eval 's//<<$modifier$safe_start_delim.\"\"/e; print
+                        $string
+                        $end_delim$script_end'
+                    or die \$\@
+                ";
+                push @tests, [
+                    $eval,
+                    $string,
+                    "Eval'd Indented here-doc: <<$modifier$start_delim with end delim '$end_delim'" . ($script_end ? "\\n" : ""),
+
+                ];
+            }
+        }
+    }
+
+    push @tests, [
+        "print <<~EOF;\n\t \t$string\n\t \tEOF\n",
+        $string,
+        "indented here-doc with tabs and spaces",
+    ];
+
+    push @tests, [
+        "print <<~EOF;\n\t \tx EOF\n\t \t$string\n\t \tEOF\n",
+         "x EOF\n$string",
+        "Embedded delimiter ignored",
+    ];
+
+    push @tests, [
+        "print <<~EOF;\n\t \t$string\n\t \tTEOF",
+        "Can't find string terminator \"EOF\" anywhere before EOF at - line 1.",
+        "indented here-doc missing terminator error is correct"
+    ];
+
+    push @tests, [
+        "print <<~EOF;\n $string\n$string\n   $string\n $string\n   EOF",
+        "Indentation on line 1 of here-doc doesn't match delimiter at - line 1.\n",
+        "indented here-doc with bad indentation"
+    ];
+
+    push @tests, [
+        "print <<~EOF;\n   $string\n   $string\n$string\n $string\n   EOF",
+        "Indentation on line 3 of here-doc doesn't match delimiter at - line 1.\n",
+        "indented here-doc with bad indentation"
+    ];
+
+    # If our delim is " EOF ", make sure other spaced version don't match
+    push @tests, [
+        "print <<~' EOF ';\n $string\n EOF\nEOF \n  EOF  \n EOF \n",
+        " $string\n EOF\nEOF \n  EOF  \n",
+        "indented here-doc matches final delimiter correctly"
+    ];
+
+    for my $test (@tests) {
+        fresh_perl_is(
+            $test->[0],
+            $test->[1],
+            { switches => ['-w'], stderr => 1 },
+            $test->[2],
+        );
+    }
 }