# tests for heredocs besides what is tested in base/lex.t
BEGIN {
chdir 't' if -d 't';
require './test.pl';
set_up_inc('../lib');
}
use strict;
plan(tests => 137);
# heredoc without newline (#65838)
{
my $string = <<'HEREDOC';
testing for 65838
HEREDOC
my $code = "<<'HEREDOC';\n${string}HEREDOC"; # HD w/o newline, in eval-string
my $hd = eval $code or warn "$@ ---";
is($hd, $string, "no terminating newline in string-eval");
}
# here-doc edge cases
{
my $string = "testing for 65838";
fresh_perl_is(
"print <<'HEREDOC';\n${string}\nHEREDOC",
$string,
{},
"heredoc at EOF without trailing newline"
);
fresh_perl_is(
"print <<;\n$string\n",
$string,
{ switches => ['-X'] },
"blank-terminated heredoc at EOF"
);
fresh_perl_is(
"print <<\n$string\n",
$string,
{ switches => ['-X'] },
"blank-terminated heredoc at EOF and no semicolon"
);
fresh_perl_is(
"print <<foo\r\nick and queasy\r\nfoo\r\n",
'ick and queasy',
{ switches => ['-X'] },
"crlf-terminated heredoc"
);
fresh_perl_is(
"print qq|\${\\<<foo}|\nick and queasy\nfoo\n",
'ick and queasy',
{ switches => ['-w'], stderr => 1 },
'no warning for qq|${\<<foo}| in file'
);
}
# here-doc parse failures
{
fresh_perl_like(
"print <<HEREDOC;\nwibble\n HEREDOC",
qr/find string terminator/,
{},
"string terminator must start at newline"
);
# Loop over various lengths to try to force at least one to cause a
# reallocation in S_scan_heredoc()
# Timing on a modern machine suggests that this loop executes in less than
# 0.1s, so it's a very small cost for the default build. The benefit is
# that building with ASAN will reveal the bug and any related regressions.
for (1..31) {
fresh_perl_like(
"print <<;\n" . "x" x $_,
qr/find string terminator/,
{ switches => ['-X'] },
"empty string terminator still needs a newline (length $_)"
);
}
fresh_perl_like(
"print <<ThisTerminatorIsLongerThanTheData;\nno more newlines",
qr/find string terminator/,
{},
"long terminator fails correctly"
);
# this would read freed memory
fresh_perl_like(
qq(0<<<<""0\n\n),
# valgrind and asan reports an error between these two lines
qr/^Number found where operator expected at - line 1, near "<<""0"\s+\(Missing operator/,
{},
"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/^Use of bare << to mean <<"" is deprecated\. Its use will be fatal in Perl 5\.28 at - line 1\.\s+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",
"intented here-doc matches final delimiter correctly"
];
for my $test (@tests) {
fresh_perl_is(
$test->[0],
$test->[1],
{ switches => ['-w'], stderr => 1 },
$test->[2],
);
}
}