From bab0ff2e44b781ec1b1180c5e96bdb95c385c80b Mon Sep 17 00:00:00 2001 From: Michael Paquier Date: Tue, 12 Oct 2021 11:16:25 +0900 Subject: [PATCH] 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 --- src/bin/pg_archivecleanup/t/010_pg_archivecleanup.pl | 2 ++ src/bin/pg_verifybackup/t/005_bad_manifest.pl | 6 ++++++ src/bin/psql/t/010_tab_completion.pl | 4 ++++ src/test/kerberos/t/001_auth.pl | 2 ++ src/test/perl/README | 10 +++++++++- src/test/recovery/t/001_stream_rep.pl | 2 ++ src/test/recovery/t/003_recovery_targets.pl | 2 ++ src/test/recovery/t/007_sync_rep.pl | 2 ++ src/test/recovery/t/009_twophase.pl | 2 ++ src/test/recovery/t/018_wal_optimize.pl | 2 ++ 10 files changed, 33 insertions(+), 1 deletion(-) diff --git a/src/bin/pg_archivecleanup/t/010_pg_archivecleanup.pl b/src/bin/pg_archivecleanup/t/010_pg_archivecleanup.pl index 22782d3042..3d196c8d86 100644 --- 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 5bd5556038..dbd0c51037 100644 --- 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 c27f216d39..bdf40ec7c0 100644 --- 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 8d49847948..4b22d3ccfa 100644 --- 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 c61c3f5e94..dc35204bb6 100644 --- 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 778f11b28b..0bbc1c0058 100644 --- 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 2b4360a2a7..b1a413035c 100644 --- 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 05803bed4e..2902494d00 100644 --- 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 1b748ad857..4a79c5ebfd 100644 --- 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 1f2bc6f5a6..b49c32230f 100644 --- 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',