Use $Test::Builder::Level in TAP test functions

petere · petere · commit c4309f4aeeae · 2018-07-01T12:58:32.000+02:00
In TAP test functions, that is, those that produce test results, locally
increment $Test::Builder::Level.  This has the effect that test failures
are reported at the callers location rather than somewhere in the test
support libraries.

Reviewed-by: Heikki Linnakangas &lt;hlinnaka@iki.fi&gt;
diff --git a/src/bin/pg_rewind/RewindTest.pm b/src/bin/pg_rewind/RewindTest.pm
@@ -87,6 +87,8 @@ sub standby_psql
 # expected
 sub check_query
 {
+	local $Test::Builder::Level = $Test::Builder::Level + 1;
+
 	my ($query, $expected_stdout, $test_name) = @_;
 	my ($stdout, $stderr);
 
diff --git a/src/test/perl/PostgresNode.pm b/src/test/perl/PostgresNode.pm
@@ -1366,6 +1366,8 @@ PostgresNode.
 
 sub command_ok
 {
+	local $Test::Builder::Level = $Test::Builder::Level + 1;
+
 	my $self = shift;
 
 	local $ENV{PGPORT} = $self->port;
@@ -1384,6 +1386,8 @@ TestLib::command_fails with our PGPORT. See command_ok(...)
 
 sub command_fails
 {
+	local $Test::Builder::Level = $Test::Builder::Level + 1;
+
 	my $self = shift;
 
 	local $ENV{PGPORT} = $self->port;
@@ -1402,6 +1406,8 @@ TestLib::command_like with our PGPORT. See command_ok(...)
 
 sub command_like
 {
+	local $Test::Builder::Level = $Test::Builder::Level + 1;
+
 	my $self = shift;
 
 	local $ENV{PGPORT} = $self->port;
@@ -1420,6 +1426,8 @@ TestLib::command_checks_all with our PGPORT. See command_ok(...)
 
 sub command_checks_all
 {
+	local $Test::Builder::Level = $Test::Builder::Level + 1;
+
 	my $self = shift;
 
 	local $ENV{PGPORT} = $self->port;
@@ -1442,6 +1450,8 @@ The log file is truncated prior to running the command, however.
 
 sub issues_sql_like
 {
+	local $Test::Builder::Level = $Test::Builder::Level + 1;
+
 	my ($self, $cmd, $expected_sql, $test_name) = @_;
 
 	local $ENV{PGPORT} = $self->port;
diff --git a/src/test/perl/TestLib.pm b/src/test/perl/TestLib.pm
@@ -366,6 +366,7 @@ sub check_pg_config
 #
 sub command_ok
 {
+	local $Test::Builder::Level = $Test::Builder::Level + 1;
 	my ($cmd, $test_name) = @_;
 	my $result = run_log($cmd);
 	ok($result, $test_name);
@@ -374,6 +375,7 @@ sub command_ok
 
 sub command_fails
 {
+	local $Test::Builder::Level = $Test::Builder::Level + 1;
 	my ($cmd, $test_name) = @_;
 	my $result = run_log($cmd);
 	ok(!$result, $test_name);
@@ -382,6 +384,7 @@ sub command_fails
 
 sub command_exit_is
 {
+	local $Test::Builder::Level = $Test::Builder::Level + 1;
 	my ($cmd, $expected, $test_name) = @_;
 	print("# Running: " . join(" ", @{$cmd}) . "\n");
 	my $h = IPC::Run::start $cmd;
@@ -404,6 +407,7 @@ sub command_exit_is
 
 sub program_help_ok
 {
+	local $Test::Builder::Level = $Test::Builder::Level + 1;
 	my ($cmd) = @_;
 	my ($stdout, $stderr);
 	print("# Running: $cmd --help\n");
@@ -417,6 +421,7 @@ sub program_help_ok
 
 sub program_version_ok
 {
+	local $Test::Builder::Level = $Test::Builder::Level + 1;
 	my ($cmd) = @_;
 	my ($stdout, $stderr);
 	print("# Running: $cmd --version\n");
@@ -430,6 +435,7 @@ sub program_version_ok
 
 sub program_options_handling_ok
 {
+	local $Test::Builder::Level = $Test::Builder::Level + 1;
 	my ($cmd) = @_;
 	my ($stdout, $stderr);
 	print("# Running: $cmd --not-a-valid-option\n");
@@ -443,6 +449,7 @@ sub program_options_handling_ok
 
 sub command_like
 {
+	local $Test::Builder::Level = $Test::Builder::Level + 1;
 	my ($cmd, $expected_stdout, $test_name) = @_;
 	my ($stdout, $stderr);
 	print("# Running: " . join(" ", @{$cmd}) . "\n");
@@ -455,6 +462,7 @@ sub command_like
 
 sub command_like_safe
 {
+	local $Test::Builder::Level = $Test::Builder::Level + 1;
 
 	# Doesn't rely on detecting end of file on the file descriptors,
 	# which can fail, causing the process to hang, notably on Msys
@@ -475,6 +483,7 @@ sub command_like_safe
 
 sub command_fails_like
 {
+	local $Test::Builder::Level = $Test::Builder::Level + 1;
 	my ($cmd, $expected_stderr, $test_name) = @_;
 	my ($stdout, $stderr);
 	print("# Running: " . join(" ", @{$cmd}) . "\n");
@@ -493,6 +502,8 @@ sub command_fails_like
 # - test_name: name of test
 sub command_checks_all
 {
+	local $Test::Builder::Level = $Test::Builder::Level + 1;
+
 	my ($cmd, $expected_ret, $out, $err, $test_name) = @_;
 
 	# run command
diff --git a/src/test/ssl/ServerSetup.pm b/src/test/ssl/ServerSetup.pm
@@ -38,6 +38,8 @@ our @EXPORT = qw(
 # The second argument is a complementary connection string.
 sub test_connect_ok
 {
+	local $Test::Builder::Level = $Test::Builder::Level + 1;
+
 	my ($common_connstr, $connstr, $test_name) = @_;
 
 	my $cmd = [
@@ -52,6 +54,8 @@ sub test_connect_ok
 
 sub test_connect_fails
 {
+	local $Test::Builder::Level = $Test::Builder::Level + 1;
+
 	my ($common_connstr, $connstr, $expected_stderr, $test_name) = @_;
 
 	my $cmd = [

Original file line number	Diff line number	Diff line change
`@@ -87,6 +87,8 @@ sub standby_psql`
`87`	`87`	`# expected`
`88`	`88`	`sub check_query`
`89`	`89`	`{`
	`90`	`+ local $Test::Builder::Level = $Test::Builder::Level + 1;`
	`91`	`+`
`90`	`92`	`my ($query, $expected_stdout, $test_name) = @_;`
`91`	`93`	`my ($stdout, $stderr);`
`92`	`94`
Original file line number	Diff line number	Diff line change
`@@ -38,6 +38,8 @@ our @EXPORT = qw(`
`38`	`38`	`# The second argument is a complementary connection string.`
`39`	`39`	`sub test_connect_ok`
`40`	`40`	`{`
	`41`	`+ local $Test::Builder::Level = $Test::Builder::Level + 1;`
	`42`	`+`
`41`	`43`	`my ($common_connstr, $connstr, $test_name) = @_;`
`42`	`44`
`43`	`45`	`my $cmd = [`
`@@ -52,6 +54,8 @@ sub test_connect_ok`
`52`	`54`
`53`	`55`	`sub test_connect_fails`
`54`	`56`	`{`
	`57`	`+ local $Test::Builder::Level = $Test::Builder::Level + 1;`
	`58`	`+`
`55`	`59`	`my ($common_connstr, $connstr, $expected_stderr, $test_name) = @_;`
`56`	`60`
`57`	`61`	`my $cmd = [`