-
-# 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';
+use strict;
+plan(tests => 6);
+
+
+# heredoc without newline (#65838)
+{
+ my $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: $!"
+ 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,
+ {},
+ "blank-terminated heredoc at EOF"
+ );
}
-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"
-);
+
+# here-doc parse failures
+{
+ fresh_perl_like(
+ "print <<HEREDOC;\nwibble\n HEREDOC",
+ qr/find string terminator/,
+ {},
+ "string terminator must start at newline"
+ );
+
+ fresh_perl_like(
+ "print <<;\nno more newlines",
+ qr/find string terminator/,
+ {},
+ "empty string terminator still needs a newline"
+ );
+
+ fresh_perl_like(
+ "print <<ThisTerminatorIsLongerThanTheData;\nno more newlines",
+ qr/find string terminator/,
+ {},
+ "long terminator fails correctly"
+ );
+}
# it feels like the least-worse thing is to assume that auto-vivification
# works. At least, this is only going to be a run-time failure, so won't
# affect tests using this file but not this function.
- $runperl_args->{progfile} = $tmpfile;
- $runperl_args->{stderr} = 1;
+ $runperl_args->{progfile} ||= $tmpfile;
+ $runperl_args->{stderr} = 1 unless exists $runperl_args->{stderr};
open TEST, ">$tmpfile" or die "Cannot open $tmpfile: $!";