Right now, when a TAP test reports a failure, it looks something like this:
# Failed test 'creating a replication slot'
# at
/....../postgresql/src/bin/pg_basebackup/../../../src/test/perl/TestLib.pm
line 371.
That file location is where we call out to the test function provided by
Test::More.
What we'd really want is
# Failed test 'creating a replication slot'
# at t/020_pg_receivewal.pl line 36.
because that's where the code that's doing the testing is.
To achieve that, we need to have our test library functions tell that
they are support functions and not the actual tests. The attached patch
does that. The mechanism is (somewhat) explained in the Test::Builder
man page.
--
Peter Eisentraut http://www.2ndQuadrant.com/
PostgreSQL Development, 24x7 Support, Remote DBA, Training & Services
From 54113ae8d1921cdd5b161e2bc3cbfd31b24bb4d2 Mon Sep 17 00:00:00 2001
From: Peter Eisentraut <pete...@gmx.net>
Date: Tue, 22 May 2018 14:25:01 -0400
Subject: [PATCH] Use $Test::Builder::Level in TAP test functions
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.
---
src/bin/pg_rewind/RewindTest.pm | 2 ++
src/test/perl/PostgresNode.pm | 10 ++++++++++
src/test/perl/TestLib.pm | 11 +++++++++++
src/test/ssl/ServerSetup.pm | 4 ++++
4 files changed, 27 insertions(+)
diff --git a/src/bin/pg_rewind/RewindTest.pm b/src/bin/pg_rewind/RewindTest.pm
index 60b54119e7..057b08f9a4 100644
--- 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
index d12dd60e73..4475eda001 100644
--- 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
index 77499c01e9..7fd27ec247 100644
--- 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
index 1cd3badaa1..f5770dcf1f 100644
--- 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 = [
--
2.17.1
