Add much-more-extensive TAP tests for pgbench.

Fabien Coelho, reviewed by Nikolay Shaplov and myself

Discussion: https://postgr.es/m/alpine.DEB.2.20.1704171422500.4025@lancre

src/bin/pgbench/t/001_pgbench.pl

-use strict;
-use warnings;
-
-use PostgresNode;
-use TestLib;
-use Test::More tests => 3;
-
-# Test concurrent insertion into table with UNIQUE oid column.  DDL expects
-# GetNewOidWithIndex() to successfully avoid violating uniqueness for indexes
-# like pg_class_oid_index and pg_proc_oid_index.  This indirectly exercises
-# LWLock and spinlock concurrency.  This test makes a 5-MiB table.
-my $node = get_new_node('main');
-$node->init;
-$node->start;
-$node->safe_psql('postgres',
-	    'CREATE UNLOGGED TABLE oid_tbl () WITH OIDS; '
-	  . 'ALTER TABLE oid_tbl ADD UNIQUE (oid);');
-my $script = $node->basedir . '/pgbench_script';
-append_to_file($script,
-	'INSERT INTO oid_tbl SELECT FROM generate_series(1,1000);');
-$node->command_like(
-	[   qw(pgbench --no-vacuum --client=5 --protocol=prepared
-		  --transactions=25 --file), $script ],
-	qr{processed: 125/125},
-	'concurrent OID generation');

src/bin/pgbench/t/002_pgbench_no_server.pl

+#
+# pgbench tests which do not need a server
+#
+
+use strict;
+use warnings;
+
+use TestLib;
+use Test::More;
+
+# invoke pgbench
+sub pgbench
+{
+	my ($opts, $stat, $out, $err, $name) = @_;
+	print STDERR "opts=$opts, stat=$stat, out=$out, err=$err, name=$name";
+	command_checks_all([ 'pgbench', split(/\s+/, $opts) ],
+		$stat, $out, $err, $name);
+}
+
+#
+# Option various errors
+#
+
+my @options = (
+
+	# name, options, stderr checks
+	[   'bad option',
+		'-h home -p 5432 -U calvin -d stuff --bad-option',
+		[ qr{unrecognized option}, qr{--help.*more information} ] ],
+	[   'no file',
+		'-f no-such-file',
+		[qr{could not open file "no-such-file":}] ],
+	[   'no builtin',
+		'-b no-such-builtin',
+		[qr{no builtin script .* "no-such-builtin"}] ],
+	[   'invalid weight',
+		'--builtin=select-only@one',
+		[qr{invalid weight specification: \@one}] ],
+	[   'invalid weight',
+		'-b select-only@-1',
+		[qr{weight spec.* out of range .*: -1}] ],
+	[ 'too many scripts', '-S ' x 129, [qr{at most 128 SQL scripts}] ],
+	[ 'bad #clients', '-c three', [qr{invalid number of clients: "three"}] ],
+	[   'bad #threads', '-j eleven', [qr{invalid number of threads: "eleven"}]
+	],
+	[ 'bad scale', '-i -s two', [qr{invalid scaling factor: "two"}] ],
+	[   'invalid #transactions',
+		'-t zil',
+		[qr{invalid number of transactions: "zil"}] ],
+	[ 'invalid duration', '-T ten', [qr{invalid duration: "ten"}] ],
+	[   '-t XOR -T',
+		'-N -l --aggregate-interval=5 --log-prefix=notused -t 1000 -T 1',
+		[qr{specify either }] ],
+	[   '-T XOR -t',
+		'-P 1 --progress-timestamp -l --sampling-rate=0.001 -T 10 -t 1000',
+		[qr{specify either }] ],
+	[ 'bad variable', '--define foobla', [qr{invalid variable definition}] ],
+	[ 'invalid fillfactor', '-F 1',            [qr{invalid fillfactor}] ],
+	[ 'invalid query mode', '-M no-such-mode', [qr{invalid query mode}] ],
+	[   'invalid progress', '--progress=0',
+		[qr{invalid thread progress delay}] ],
+	[ 'invalid rate',    '--rate=0.0',          [qr{invalid rate limit}] ],
+	[ 'invalid latency', '--latency-limit=0.0', [qr{invalid latency limit}] ],
+	[   'invalid sampling rate', '--sampling-rate=0',
+		[qr{invalid sampling rate}] ],
+	[   'invalid aggregate interval', '--aggregate-interval=-3',
+		[qr{invalid .* seconds for}] ],
+	[   'weight zero',
+		'-b se@0 -b si@0 -b tpcb@0',
+		[qr{weight must not be zero}] ],
+	[ 'init vs run', '-i -S',    [qr{cannot be used in initialization}] ],
+	[ 'run vs init', '-S -F 90', [qr{cannot be used in benchmarking}] ],
+	[ 'ambiguous builtin', '-b s', [qr{ambiguous}] ],
+	[   '--progress-timestamp => --progress', '--progress-timestamp',
+		[qr{allowed only under}] ],
+
+	# loging sub-options
+	[   'sampling => log', '--sampling-rate=0.01',
+		[qr{log sampling .* only when}] ],
+	[   'sampling XOR aggregate',
+		'-l --sampling-rate=0.1 --aggregate-interval=3',
+		[qr{sampling .* aggregation .* cannot be used at the same time}] ],
+	[   'aggregate => log', '--aggregate-interval=3',
+		[qr{aggregation .* only when}] ],
+	[ 'log-prefix => log', '--log-prefix=x', [qr{prefix .* only when}] ],
+	[   'duration & aggregation',
+		'-l -T 1 --aggregate-interval=3',
+		[qr{aggr.* not be higher}] ],
+	[   'duration % aggregation',
+		'-l -T 5 --aggregate-interval=3',
+		[qr{multiple}] ],);
+
+for my $o (@options)
+{
+	my ($name, $opts, $err_checks) = @$o;
+	pgbench($opts, 1, [qr{^$}], $err_checks,
+		'pgbench option error: ' . $name);
+}
+
+# Help
+pgbench(
+	'--help', 0,
+	[   qr{benchmarking tool for PostgreSQL},
+		qr{Usage},
+		qr{Initialization options:},
+		qr{Common options:},
+		qr{Report bugs to} ],
+	[qr{^$}],
+	'pgbench help');
+
+# Version
+pgbench('-V', 0, [qr{^pgbench .PostgreSQL. }], [qr{^$}], 'pgbench version');
+
+# list of builtins
+pgbench(
+	'-b list',
+	0,
+	[qr{^$}],
+	[   qr{Available builtin scripts:}, qr{tpcb-like},
+		qr{simple-update},              qr{select-only} ],
+	'pgbench builtin list');
+
+done_testing();

src/test/perl/PostgresNode.pm

@@ -155,7 +155,8 @@ sub new
 		_logfile => "$TestLib::log_path/${testname}_${name}.log" };
 
 	bless $self, $class;
-	mkdir $self->{_basedir}	or
+	mkdir $self->{_basedir}
+	  or
 	  BAIL_OUT("could not create data directory \"$self->{_basedir}\": $!");
 	$self->dump_info;
 
@@ -934,8 +935,7 @@ sub get_new_node
 # Retain the errno on die() if set, else assume a generic errno of 1.
 # This will instruct the END handler on how to handle artifacts left
 # behind from tests.
-$SIG{__DIE__} = sub
-{
+$SIG{__DIE__} = sub {
 	if ($!)
 	{
 		$died = $!;
@@ -1325,9 +1325,9 @@ sub command_ok
 
 =pod
 
-=item $node->command_fails(...) - TestLib::command_fails with our PGPORT
+=item $node->command_fails(...)
 
-See command_ok(...)
+TestLib::command_fails with our PGPORT. See command_ok(...)
 
 =cut
 
@@ -1359,6 +1359,23 @@ sub command_like
 
 =pod
 
+=item $node->command_checks_all(...)
+
+TestLib::command_checks_all with our PGPORT. See command_ok(...)
+
+=cut
+
+sub command_checks_all
+{
+	my $self = shift;
+
+	local $ENV{PGPORT} = $self->port;
+
+	TestLib::command_checks_all(@_);
+}
+
+=pod
+
 =item $node->issues_sql_like(cmd, expected_sql, test_name)
 
 Run a command on the node, then verify that $expected_sql appears in the

src/test/perl/TestLib.pm

@@ -39,6 +39,7 @@ our @EXPORT = qw(
   command_like
   command_like_safe
   command_fails_like
+  command_checks_all
 
   $windows_os
 );
@@ -330,4 +331,41 @@ sub command_fails_like
 	like($stderr, $expected_stderr, "$test_name: matches");
 }
 
+# Run a command and check its status and outputs.
+# The 5 arguments are:
+# - cmd: ref to list for command, options and arguments to run
+# - ret: expected exit status
+# - out: ref to list of re to be checked against stdout (all must match)
+# - err: ref to list of re to be checked against stderr (all must match)
+# - test_name: name of test
+sub command_checks_all
+{
+	my ($cmd, $ret, $out, $err, $test_name) = @_;
+
+	# run command
+	my ($stdout, $stderr);
+	print("# Running: " . join(" ", @{$cmd}) . "\n");
+	IPC::Run::run($cmd, '>', \$stdout, '2>', \$stderr);
+
+	# On Windows, the exit status of the process is returned directly as the
+	# process's exit code, while on Unix, it's returned in the high bits
+	# of the exit code.
+	my $status = $windows_os ? $? : $? >> 8;
+
+	# check status
+	ok($ret == $status, "$test_name status (got $status vs expected $ret)");
+
+	# check stdout
+	for my $re (@$out)
+	{
+		like($stdout, $re, "$test_name stdout /$re/");
+	}
+
+	# check stderr
+	for my $re (@$err)
+	{
+		like($stderr, $re, "$test_name stderr /$re/");
+	}
+}
+
 1;