From 50d3d2e4e78263d8741706541afafd58f80167fe Mon Sep 17 00:00:00 2001
From: Mischa POSLAWSKY <perl@shiar.org>
Date: Thu, 3 Sep 2015 19:54:24 +0200
Subject: [PATCH] t: exceptions to return errors in Test::PLP

Internal code cleanup.
---
 lib/Test/PLP.pm | 68 +++++++++++++++++++++++++++----------------------
 1 file changed, 38 insertions(+), 30 deletions(-)

diff --git a/lib/Test/PLP.pm b/lib/Test/PLP.pm
index 1eec19b..04bfe2e 100644
--- 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(@_));
 }
 
-- 
2.30.0