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/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 be51fa0ffe..e3fb22645b 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 f704320f80..2b4c6f4e72 100644 --- a/src/test/recovery/t/003_recovery_targets.pl +++ b/src/test/recovery/t/003_recovery_targets.pl @@ -10,6 +10,8 @@ use Test::More tests => 8; # 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 eccde8f551..b17ed3ac52 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;