mirror/perl
1
0
Fork 0
mirror of https://github.com/Perl/perl5.git synced 2026-01-26 16:39:36 +00:00
Code Issues Packages Projects Releases Wiki Activity

Clean up heredoc.t

Browse Source 
* Made the tests more independent, mostly by decoupling the use of
  a single $string.  This will make it easier to expand on the test file
  later.

* Replace ok( $foo eq $bar ) with is() for better diagnostics

* Remove unnecessary STDERR redirection.  fresh_perl does that for you.

* fix fresh_perl to honor progfile and stderr arguments passed in
  rather than just blowing over them
This commit is contained in:
Michael G. Schwern 2009-06-12 15:35:00 -07:00 committed by Father Chrysostomos
parent c8e9f72fa0
commit c49688b018
2 changed files with 53 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

93
t/op/heredoc.t
View File

@ -1,58 +1,67 @@
# 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");
}
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"
);
# here-doc edge cases
{
my $string = "testing for 65838";
fresh_perl_like(
"$redirect print <<;\nno more newlines",
qr/find string terminator/, {},
"empty string terminator still needs a newline"
);
fresh_perl_is(
"print <<'HEREDOC';\n${string}\nHEREDOC",
$string,
{},
"heredoc at EOF without trailing newline"
);
fresh_perl_like(
"$redirect print <<ThisTerminatorIsLongerThanTheData;\nno more newlines",
qr/find string terminator/, {},
"long terminator fails correctly"
);
fresh_perl_is(
"print <<;\n$string\n",
$string,
{},
"blank-terminated heredoc at EOF"
);
}
# 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"
);
}

4
t/test.pl
View File

@ -793,8 +793,8 @@ sub _fresh_perl {
# 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: $!";