};
my $failure = $@;
select ORGOUT; # return to original STDOUT
+ die $failure if $failure;
- return ($output, $failure);
+ return $output;
}
sub plp_is {
- my ($name, $src, $expect, $env, $input) = @_;
+ my ($src, $env, $input, $expect, $name) = @_;
my $tb = __PACKAGE__->builder;
local $Test::Builder::Level = $Test::Builder::Level + 1;
- my ($output, $failure) = _plp_run($src, $env, $input);
- if ($failure) {
+ my $output = eval { _plp_run($src, $env, $input) };
+ if (my $failure = $@) {
$tb->ok(0, $name);
$tb->diag(" Error: $failure");
return;
}
- $output =~ s{((?:.+\n)*)}{ join "", sort split /(?<=\n)/, $1 }e; # order headers
- is_string($output, $expect, $name);
+
+ if (defined $expect) {
+ $output =~ s{((?:.+\n)*)}{ join "", sort split /(?<=\n)/, $1 }e; # order headers
+ return is_string($output, $expect, $name);
+ }
+
+ $tb->ok(defined $output, $name);
+ return $output;
}
sub _getwarning {
return $res;
}
-sub plp_ok {
+sub _getplp {
my ($file, %replace) = @_;
- my $tb = __PACKAGE__->builder;
- local $Test::Builder::Level = $Test::Builder::Level + 1;
(my $name = $file) =~ s/[.][^.]+$//;
$file = "$name.html";
$name =~ s/^(\d*)-// and $name .= " ($1)";
DecodeURI($name);
- my $output = eval {
+ my $env = delete $replace{-env};
+
+ my $output;
+ if (open my $fh, '<', $file) {
local $/ = undef; # slurp
- open my $fh, '<', $file or die "$!\n";
- return readline $fh;
- };
- if (not defined $output) {
- $tb->ok(0, $name);
- $tb->diag("error reading output from $file: $@");
- return;
+ $output = readline $fh;
+ close $fh;
}
- my $env = delete $replace{-env};
- $replace{HEAD} //= "Content-Type: text/html\nX-PLP-Version: $PLP::VERSION\n";
- $replace{VERSION } //= $PLP::VERSION;
- $replace{SCRIPT_NAME } //= $src;
- $replace{SCRIPT_FILENAME} //= "./$src";
-
- chomp $output;
- $output =~ s/\$$_/$replace{$_}/g for keys %replace;
- $output =~ s{
- <eval \s+ line="([^"]*)"> (.*?) </eval>
- }{ _getwarning($2, $1, $src) }msxge;
-
- plp_is($name, $src, $output, $env, $input);
+ if ($output) {
+ $replace{HEAD} //= "Content-Type: text/html\nX-PLP-Version: $PLP::VERSION\n";
+ $replace{VERSION } //= $PLP::VERSION;
+ $replace{SCRIPT_NAME } //= $src;
+ $replace{SCRIPT_FILENAME} //= "./$src";
+
+ chomp $output;
+ $output =~ s/\$$_/$replace{$_}/g for keys %replace;
+ $output =~ s{
+ <eval \s+ line="([^"]*)"> (.*?) </eval>
+ }{ _getwarning($2, $1, $src) }msxge;
+ }
+
+ return ($src, $env, $input, $output, $name);
+}
+
+sub plp_ok {
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+ plp_is(_getplp(@_));
}