t: exceptions to return errors in Test::PLP

Internal code cleanup.

diff --git a/lib/Test/PLP.pm b/lib/Test/PLP.pm
index 1eec19b1269bd7b1f2be0f6d174edaf4dbff6daa..04bfe2e9b21e29859c8c82f84e0c1d7fef97c405 100644 (file)
--- a/lib/Test/PLP.pm
+++ b/lib/Test/PLP.pm
@@ -79,23 +79,29 @@ sub _plp_run {
        };
        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);
+       }
+
+       return $tb->ok(defined $output, $name);
 }
 
 sub _getwarning {
@@ -110,10 +116,8 @@ 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";
@@ -122,29 +126,33 @@ sub plp_ok {
        $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(@_));
 }