Location via proxy:   [ UP ]  
[Report a bug]   [Manage cookies]                
Skip to content

Commit c4309f4

Browse files
committed
Use $Test::Builder::Level in TAP test functions
In TAP test functions, that is, those that produce test results, locally increment $Test::Builder::Level. This has the effect that test failures are reported at the callers location rather than somewhere in the test support libraries. Reviewed-by: Heikki Linnakangas <hlinnaka@iki.fi>
1 parent 6578234 commit c4309f4

File tree

4 files changed

+27
-0
lines changed

4 files changed

+27
-0
lines changed

src/bin/pg_rewind/RewindTest.pm

+2
Original file line numberDiff line numberDiff line change
@@ -87,6 +87,8 @@ sub standby_psql
8787
# expected
8888
sub check_query
8989
{
90+
local $Test::Builder::Level = $Test::Builder::Level + 1;
91+
9092
my ($query, $expected_stdout, $test_name) = @_;
9193
my ($stdout, $stderr);
9294

src/test/perl/PostgresNode.pm

+10
Original file line numberDiff line numberDiff line change
@@ -1366,6 +1366,8 @@ PostgresNode.
13661366

13671367
sub command_ok
13681368
{
1369+
local $Test::Builder::Level = $Test::Builder::Level + 1;
1370+
13691371
my $self = shift;
13701372

13711373
local $ENV{PGPORT} = $self->port;
@@ -1384,6 +1386,8 @@ TestLib::command_fails with our PGPORT. See command_ok(...)
13841386

13851387
sub command_fails
13861388
{
1389+
local $Test::Builder::Level = $Test::Builder::Level + 1;
1390+
13871391
my $self = shift;
13881392

13891393
local $ENV{PGPORT} = $self->port;
@@ -1402,6 +1406,8 @@ TestLib::command_like with our PGPORT. See command_ok(...)
14021406

14031407
sub command_like
14041408
{
1409+
local $Test::Builder::Level = $Test::Builder::Level + 1;
1410+
14051411
my $self = shift;
14061412

14071413
local $ENV{PGPORT} = $self->port;
@@ -1420,6 +1426,8 @@ TestLib::command_checks_all with our PGPORT. See command_ok(...)
14201426

14211427
sub command_checks_all
14221428
{
1429+
local $Test::Builder::Level = $Test::Builder::Level + 1;
1430+
14231431
my $self = shift;
14241432

14251433
local $ENV{PGPORT} = $self->port;
@@ -1442,6 +1450,8 @@ The log file is truncated prior to running the command, however.
14421450

14431451
sub issues_sql_like
14441452
{
1453+
local $Test::Builder::Level = $Test::Builder::Level + 1;
1454+
14451455
my ($self, $cmd, $expected_sql, $test_name) = @_;
14461456

14471457
local $ENV{PGPORT} = $self->port;

src/test/perl/TestLib.pm

+11
Original file line numberDiff line numberDiff line change
@@ -366,6 +366,7 @@ sub check_pg_config
366366
#
367367
sub command_ok
368368
{
369+
local $Test::Builder::Level = $Test::Builder::Level + 1;
369370
my ($cmd, $test_name) = @_;
370371
my $result = run_log($cmd);
371372
ok($result, $test_name);
@@ -374,6 +375,7 @@ sub command_ok
374375

375376
sub command_fails
376377
{
378+
local $Test::Builder::Level = $Test::Builder::Level + 1;
377379
my ($cmd, $test_name) = @_;
378380
my $result = run_log($cmd);
379381
ok(!$result, $test_name);
@@ -382,6 +384,7 @@ sub command_fails
382384

383385
sub command_exit_is
384386
{
387+
local $Test::Builder::Level = $Test::Builder::Level + 1;
385388
my ($cmd, $expected, $test_name) = @_;
386389
print("# Running: " . join(" ", @{$cmd}) . "\n");
387390
my $h = IPC::Run::start $cmd;
@@ -404,6 +407,7 @@ sub command_exit_is
404407

405408
sub program_help_ok
406409
{
410+
local $Test::Builder::Level = $Test::Builder::Level + 1;
407411
my ($cmd) = @_;
408412
my ($stdout, $stderr);
409413
print("# Running: $cmd --help\n");
@@ -417,6 +421,7 @@ sub program_help_ok
417421

418422
sub program_version_ok
419423
{
424+
local $Test::Builder::Level = $Test::Builder::Level + 1;
420425
my ($cmd) = @_;
421426
my ($stdout, $stderr);
422427
print("# Running: $cmd --version\n");
@@ -430,6 +435,7 @@ sub program_version_ok
430435

431436
sub program_options_handling_ok
432437
{
438+
local $Test::Builder::Level = $Test::Builder::Level + 1;
433439
my ($cmd) = @_;
434440
my ($stdout, $stderr);
435441
print("# Running: $cmd --not-a-valid-option\n");
@@ -443,6 +449,7 @@ sub program_options_handling_ok
443449

444450
sub command_like
445451
{
452+
local $Test::Builder::Level = $Test::Builder::Level + 1;
446453
my ($cmd, $expected_stdout, $test_name) = @_;
447454
my ($stdout, $stderr);
448455
print("# Running: " . join(" ", @{$cmd}) . "\n");
@@ -455,6 +462,7 @@ sub command_like
455462

456463
sub command_like_safe
457464
{
465+
local $Test::Builder::Level = $Test::Builder::Level + 1;
458466

459467
# Doesn't rely on detecting end of file on the file descriptors,
460468
# which can fail, causing the process to hang, notably on Msys
@@ -475,6 +483,7 @@ sub command_like_safe
475483

476484
sub command_fails_like
477485
{
486+
local $Test::Builder::Level = $Test::Builder::Level + 1;
478487
my ($cmd, $expected_stderr, $test_name) = @_;
479488
my ($stdout, $stderr);
480489
print("# Running: " . join(" ", @{$cmd}) . "\n");
@@ -493,6 +502,8 @@ sub command_fails_like
493502
# - test_name: name of test
494503
sub command_checks_all
495504
{
505+
local $Test::Builder::Level = $Test::Builder::Level + 1;
506+
496507
my ($cmd, $expected_ret, $out, $err, $test_name) = @_;
497508

498509
# run command

src/test/ssl/ServerSetup.pm

+4
Original file line numberDiff line numberDiff line change
@@ -38,6 +38,8 @@ our @EXPORT = qw(
3838
# The second argument is a complementary connection string.
3939
sub test_connect_ok
4040
{
41+
local $Test::Builder::Level = $Test::Builder::Level + 1;
42+
4143
my ($common_connstr, $connstr, $test_name) = @_;
4244

4345
my $cmd = [
@@ -52,6 +54,8 @@ sub test_connect_ok
5254

5355
sub test_connect_fails
5456
{
57+
local $Test::Builder::Level = $Test::Builder::Level + 1;
58+
5559
my ($common_connstr, $connstr, $expected_stderr, $test_name) = @_;
5660

5761
my $cmd = [

0 commit comments

Comments
 (0)