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/bin/pg_verifybackup/t/005_bad_manifest.pl b/src/bin/pg_verifybackup/t/005_bad_manifest.pl
index 5bd5556038c3d97c79535d50f99625ab9dbf52fa..dbd0c510376db49bca278a171503f4c332b39bf8 100644 (file)
--- a/src/bin/pg_verifybackup/t/005_bad_manifest.pl
+++ b/src/bin/pg_verifybackup/t/005_bad_manifest.pl
@@ -173,6 +173,8 @@ EOM
 
 sub test_parse_error
 {
+   local $Test::Builder::Level = $Test::Builder::Level + 1;
+
    my ($test_name, $manifest_contents) = @_;
 
    test_bad_manifest($test_name,
@@ -183,6 +185,8 @@ sub test_parse_error
 
 sub test_fatal_error
 {
+   local $Test::Builder::Level = $Test::Builder::Level + 1;
+
    my ($test_name, $manifest_contents) = @_;
 
    test_bad_manifest($test_name, qr/fatal: $test_name/, $manifest_contents);
@@ -191,6 +195,8 @@ sub test_fatal_error
 
 sub test_bad_manifest
 {
+   local $Test::Builder::Level = $Test::Builder::Level + 1;
+
    my ($test_name, $regexp, $manifest_contents) = @_;
 
    open(my $fh, '>', "$tempdir/backup_manifest") || die "open: $!";

diff --git a/src/bin/psql/t/010_tab_completion.pl b/src/bin/psql/t/010_tab_completion.pl
index c27f216d39276af9ac7864b1b01958290c0a39a8..bdf40ec7c05afa2e64ce591662cfde0a2c6adfbe 100644 (file)
--- a/src/bin/psql/t/010_tab_completion.pl
+++ b/src/bin/psql/t/010_tab_completion.pl
@@ -124,6 +124,8 @@ sub check_completion
 # (won't work if we are inside a string literal!)
 sub clear_query
 {
+   local $Test::Builder::Level = $Test::Builder::Level + 1;
+
    check_completion("\\r\n", qr/postgres=# /, "\\r works");
    return;
 }
@@ -133,6 +135,8 @@ sub clear_query
 # than clear_query because we lose evidence in the history file)
 sub clear_line
 {
+   local $Test::Builder::Level = $Test::Builder::Level + 1;
+
    check_completion("\025\n", qr/postgres=# /, "control-U works");
    return;
 }

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 778f11b28b436f0b7f0d0371b89d82b24483840a..0bbc1c00582ecc49c1f8bd76dc8dda871527960a 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 2b4360a2a7d3ac3d794f548685db97a7832de280..b1a413035c31d340e78a02d8ef93061c5555f527 100644 (file)
--- a/src/test/recovery/t/003_recovery_targets.pl
+++ b/src/test/recovery/t/003_recovery_targets.pl
@@ -11,6 +11,8 @@ use Time::HiRes qw(usleep);
 # 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 05803bed4e379bfddc5e3327daac309d723f90fb..2902494d007cce794b433974e1f0ee5929962a60 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;
 

diff --git a/src/test/recovery/t/018_wal_optimize.pl b/src/test/recovery/t/018_wal_optimize.pl
index 1f2bc6f5a68dc5172428a0a2df84942b58878a23..b49c32230f0cf049bc1365c9fd680b1cef7432bd 100644 (file)
--- a/src/test/recovery/t/018_wal_optimize.pl
+++ b/src/test/recovery/t/018_wal_optimize.pl
@@ -15,6 +15,8 @@ use Test::More tests => 38;
 
 sub check_orphan_relfilenodes
 {
+   local $Test::Builder::Level = $Test::Builder::Level + 1;
+
    my ($node, $test_name) = @_;
 
    my $db_oid = $node->safe_psql('postgres',