From 3f50bc5236d7793939904222a38f7e13a2cda47c Mon Sep 17 00:00:00 2001
From: Peter Eisentraut <peter@eisentraut.org>
Date: Thu, 24 Feb 2022 11:01:47 +0100
Subject: [PATCH v2] Readd use of TAP subtests

Since 405f32fc49609eb94fa39e7b5e7c1fe2bb2b73aa, Test::More must be new
enough to support subtests.

The present patch effectively reverts
7912f9b7dc9e2d3f6cd81892ef6aa797578e9f06.  Many more refactorings like
this are possible; this is just to get started.
---
 src/test/perl/PostgreSQL/Test/Cluster.pm | 14 +++---
 src/test/perl/PostgreSQL/Test/Utils.pm   | 62 +++++++++++++-----------
 2 files changed, 43 insertions(+), 33 deletions(-)

diff --git a/src/test/perl/PostgreSQL/Test/Cluster.pm b/src/test/perl/PostgreSQL/Test/Cluster.pm
index be05845248..722bdf8a36 100644
--- a/src/test/perl/PostgreSQL/Test/Cluster.pm
+++ b/src/test/perl/PostgreSQL/Test/Cluster.pm
@@ -2473,14 +2473,16 @@ sub issues_sql_like
 
 	my ($self, $cmd, $expected_sql, $test_name) = @_;
 
-	local %ENV = $self->_get_env();
+	subtest $test_name => sub {
+		local %ENV = $self->_get_env();
 
-	my $log_location = -s $self->logfile;
+		my $log_location = -s $self->logfile;
 
-	my $result = PostgreSQL::Test::Utils::run_log($cmd);
-	ok($result, "@$cmd exit code 0");
-	my $log = PostgreSQL::Test::Utils::slurp_file($self->logfile, $log_location);
-	like($log, $expected_sql, "$test_name: SQL found in server log");
+		my $result = PostgreSQL::Test::Utils::run_log($cmd);
+		ok($result, "@$cmd exit code 0");
+		my $log = PostgreSQL::Test::Utils::slurp_file($self->logfile, $log_location);
+		like($log, $expected_sql, "SQL found in server log");
+	};
 	return;
 }
 
diff --git a/src/test/perl/PostgreSQL/Test/Utils.pm b/src/test/perl/PostgreSQL/Test/Utils.pm
index 46cd746796..5869f060ee 100644
--- a/src/test/perl/PostgreSQL/Test/Utils.pm
+++ b/src/test/perl/PostgreSQL/Test/Utils.pm
@@ -792,13 +792,15 @@ sub program_help_ok
 {
 	local $Test::Builder::Level = $Test::Builder::Level + 1;
 	my ($cmd) = @_;
-	my ($stdout, $stderr);
-	print("# Running: $cmd --help\n");
-	my $result = IPC::Run::run [ $cmd, '--help' ], '>', \$stdout, '2>',
-	  \$stderr;
-	ok($result, "$cmd --help exit code 0");
-	isnt($stdout, '', "$cmd --help goes to stdout");
-	is($stderr, '', "$cmd --help nothing to stderr");
+	subtest "$cmd --help" => sub {
+		my ($stdout, $stderr);
+		print("# Running: $cmd --help\n");
+		my $result = IPC::Run::run [ $cmd, '--help' ], '>', \$stdout, '2>',
+		  \$stderr;
+		ok($result, "exit code 0");
+		isnt($stdout, '', "goes to stdout");
+		is($stderr, '', "nothing to stderr");
+	};
 	return;
 }
 
@@ -814,13 +816,15 @@ sub program_version_ok
 {
 	local $Test::Builder::Level = $Test::Builder::Level + 1;
 	my ($cmd) = @_;
-	my ($stdout, $stderr);
-	print("# Running: $cmd --version\n");
-	my $result = IPC::Run::run [ $cmd, '--version' ], '>', \$stdout, '2>',
-	  \$stderr;
-	ok($result, "$cmd --version exit code 0");
-	isnt($stdout, '', "$cmd --version goes to stdout");
-	is($stderr, '', "$cmd --version nothing to stderr");
+	subtest "$cmd --version" => sub {
+		my ($stdout, $stderr);
+		print("# Running: $cmd --version\n");
+		my $result = IPC::Run::run [ $cmd, '--version' ], '>', \$stdout, '2>',
+		  \$stderr;
+		ok($result, "exit code 0");
+		isnt($stdout, '', "goes to stdout");
+		is($stderr, '', "nothing to stderr");
+	};
 	return;
 }
 
@@ -837,13 +841,15 @@ sub program_options_handling_ok
 {
 	local $Test::Builder::Level = $Test::Builder::Level + 1;
 	my ($cmd) = @_;
-	my ($stdout, $stderr);
-	print("# Running: $cmd --not-a-valid-option\n");
-	my $result = IPC::Run::run [ $cmd, '--not-a-valid-option' ], '>',
-	  \$stdout,
-	  '2>', \$stderr;
-	ok(!$result, "$cmd with invalid option nonzero exit code");
-	isnt($stderr, '', "$cmd with invalid option prints error message");
+	subtest "$cmd options handling" => sub {
+		my ($stdout, $stderr);
+		print("# Running: $cmd --not-a-valid-option\n");
+		my $result = IPC::Run::run [ $cmd, '--not-a-valid-option' ], '>',
+		  \$stdout,
+		  '2>', \$stderr;
+		ok(!$result, "invalid option nonzero exit code");
+		isnt($stderr, '', "invalid option prints error message");
+	};
 	return;
 }
 
@@ -860,12 +866,14 @@ sub command_like
 {
 	local $Test::Builder::Level = $Test::Builder::Level + 1;
 	my ($cmd, $expected_stdout, $test_name) = @_;
-	my ($stdout, $stderr);
-	print("# Running: " . join(" ", @{$cmd}) . "\n");
-	my $result = IPC::Run::run $cmd, '>', \$stdout, '2>', \$stderr;
-	ok($result, "$test_name: exit code 0");
-	is($stderr, '', "$test_name: no stderr");
-	like($stdout, $expected_stdout, "$test_name: matches");
+	subtest $test_name => sub {
+		my ($stdout, $stderr);
+		print("# Running: " . join(" ", @{$cmd}) . "\n");
+		my $result = IPC::Run::run $cmd, '>', \$stdout, '2>', \$stderr;
+		ok($result, "exit code 0");
+		is($stderr, '', "no stderr");
+		like($stdout, $expected_stdout, "stdout matches");
+	};
 	return;
 }
 
-- 
2.35.1