git.postgresql.org Git - postgresql.git/commitdiff

git projects / postgresql.git / commitdiff

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

author Michael Paquier <michael@paquier.xyz>

2021年10月12日 02:15:44 +0000 (11:15 +0900)

committer Michael Paquier <michael@paquier.xyz>

2021年10月12日 02:15:44 +0000 (11:15 +0900)

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

13 files changed:

contrib/amcheck/t/001_verify_heapam.pl patch | blob | blame | history

contrib/test_decoding/t/001_repl_stats.pl patch | blob | blame | history

src/bin/pg_archivecleanup/t/010_pg_archivecleanup.pl patch | blob | blame | history

src/bin/pg_ctl/t/004_logrotate.pl patch | blob | blame | history

src/bin/pg_verifybackup/t/005_bad_manifest.pl patch | blob | blame | history

src/bin/psql/t/010_tab_completion.pl patch | blob | blame | history

src/test/kerberos/t/001_auth.pl patch | blob | blame | history

src/test/perl/README patch | blob | blame | history

src/test/recovery/t/001_stream_rep.pl patch | blob | blame | history

src/test/recovery/t/003_recovery_targets.pl patch | blob | blame | history

src/test/recovery/t/007_sync_rep.pl patch | blob | blame | history

src/test/recovery/t/009_twophase.pl patch | blob | blame | history

src/test/recovery/t/018_wal_optimize.pl patch | blob | blame | history

diff --git a/contrib/amcheck/t/001_verify_heapam.pl b/contrib/amcheck/t/001_verify_heapam.pl

index ba40f64b58146a6a1499ddfd740c89b409e319ca..8e02a8db2a38f50eb98fadfebe3fd29ee35bb2b2 100644 (file)

--- a/contrib/amcheck/t/001_verify_heapam.pl

+++ b/contrib/amcheck/t/001_verify_heapam.pl

@@ -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))

diff --git a/contrib/test_decoding/t/001_repl_stats.pl b/contrib/test_decoding/t/001_repl_stats.pl

index fdef6cb1ffddc820de9fdeeded405a24a98b51c8..e8644e1cbcd005d5ad38b32873113c9b004ee2bb 100644 (file)

--- a/contrib/test_decoding/t/001_repl_stats.pl

+++ b/contrib/test_decoding/t/001_repl_stats.pl

@@ -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(

diff --git a/src/bin/pg_archivecleanup/t/010_pg_archivecleanup.pl b/src/bin/pg_archivecleanup/t/010_pg_archivecleanup.pl

index 8134c2a62e81cf452f1821d1e35c65049b05f1ce..8d689b9601cee757e4e43bfa62364952736c92dd 100644 (file)

--- a/src/bin/pg_archivecleanup/t/010_pg_archivecleanup.pl

+++ b/src/bin/pg_archivecleanup/t/010_pg_archivecleanup.pl

@@ -72,6 +72,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_ctl/t/004_logrotate.pl b/src/bin/pg_ctl/t/004_logrotate.pl

index aa0d64a4f79a8a8cb26c6c798527ffcb8ee78b9e..13e91f3bc97e9937c471c8ddc8f069d76b81ab23 100644 (file)

--- a/src/bin/pg_ctl/t/004_logrotate.pl

+++ b/src/bin/pg_ctl/t/004_logrotate.pl

@@ -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;

diff --git a/src/bin/pg_verifybackup/t/005_bad_manifest.pl b/src/bin/pg_verifybackup/t/005_bad_manifest.pl

index 4f5b8f5a4991b2335954369d190b6f10d3248475..1420cfb352c703ddee558b1e55e0b57aad661aec 100644 (file)

--- a/src/bin/pg_verifybackup/t/005_bad_manifest.pl

+++ b/src/bin/pg_verifybackup/t/005_bad_manifest.pl

@@ -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: $!";

diff --git a/src/bin/psql/t/010_tab_completion.pl b/src/bin/psql/t/010_tab_completion.pl

index 8695d225451cdb30c9935e1c9bf16df346262536..dbca56afadc9a84f0e8ee46afe25205aad8248d9 100644 (file)

--- a/src/bin/psql/t/010_tab_completion.pl

+++ b/src/bin/psql/t/010_tab_completion.pl

@@ -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;

}

diff --git a/src/test/kerberos/t/001_auth.pl b/src/test/kerberos/t/001_auth.pl

index c484237d07848ff5e32bdbde93b57686738e2caf..968be3952f4cdb63ea680b40e88d8a83ad8e2ac7 100644 (file)

--- a/src/test/kerberos/t/001_auth.pl

+++ b/src/test/kerberos/t/001_auth.pl

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

diff --git a/src/test/perl/README b/src/test/perl/README

index 67a050b9d48aaf3428485b4ef5a1a423bd8f7260..b2a5541557b0dbe83533cd8075393561ebd4abda 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 ac581c1c078396f0e9e134b891c62e0a906f1be1..9916a36012c85a685f3b67f8146355f67fd962f2 100644 (file)

--- a/src/test/recovery/t/001_stream_rep.pl

+++ b/src/test/recovery/t/001_stream_rep.pl

@@ -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;

diff --git a/src/test/recovery/t/003_recovery_targets.pl b/src/test/recovery/t/003_recovery_targets.pl

index 7bd500ed95619adf4df95baae922f45f073ed060..78ef60d3b2d46403d2bac4955b9910b4eb405be1 100644 (file)

--- a/src/test/recovery/t/003_recovery_targets.pl

+++ b/src/test/recovery/t/003_recovery_targets.pl

@@ -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;

diff --git a/src/test/recovery/t/007_sync_rep.pl b/src/test/recovery/t/007_sync_rep.pl

index 9d00e17f9f0995555b4a0e383a08c9298535ce3d..3b031addf7667a477307c1f7169bf97f1dd34a48 100644 (file)

--- a/src/test/recovery/t/007_sync_rep.pl

+++ b/src/test/recovery/t/007_sync_rep.pl

@@ -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))

diff --git a/src/test/recovery/t/009_twophase.pl b/src/test/recovery/t/009_twophase.pl

index 78d4ef5b54bdf384ff9d3adfb818e05eacb2411b..66a256208c46c6040fd24ccf9ac3431e77d2da2b 100644 (file)

--- a/src/test/recovery/t/009_twophase.pl

+++ b/src/test/recovery/t/009_twophase.pl

@@ -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;

diff --git a/src/test/recovery/t/018_wal_optimize.pl b/src/test/recovery/t/018_wal_optimize.pl

index 47cbc959554b02e209ebca4552a2397a8347565f..3bedeffcae19c2e13c0e5ffefd9de6036ef91077 100644 (file)

--- a/src/test/recovery/t/018_wal_optimize.pl

+++ b/src/test/recovery/t/018_wal_optimize.pl

@@ -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',

This is the main PostgreSQL git repository.

RSS Atom