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
This commit is contained in:
Michael Paquier 2021-10-12 11:15:44 +09:00
parent e3e29cec10
commit f9c4cb6868
13 changed files with 45 additions and 1 deletions

View File

@ -209,6 +209,8 @@ sub corrupt_first_page
sub detects_heap_corruption
{
local $Test::Builder::Level = $Test::Builder::Level + 1;
my ($function, $testname) = @_;
detects_corruption(
@ -224,6 +226,8 @@ sub detects_heap_corruption
sub detects_corruption
{
local $Test::Builder::Level = $Test::Builder::Level + 1;
my ($function, $testname, @re) = @_;
my $result = $node->safe_psql('postgres', qq(SELECT * FROM $function));
@ -232,6 +236,8 @@ sub detects_corruption
sub detects_no_corruption
{
local $Test::Builder::Level = $Test::Builder::Level + 1;
my ($function, $testname) = @_;
my $result = $node->safe_psql('postgres', qq(SELECT * FROM $function));
@ -247,6 +253,8 @@ sub detects_no_corruption
# and should be unique.
sub check_all_options_uncorrupted
{
local $Test::Builder::Level = $Test::Builder::Level + 1;
my ($relname, $prefix) = @_;
for my $stop (qw(true false))

View File

@ -19,6 +19,8 @@ $node->start;
# Check that replication slot stats are expected.
sub test_slot_stats
{
local $Test::Builder::Level = $Test::Builder::Level + 1;
my ($node, $expected, $msg) = @_;
my $result = $node->safe_psql(

View File

@ -72,6 +72,8 @@ command_fails_like(
sub run_check
{
local $Test::Builder::Level = $Test::Builder::Level + 1;
my ($suffix, $test_name) = @_;
create_files();

View File

@ -31,6 +31,8 @@ sub fetch_file_name
# Check for a pattern in the logs associated to one format.
sub check_log_pattern
{
local $Test::Builder::Level = $Test::Builder::Level + 1;
my $format = shift;
my $logfiles = shift;
my $pattern = shift;

View File

@ -176,6 +176,8 @@ EOM
sub test_parse_error
{
local $Test::Builder::Level = $Test::Builder::Level + 1;
my ($test_name, $manifest_contents) = @_;
test_bad_manifest($test_name,
@ -186,6 +188,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);
@ -194,6 +198,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: $!";

View File

@ -127,6 +127,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;
}
@ -136,6 +138,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;
}

View File

@ -221,6 +221,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

View File

@ -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.:

View File

@ -75,6 +75,8 @@ note "testing connection parameter \"target_session_attrs\"";
# Expect to connect to $target_node (undef for failure) with given $status.
sub test_target_session_attrs
{
local $Test::Builder::Level = $Test::Builder::Level + 1;
my $node1 = shift;
my $node2 = shift;
my $target_node = shift;

View File

@ -14,6 +14,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_primary = shift;

View File

@ -17,6 +17,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))

View File

@ -14,6 +14,8 @@ my $psql_rc = '';
sub configure_and_reload
{
local $Test::Builder::Level = $Test::Builder::Level + 1;
my ($node, $parameter) = @_;
my $name = $node->name;

View File

@ -18,6 +18,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',