Add more $Test::Builder::Level in the TAP tests

Incrementing the level of the call stack reported is useful for
debugging purposes as it allows to control which part of the test is
exactly failing, especially if a test is structured with subroutines
that call routines from Test::More.

This adds more incrementations of $Test::Builder::Level where debugging
gets improved (for example it does not make sense for some paths like
pg_rewind where long subroutines are used).

A note is added to src/test/perl/README about that, based on a
suggestion from Andrew Dunstan and a wording coming from both of us.

Usage of Test::Builder::Level has spread in 12, so a backpatch down to
this version is done.

Reviewed-by: Andrew Dunstan, Peter Eisentraut, Daniel Gustafsson
Discussion: https://postgr.es/m/YV1CCFwgM1RV1LeS@paquier.xyz
Backpatch-through: 12

diff --git a/src/bin/pg_archivecleanup/t/010_pg_archivecleanup.pl b/src/bin/pg_archivecleanup/t/010_pg_archivecleanup.pl
index 22782d304207be3c66d191d02d4b4d6a7b2a2742..3d196c8d8616dabea1f04ed499d651f05a414667 100644 (file)
--- a/src/bin/pg_archivecleanup/t/010_pg_archivecleanup.pl
+++ b/src/bin/pg_archivecleanup/t/010_pg_archivecleanup.pl
@@ -69,6 +69,8 @@ command_fails_like(
 
 sub run_check
 {
+   local $Test::Builder::Level = $Test::Builder::Level + 1;
+
    my ($suffix, $test_name) = @_;
 
    create_files();

diff --git a/src/test/kerberos/t/001_auth.pl b/src/test/kerberos/t/001_auth.pl
index 8d49847948c23bfa23412563f03a04d51240a15a..4b22d3ccfafa5e376b9276afa5d5457a8930a8ee 100644 (file)
--- a/src/test/kerberos/t/001_auth.pl
+++ b/src/test/kerberos/t/001_auth.pl
@@ -203,6 +203,8 @@ sub test_access
 # As above, but test for an arbitrary query result.
 sub test_query
 {
+   local $Test::Builder::Level = $Test::Builder::Level + 1;
+
    my ($node, $role, $query, $expected, $gssencmode, $test_name) = @_;
 
    # need to connect over TCP/IP for Kerberos

diff --git a/src/test/perl/README b/src/test/perl/README
index c61c3f5e9423920249b4e7db58117dd469e2eea4..dc35204bb61a2a502a213cd5042c02afd288e5c0 100644 (file)
--- a/src/test/perl/README
+++ b/src/test/perl/README
@@ -61,9 +61,17 @@ Test::More::like entails use of the qr// operator.  Avoid Perl 5.8.8 bug
 #39185 by not using the "$" regular expression metacharacter in qr// when also
 using the "/m" modifier.  Instead of "$", use "\n" or "(?=\n|\z)".
 
-Read the Test::More documentation for more on how to write tests:
+Test::Builder::Level controls how far up in the call stack a test will look
+at when reporting a failure.  This should be incremented by any subroutine
+which directly or indirectly calls test routines from Test::More, such as
+ok() or is():
+
+    local $Test::Builder::Level = $Test::Builder::Level + 1;
+
+Read the documentation for more on how to write tests:
 
     perldoc Test::More
+    perldoc Test::Builder
 
 For available PostgreSQL-specific test methods and some example tests read the
 perldoc for the test modules, e.g.:

diff --git a/src/test/recovery/t/001_stream_rep.pl b/src/test/recovery/t/001_stream_rep.pl
index be51fa0ffe31c4dd68a09b51761ea16a0b9dfab2..e3fb22645bd870ddd4956906670e74511c7d7d28 100644 (file)
--- a/src/test/recovery/t/001_stream_rep.pl
+++ b/src/test/recovery/t/001_stream_rep.pl
@@ -72,6 +72,8 @@ note "testing connection parameter \"target_session_attrs\"";
 # target_session_attrs with multiple nodes.
 sub test_target_session_attrs
 {
+   local $Test::Builder::Level = $Test::Builder::Level + 1;
+
    my $node1       = shift;
    my $node2       = shift;
    my $target_node = shift;

diff --git a/src/test/recovery/t/003_recovery_targets.pl b/src/test/recovery/t/003_recovery_targets.pl
index f704320f8035640041c7332285e74d9a5428f50c..2b4c6f4e720bc8f6ee20f6f7ce649686c2be95a3 100644 (file)
--- a/src/test/recovery/t/003_recovery_targets.pl
+++ b/src/test/recovery/t/003_recovery_targets.pl
@@ -10,6 +10,8 @@ use Test::More tests => 8;
 # count to reach $num_rows, yet not later than the recovery target.
 sub test_recovery_standby
 {
+   local $Test::Builder::Level = $Test::Builder::Level + 1;
+
    my $test_name       = shift;
    my $node_name       = shift;
    my $node_master     = shift;

diff --git a/src/test/recovery/t/007_sync_rep.pl b/src/test/recovery/t/007_sync_rep.pl
index eccde8f551f059f66839ff1072c8d6cad044f1d9..b17ed3ac5298c3345b635f75cce0427e619e4e88 100644 (file)
--- a/src/test/recovery/t/007_sync_rep.pl
+++ b/src/test/recovery/t/007_sync_rep.pl
@@ -14,6 +14,8 @@ my $check_sql =
 # the configuration file is reloaded before the test.
 sub test_sync_state
 {
+   local $Test::Builder::Level = $Test::Builder::Level + 1;
+
    my ($self, $expected, $msg, $setting) = @_;
 
    if (defined($setting))

diff --git a/src/test/recovery/t/009_twophase.pl b/src/test/recovery/t/009_twophase.pl
index 1b748ad857b0eef99493497b1204b26fe98ec7c9..4a79c5ebfdb80297cdf9894d763a38fc7764d2d6 100644 (file)
--- a/src/test/recovery/t/009_twophase.pl
+++ b/src/test/recovery/t/009_twophase.pl
@@ -11,6 +11,8 @@ my $psql_rc  = '';
 
 sub configure_and_reload
 {
+   local $Test::Builder::Level = $Test::Builder::Level + 1;
+
    my ($node, $parameter) = @_;
    my $name = $node->name;