Commit ed8a7c6f authored by Tom Lane's avatar Tom Lane

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
parent f0a0c17c
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');
use strict;
use warnings;
use PostgresNode;
use TestLib;
use Test::More;
# start a pgbench specific server
my $node = get_new_node('main');
$node->init;
$node->start;
# invoke pgbench
sub pgbench
{
my ($opts, $stat, $out, $err, $name, $files) = @_;
my @cmd = ('pgbench', split /\s+/, $opts);
my @filenames = ();
if (defined $files)
{
# note: files are ordered for determinism
for my $fn (sort keys %$files)
{
my $filename = $node->basedir . '/' . $fn;
push @cmd, '-f', $filename;
# cleanup file weight
$filename =~ s/\@\d+$//;
#push @filenames, $filename;
append_to_file($filename, $$files{$fn});
}
}
$node->command_checks_all(\@cmd, $stat, $out, $err, $name);
# cleanup?
#unlink @filenames or die "cannot unlink files (@filenames): $!";
}
# 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.
$node->safe_psql('postgres',
'CREATE UNLOGGED TABLE oid_tbl () WITH OIDS; '
. 'ALTER TABLE oid_tbl ADD UNIQUE (oid);');
pgbench(
'--no-vacuum --client=5 --protocol=prepared --transactions=25',
0,
[qr{processed: 125/125}],
[qr{^$}],
'concurrency OID generation',
{ '001_pgbench_concurrent_oid_generation' =>
'INSERT INTO oid_tbl SELECT FROM generate_series(1,1000);' });
# cleanup
$node->safe_psql('postgres', 'DROP TABLE oid_tbl;');
# Trigger various connection errors
pgbench(
'no-such-database',
1,
[qr{^$}],
[ qr{connection to database "no-such-database" failed},
qr{FATAL: database "no-such-database" does not exist} ],
'no such database');
pgbench(
'-U no-such-user template0',
1,
[qr{^$}],
[ qr{connection to database "template0" failed},
qr{FATAL: role "no-such-user" does not exist} ],
'no such user');
pgbench(
'-S -t 1', 1, [qr{^$}],
[qr{Perhaps you need to do initialization}],
'run without init');
# Initialize pgbench tables scale 1
pgbench(
'-i', 0, [qr{^$}],
[ qr{creating tables}, qr{vacuum}, qr{set primary keys}, qr{done\.} ],
'pgbench scale 1 initialization',);
# Again, with all possible options
pgbench(
# unlogged => faster test
'--initialize --scale=1 --unlogged --fillfactor=98 --foreign-keys --quiet'
. ' --tablespace=pg_default --index-tablespace=pg_default',
0,
[qr{^$}i],
[ qr{creating tables},
qr{vacuum},
qr{set primary keys},
qr{set foreign keys},
qr{done\.} ],
'pgbench scale 1 initialization');
# Run all builtin scripts, for a few transactions each
pgbench(
'--transactions=5 -Dfoo=bla --client=2 --protocol=simple --builtin=t'
. ' --connect -n -v -n',
0,
[ qr{builtin: TPC-B},
qr{clients: 2\b},
qr{processed: 10/10},
qr{mode: simple} ],
[qr{^$}],
'pgbench tpcb-like');
pgbench(
'--transactions=20 --client=5 -M extended --builtin=si -C --no-vacuum -s 1',
0,
[ qr{builtin: simple update},
qr{clients: 5\b},
qr{threads: 1\b},
qr{processed: 100/100},
qr{mode: extended} ],
[qr{scale option ignored}],
'pgbench simple update');
pgbench(
'-t 100 -c 7 -M prepared -b se --debug',
0,
[ qr{builtin: select only},
qr{clients: 7\b},
qr{threads: 1\b},
qr{processed: 700/700},
qr{mode: prepared} ],
[ qr{vacuum}, qr{client 0}, qr{client 1}, qr{sending},
qr{receiving}, qr{executing} ],
'pgbench select only');
# run custom scripts
pgbench(
'-t 100 -c 1 -j 2 -M prepared -n',
0,
[ qr{type: multiple scripts},
qr{mode: prepared},
qr{script 1: .*/001_pgbench_custom_script_1},
qr{weight: 2},
qr{script 2: .*/001_pgbench_custom_script_2},
qr{weight: 1},
qr{processed: 100/100} ],
[qr{^$}],
'pgbench custom scripts',
{ '001_pgbench_custom_script_1@1' => q{-- select only
\set aid random(1, :scale * 100000)
SELECT abalance::INTEGER AS balance
FROM pgbench_accounts
WHERE aid=:aid;
},
'001_pgbench_custom_script_2@2' => q{-- special variables
BEGIN;
\set foo 1
-- cast are needed for typing under -M prepared
SELECT :foo::INT + :scale::INT * :client_id::INT AS bla;
COMMIT;
} });
pgbench(
'-n -t 10 -c 1 -M simple',
0,
[ qr{type: .*/001_pgbench_custom_script_3},
qr{processed: 10/10},
qr{mode: simple} ],
[qr{^$}],
'pgbench custom script',
{ '001_pgbench_custom_script_3' => q{-- select only variant
\set aid random(1, :scale * 100000)
BEGIN;
SELECT abalance::INTEGER AS balance
FROM pgbench_accounts
WHERE aid=:aid;
COMMIT;
} });
pgbench(
'-n -t 10 -c 2 -M extended',
0,
[ qr{type: .*/001_pgbench_custom_script_4},
qr{processed: 20/20},
qr{mode: extended} ],
[qr{^$}],
'pgbench custom script',
{ '001_pgbench_custom_script_4' => q{-- select only variant
\set aid random(1, :scale * 100000)
BEGIN;
SELECT abalance::INTEGER AS balance
FROM pgbench_accounts
WHERE aid=:aid;
COMMIT;
} });
# test expressions
pgbench(
'-t 1 -Dfoo=-10.1 -Dbla=false -Di=+3 -Dminint=-9223372036854775808',
0,
[ qr{type: .*/001_pgbench_expressions}, qr{processed: 1/1} ],
[ qr{command=4.: int 4\b},
qr{command=5.: int 5\b},
qr{command=6.: int 6\b},
qr{command=7.: int 7\b},
qr{command=8.: int 8\b},
qr{command=9.: int 9\b},
qr{command=10.: int 10\b},
qr{command=11.: int 11\b},
qr{command=12.: int 12\b},
qr{command=13.: double 13\b},
qr{command=14.: double 14\b},
qr{command=15.: double 15\b},
qr{command=16.: double 16\b},
qr{command=17.: double 17\b},
qr{command=18.: double 18\b},
qr{command=19.: double 19\b},
qr{command=20.: double 20\b},
qr{command=21.: double -?nan\b},
qr{command=22.: double inf\b},
qr{command=23.: double -inf\b},
qr{command=24.: int 9223372036854775807\b}, ],
'pgbench expressions',
{ '001_pgbench_expressions' => q{-- integer functions
\set i1 debug(random(1, 100))
\set i2 debug(random_exponential(1, 100, 10.0))
\set i3 debug(random_gaussian(1, 100, 10.0))
\set i4 debug(abs(-4))
\set i5 debug(greatest(5, 4, 3, 2))
\set i6 debug(11 + least(-5, -4, -3, -2))
\set i7 debug(int(7.3))
-- integer operators
\set i8 debug(17 / 5 + 5)
\set i9 debug(- (3 * 4 - 3) / -1 + 3 % -1)
\set ia debug(10 + (0 + 0 * 0 - 0 / 1))
\set ib debug(:ia + :scale)
\set ic debug(64 % 13)
-- double functions
\set d1 debug(sqrt(3.0) * abs(-0.8E1))
\set d2 debug(double(1 + 1) * 7)
\set pi debug(pi() * 4.9)
\set d4 debug(greatest(4, 2, -1.17) * 4.0)
\set d5 debug(least(-5.18, .0E0, 1.0/0) * -3.3)
-- double operators
\set d6 debug((0.5 * 12.1 - 0.05) * (31.0 / 10))
\set d7 debug(11.1 + 7.9)
\set d8 debug(:foo * -2)
-- special values
\set nan debug(0.0 / 0.0)
\set pin debug(1.0 / 0.0)
\set nin debug(-1.0 / 0.0)
\set maxint debug(:minint - 1)
-- reset a variable
\set i1 0
} });
# backslash commands
pgbench(
'-t 1', 0,
[ qr{type: .*/001_pgbench_backslash_commands},
qr{processed: 1/1},
qr{shell-echo-output} ],
[qr{command=8.: int 2\b}],
'pgbench backslash commands',
{ '001_pgbench_backslash_commands' => q{-- run set
\set zero 0
\set one 1.0
-- sleep
\sleep :one ms
\sleep 100 us
\sleep 0 s
\sleep :zero
-- setshell and continuation
\setshell two\
expr \
1 + :one
\set n debug(:two)
-- shell
\shell echo shell-echo-output
} });
# trigger many expression errors
my @errors = (
# [ test name, script number, status, stderr match ]
# SQL
[ 'sql syntax error',
0,
[ qr{ERROR: syntax error}, qr{prepared statement .* does not exist}
],
q{-- SQL syntax error
SELECT 1 + ;
} ],
[ 'sql too many args', 1, [qr{statement has too many arguments.*\b9\b}],
q{-- MAX_ARGS=10 for prepared
\set i 0
SELECT LEAST(:i, :i, :i, :i, :i, :i, :i, :i, :i, :i, :i);
} ],
# SHELL
[ 'shell bad command', 0,
[qr{meta-command 'shell' failed}], q{\shell no-such-command} ],
[ 'shell undefined variable', 0,
[qr{undefined variable ":nosuchvariable"}],
q{-- undefined variable in shell
\shell echo ::foo :nosuchvariable
} ],
[ 'shell missing command', 1, [qr{missing command }], q{\shell} ],
[ 'shell too many args', 1, [qr{too many arguments in command "shell"}],
q{-- 257 arguments to \shell
\shell echo \
0 1 2 3 4 5 6 7 8 9 A B C D E F \
0 1 2 3 4 5 6 7 8 9 A B C D E F \
0 1 2 3 4 5 6 7 8 9 A B C D E F \
0 1 2 3 4 5 6 7 8 9 A B C D E F \
0 1 2 3 4 5 6 7 8 9 A B C D E F \
0 1 2 3 4 5 6 7 8 9 A B C D E F \
0 1 2 3 4 5 6 7 8 9 A B C D E F \
0 1 2 3 4 5 6 7 8 9 A B C D E F \
0 1 2 3 4 5 6 7 8 9 A B C D E F \
0 1 2 3 4 5 6 7 8 9 A B C D E F \
0 1 2 3 4 5 6 7 8 9 A B C D E F \
0 1 2 3 4 5 6 7 8 9 A B C D E F \
0 1 2 3 4 5 6 7 8 9 A B C D E F \
0 1 2 3 4 5 6 7 8 9 A B C D E F \
0 1 2 3 4 5 6 7 8 9 A B C D E F \
0 1 2 3 4 5 6 7 8 9 A B C D E F
} ],
# SET
[ 'set syntax error', 1,
[qr{syntax error in command "set"}], q{\set i 1 +} ],
[ 'set no such function', 1,
[qr{unexpected function name}], q{\set i noSuchFunction()} ],
[ 'set invalid variable name', 0,
[qr{invalid variable name}], q{\set . 1} ],
[ 'set int overflow', 0,
[qr{double to int overflow for 100}], q{\set i int(1E32)} ],
[ 'set division by zero', 0, [qr{division by zero}], q{\set i 1/0} ],
[ 'set bigint out of range', 0,
[qr{bigint out of range}], q{\set i 9223372036854775808 / -1} ],
[ 'set undefined variable',
0,
[qr{undefined variable "nosuchvariable"}],
q{\set i :nosuchvariable} ],
[ 'set unexpected char', 1, [qr{unexpected character .;.}], q{\set i ;} ],
[ 'set too many args',
0,
[qr{too many function arguments}],
q{\set i least(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16)} ],
[ 'set empty random range', 0,
[qr{empty range given to random}], q{\set i random(5,3)} ],
[ 'set random range too large',
0,
[qr{random range is too large}],
q{\set i random(-9223372036854775808, 9223372036854775807)} ],
[ 'set gaussian param too small',
0,
[qr{gaussian param.* at least 2}],
q{\set i random_gaussian(0, 10, 1.0)} ],
[ 'set exponential param > 0',
0,
[qr{exponential parameter must be greater }],
q{\set i random_exponential(0, 10, 0.0)} ],
[ 'set non numeric value', 0,
[qr{malformed variable "foo" value: "bla"}], q{\set i :foo + 1} ],
[ 'set no expression', 1, [qr{syntax error}], q{\set i} ],
[ 'set missing argument', 1, [qr{missing argument}i], q{\set} ],
# SETSHELL
[ 'setshell not an int', 0,
[qr{command must return an integer}], q{\setshell i echo -n one} ],
[ 'setshell missing arg', 1, [qr{missing argument }], q{\setshell var} ],
[ 'setshell no such command', 0,
[qr{could not read result }], q{\setshell var no-such-command} ],
# SLEEP
[ 'sleep undefined variable', 0,
[qr{sleep: undefined variable}], q{\sleep :nosuchvariable} ],
[ 'sleep too many args', 1,
[qr{too many arguments}], q{\sleep too many args} ],
[ 'sleep missing arg', 1,
[ qr{missing argument}, qr{\\sleep} ], q{\sleep} ],
[ 'sleep unknown unit', 1,
[qr{unrecognized time unit}], q{\sleep 1 week} ],
# MISC
[ 'misc invalid backslash command', 1,
[qr{invalid command .* "nosuchcommand"}], q{\nosuchcommand} ],
[ 'misc empty script', 1, [qr{empty command list for script}], q{} ],);
for my $e (@errors)
{
my ($name, $status, $re, $script) = @$e;
my $n = '001_pgbench_error_' . $name;
$n =~ s/ /_/g;
pgbench(
'-n -t 1 -Dfoo=bla -M prepared',
$status,
[ $status ? qr{^$} : qr{processed: 0/1} ],
$re,
'pgbench script error: ' . $name,
{ $n => $script });
}
# throttling
pgbench(
'-t 100 -S --rate=100000 --latency-limit=1000000 -c 2 -n -r',
0,
[ qr{processed: 200/200}, qr{builtin: select only} ],
[qr{^$}],
'pgbench throttling');
pgbench(
# given the expected rate and the 2 ms tx duration, at most one is executed
'-t 10 --rate=100000 --latency-limit=1 -n -r',
0,
[ qr{processed: [01]/10},
qr{type: .*/001_pgbench_sleep},
qr{above the 1.0 ms latency limit: [01] } ],
[qr{^$}i],
'pgbench late throttling',
{ '001_pgbench_sleep' => q{\sleep 2ms} });
# check log contents and cleanup
sub check_pgbench_logs
{
my ($prefix, $nb, $min, $max, $re) = @_;
my @logs = <$prefix.*>;
ok(@logs == $nb, "number of log files");
ok(grep(/^$prefix\.\d+(\.\d+)?$/, @logs) == $nb, "file name format");
my $log_number = 0;
for my $log (sort @logs)
{
eval {
open LOG, $log or die "$@";
my @contents = <LOG>;
my $clen = @contents;
ok( $min <= $clen && $clen <= $max,
"transaction count for $log ($clen)");
ok( grep($re, @contents) == $clen,
"transaction format for $prefix");
close LOG or die "$@";
};
}
ok(unlink(@logs), "remove log files");
}
# note: --progress-timestamp is not tested
pgbench(
'-T 2 -P 1 -l --log-prefix=001_pgbench_log_1 --aggregate-interval=1'
. ' -S -b se@2 --rate=20 --latency-limit=1000 -j 2 -c 3 -r',
0,
[ qr{type: multiple},
qr{clients: 3},
qr{threads: 2},
qr{duration: 2 s},
qr{script 1: .* select only},
qr{script 2: .* select only},
qr{statement latencies in milliseconds},
qr{FROM pgbench_accounts} ],
[ qr{vacuum}, qr{progress: 1\b} ],
'pgbench progress');
# 2 threads 2 seconds, sometimes only one aggregated line is written
check_pgbench_logs('001_pgbench_log_1', 2, 1, 2,
qr{^\d+ \d{1,2} \d+ \d+ \d+ \d+ \d+ \d+ \d+ \d+ \d+$});
# with sampling rate
pgbench(
'-n -S -t 50 -c 2 --log --log-prefix=001_pgbench_log_2 --sampling-rate=0.5',
0,
[ qr{select only}, qr{processed: 100/100} ],
[qr{^$}],
'pgbench logs');
check_pgbench_logs('001_pgbench_log_2', 1, 8, 92,
qr{^0 \d{1,2} \d+ \d \d+ \d+$});
# check log file in some detail
pgbench(
'-n -b se -t 10 -l --log-prefix=001_pgbench_log_3',
0, [ qr{select only}, qr{processed: 10/10} ],
[qr{^$}], 'pgbench logs contents');
check_pgbench_logs('001_pgbench_log_3', 1, 10, 10,
qr{^\d \d{1,2} \d+ \d \d+ \d+$});
# done
$node->stop;
done_testing();
#
# 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();
......@@ -155,8 +155,9 @@ sub new
_logfile => "$TestLib::log_path/${testname}_${name}.log" };
bless $self, $class;
mkdir $self->{_basedir} or
BAIL_OUT("could not create data directory \"$self->{_basedir}\": $!");
mkdir $self->{_basedir}
or
BAIL_OUT("could not create data directory \"$self->{_basedir}\": $!");
$self->dump_info;
return $self;
......@@ -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 = $!;
......@@ -965,7 +965,7 @@ END
# clean basedir on clean test invocation
$node->clean_node
if TestLib::all_tests_passing() && !defined $died && !$exit_code;
if TestLib::all_tests_passing() && !defined $died && !$exit_code;
}
$? = $exit_code;
......@@ -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
......
......@@ -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;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment