[perl #65838] Tests for here-docs without final newlines

and a few error cases

diff --git a/MANIFEST b/MANIFEST
index 71e26a0..7484cd6 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -5281,6 +5281,7 @@ t/op/hashassign.t         See if hash assignments work
 t/op/hash-rt85026.t            See if hash iteration/deletion works
 t/op/hash.t                    See if the complexity attackers are repelled
 t/op/hashwarn.t                        See if warnings for bad hash assignments work
+t/op/heredoc.t                 See if heredoc edge and corner cases work
 t/op/inccode.t                 See if coderefs work in @INC
 t/op/inccode-tie.t             See if tie to @INC works
 t/op/incfilter.t               See if the source filters in coderef-in-@INC work

diff --git a/t/op/heredoc.t b/t/op/heredoc.t
new file mode 100644 (file)
index 0000000..962e8a7
--- /dev/null
+++ b/t/op/heredoc.t
@@ -0,0 +1,58 @@
+
+# heredoc.t
+# tests for heredocs besides what is tested in base/lex.t
+BEGIN {
+   chdir 't' if -d 't';
+   @INC = '../lib';
+   require './test.pl';
+}
+
+plan (tests => 6);
+#heredoc without newline (#65838)
+$string = <<'HEREDOC';
+testing for 65838
+HEREDOC
+$code = "<<'HEREDOC';\n${string}HEREDOC";  # HD w/o newline, in eval-string
+$hd = eval $code or warn "$@ ---";
+ok($hd eq $string, "no terminating newline in string-eval");
+
+$redirect = <<\REDIR;
+BEGIN {
+   open STDERR, ">&STDOUT" or die "PROBLEM DUPING STDOUT: $!"
+}
+REDIR
+
+chomp (my $chomped_string = $string);
+fresh_perl_is(
+   "print $code",
+   $chomped_string,{},
+   "heredoc at EOF without trailing newline"
+);
+
+# like test 18 from t/base/lex.t but at EOF
+fresh_perl_is(
+   "print <<;\n$string",
+   $chomped_string,{},
+   "blank-terminated heredoc at EOF"
+);
+
+
+# the next three are supposed to fail parsing
+fresh_perl_like(
+   "$redirect print <<HEREDOC;\n$string HEREDOC",
+   qr/find string terminator/, {},
+   "string terminator must start at newline"
+);
+
+fresh_perl_like(
+   "$redirect print <<;\nno more newlines",
+   qr/find string terminator/, {},
+   "empty string terminator still needs a newline"
+);
+
+fresh_perl_like(
+   "$redirect print <<ThisTerminatorIsLongerThanTheData;\nno more newlines",
+   qr/find string terminator/, {},
+   "long terminator fails correctly"
+);
+