From f9c4cb686800d46ef9e9e90ed5133493b23962af Mon Sep 17 00:00:00 2001 From: Michael Paquier Date: Tue, 12 Oct 2021 11:15:44 +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 --- contrib/amcheck/t/001_verify_heapam.pl | 8 ++++++++ contrib/test_decoding/t/001_repl_stats.pl | 2 ++ src/bin/pg_archivecleanup/t/010_pg_archivecleanup.pl | 2 ++ src/bin/pg_ctl/t/004_logrotate.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 ++ 13 files changed, 45 insertions(+), 1 deletion(-) diff --git a/contrib/amcheck/t/001_verify_heapam.pl b/contrib/amcheck/t/001_verify_heapam.pl index ba40f64b581..8e02a8db2a3 100644 --- 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 fdef6cb1ffd..e8644e1cbcd 100644 --- 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 8134c2a62e8..8d689b9601c 100644 --- 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 aa0d64a4f79..13e91f3bc97 100644 --- 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 4f5b8f5a499..1420cfb352c 100644 --- 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 8695d225451..dbca56afadc 100644 --- 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 c484237d078..968be3952f4 100644 --- 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 67a050b9d48..b2a5541557b 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 ac581c1c078..9916a36012c 100644 --- 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 7bd500ed956..78ef60d3b2d 100644 --- 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 9d00e17f9f0..3b031addf76 100644 --- 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 78d4ef5b54b..66a256208c4 100644 --- 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 47cbc959554..3bedeffcae1 100644 --- 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', -- 2.39.5