diff options
Diffstat (limited to 'src/test/perl')
| -rw-r--r-- | src/test/perl/PostgresNode.pm | 470 | ||||
| -rw-r--r-- | src/test/perl/RecursiveCopy.pm | 42 | ||||
| -rw-r--r-- | src/test/perl/TestLib.pm | 319 |
3 files changed, 620 insertions, 211 deletions
diff --git a/src/test/perl/PostgresNode.pm b/src/test/perl/PostgresNode.pm new file mode 100644 index 00000000000..aa7a00c9fa4 --- /dev/null +++ b/src/test/perl/PostgresNode.pm @@ -0,0 +1,470 @@ +# PostgresNode, class representing a data directory and postmaster. +# +# This contains a basic set of routines able to work on a PostgreSQL node, +# allowing to start, stop, backup and initialize it with various options. +# The set of nodes managed by a given test is also managed by this module. + +package PostgresNode; + +use strict; +use warnings; + +use Config; +use Cwd; +use Exporter 'import'; +use File::Basename; +use File::Spec; +use File::Temp (); +use IPC::Run; +use PostgresNode; +use RecursiveCopy; +use Test::More; +use TestLib (); + +our @EXPORT = qw( + get_new_node +); + +our ($test_pghost, $last_port_assigned, @all_nodes); + +BEGIN +{ + + # PGHOST is set once and for all through a single series of tests when + # this module is loaded. + $test_pghost = + $TestLib::windows_os ? "127.0.0.1" : TestLib::tempdir_short; + $ENV{PGHOST} = $test_pghost; + $ENV{PGDATABASE} = 'postgres'; + + # Tracking of last port value assigned to accelerate free port lookup. + # XXX: Should this use PG_VERSION_NUM? + $last_port_assigned = 90600 % 16384 + 49152; + + # Node tracking + @all_nodes = (); +} + +sub new +{ + my $class = shift; + my $pghost = shift; + my $pgport = shift; + my $self = { + _port => $pgport, + _host => $pghost, + _basedir => TestLib::tempdir, + _applname => "node_$pgport", + _logfile => "$TestLib::log_path/node_$pgport.log" }; + + bless $self, $class; + $self->dump_info; + + return $self; +} + +sub port +{ + my ($self) = @_; + return $self->{_port}; +} + +sub host +{ + my ($self) = @_; + return $self->{_host}; +} + +sub basedir +{ + my ($self) = @_; + return $self->{_basedir}; +} + +sub applname +{ + my ($self) = @_; + return $self->{_applname}; +} + +sub logfile +{ + my ($self) = @_; + return $self->{_logfile}; +} + +sub connstr +{ + my ($self, $dbname) = @_; + my $pgport = $self->port; + my $pghost = $self->host; + if (!defined($dbname)) + { + return "port=$pgport host=$pghost"; + } + return "port=$pgport host=$pghost dbname=$dbname"; +} + +sub data_dir +{ + my ($self) = @_; + my $res = $self->basedir; + return "$res/pgdata"; +} + +sub archive_dir +{ + my ($self) = @_; + my $basedir = $self->basedir; + return "$basedir/archives"; +} + +sub backup_dir +{ + my ($self) = @_; + my $basedir = $self->basedir; + return "$basedir/backup"; +} + +# Dump node information +sub dump_info +{ + my ($self) = @_; + print "Data directory: " . $self->data_dir . "\n"; + print "Backup directory: " . $self->backup_dir . "\n"; + print "Archive directory: " . $self->archive_dir . "\n"; + print "Connection string: " . $self->connstr . "\n"; + print "Application name: " . $self->applname . "\n"; + print "Log file: " . $self->logfile . "\n"; +} + +sub set_replication_conf +{ + my ($self) = @_; + my $pgdata = $self->data_dir; + + open my $hba, ">>$pgdata/pg_hba.conf"; + print $hba "\n# Allow replication (set up by PostgresNode.pm)\n"; + if (!$TestLib::windows_os) + { + print $hba "local replication all trust\n"; + } + else + { + print $hba +"host replication all 127.0.0.1/32 sspi include_realm=1 map=regress\n"; + } + close $hba; +} + +# Initialize a new cluster for testing. +# +# Authentication is set up so that only the current OS user can access the +# cluster. On Unix, we use Unix domain socket connections, with the socket in +# a directory that's only accessible to the current user to ensure that. +# On Windows, we use SSPI authentication to ensure the same (by pg_regress +# --config-auth). +sub init +{ + my ($self, %params) = @_; + my $port = $self->port; + my $pgdata = $self->data_dir; + my $host = $self->host; + + $params{hba_permit_replication} = 1 + if (!defined($params{hba_permit_replication})); + + mkdir $self->backup_dir; + mkdir $self->archive_dir; + + TestLib::system_or_bail('initdb', '-D', $pgdata, '-A', 'trust', '-N'); + TestLib::system_or_bail($ENV{PG_REGRESS}, '--config-auth', $pgdata); + + open my $conf, ">>$pgdata/postgresql.conf"; + print $conf "\n# Added by PostgresNode.pm)\n"; + print $conf "fsync = off\n"; + print $conf "log_statement = all\n"; + print $conf "port = $port\n"; + if ($TestLib::windows_os) + { + print $conf "listen_addresses = '$host'\n"; + } + else + { + print $conf "unix_socket_directories = '$host'\n"; + print $conf "listen_addresses = ''\n"; + } + close $conf; + + $self->set_replication_conf if ($params{hba_permit_replication}); +} + +sub append_conf +{ + my ($self, $filename, $str) = @_; + + my $conffile = $self->data_dir . '/' . $filename; + + TestLib::append_to_file($conffile, $str); +} + +sub backup +{ + my ($self, $backup_name) = @_; + my $backup_path = $self->backup_dir . '/' . $backup_name; + my $port = $self->port; + + print "# Taking backup $backup_name from node with port $port\n"; + TestLib::system_or_bail("pg_basebackup -D $backup_path -p $port -x"); + print "# Backup finished\n"; +} + +sub init_from_backup +{ + my ($self, $root_node, $backup_name) = @_; + my $backup_path = $root_node->backup_dir . '/' . $backup_name; + my $port = $self->port; + my $root_port = $root_node->port; + + print +"Initializing node $port from backup \"$backup_name\" of node $root_port\n"; + die "Backup $backup_path does not exist" unless -d $backup_path; + + mkdir $self->backup_dir; + mkdir $self->archive_dir; + + my $data_path = $self->data_dir; + rmdir($data_path); + RecursiveCopy::copypath($backup_path, $data_path); + chmod(0700, $data_path); + + # Base configuration for this node + $self->append_conf( + 'postgresql.conf', + qq( +port = $port +)); + $self->set_replication_conf; +} + +sub start +{ + my ($self) = @_; + my $port = $self->port; + my $pgdata = $self->data_dir; + print("### Starting test server in $pgdata\n"); + my $ret = TestLib::system_log('pg_ctl', '-w', '-D', $self->data_dir, '-l', + $self->logfile, 'start'); + + if ($ret != 0) + { + print "# pg_ctl failed; logfile:\n"; + print TestLib::slurp_file($self->logfile); + BAIL_OUT("pg_ctl failed"); + } + + $self->_update_pid; + +} + +sub stop +{ + my ($self, $mode) = @_; + my $port = $self->port; + my $pgdata = $self->data_dir; + $mode = 'fast' if (!defined($mode)); + print "### Stopping node in $pgdata with port $port using mode $mode\n"; + TestLib::system_log('pg_ctl', '-D', $pgdata, '-m', $mode, 'stop'); + $self->{_pid} = undef; + $self->_update_pid; +} + +sub restart +{ + my ($self) = @_; + my $port = $self->port; + my $pgdata = $self->data_dir; + my $logfile = $self->logfile; + TestLib::system_log('pg_ctl', '-D', $pgdata, '-w', '-l', $logfile, + 'restart'); + $self->_update_pid; +} + +sub _update_pid +{ + my $self = shift; + + # If we can open the PID file, read its first line and that's the PID we + # want. If the file cannot be opened, presumably the server is not + # running; don't be noisy in that case. + open my $pidfile, $self->data_dir . "/postmaster.pid"; + if (not defined $pidfile) + { + $self->{_pid} = undef; + print "# No postmaster PID\n"; + return; + } + + $self->{_pid} = <$pidfile>; + print "# Postmaster PID is $self->{_pid}\n"; + close $pidfile; +} + +# +# Cluster management functions +# + +# Build a new PostgresNode object, assigning a free port number. +# +# We also register the node, to avoid the port number from being reused +# for another node even when this one is not active. +sub get_new_node +{ + my $found = 0; + my $port = $last_port_assigned; + + while ($found == 0) + { + $port++; + print "# Checking for port $port\n"; + my $devnull = $TestLib::windows_os ? "nul" : "/dev/null"; + if (!TestLib::run_log([ 'pg_isready', '-p', $port ])) + { + $found = 1; + + # Found a potential candidate port number. Check first that it is + # not included in the list of registered nodes. + foreach my $node (@all_nodes) + { + $found = 0 if ($node->port == $port); + } + } + } + + print "# Found free port $port\n"; + + # Lock port number found by creating a new node + my $node = new PostgresNode($test_pghost, $port); + + # Add node to list of nodes + push(@all_nodes, $node); + + # And update port for next time + $last_port_assigned = $port; + + return $node; +} + +sub DESTROY +{ + my $self = shift; + return if not defined $self->{_pid}; + print "# signalling QUIT to $self->{_pid}\n"; + kill 'QUIT', $self->{_pid}; +} + +sub teardown_node +{ + my $self = shift; + + $self->stop('immediate'); +} + +sub psql +{ + my ($self, $dbname, $sql) = @_; + + my ($stdout, $stderr); + print("# Running SQL command: $sql\n"); + + IPC::Run::run [ 'psql', '-XAtq', '-d', $self->connstr($dbname), '-f', + '-' ], '<', \$sql, '>', \$stdout, '2>', \$stderr + or die; + + if ($stderr ne "") + { + print "#### Begin standard error\n"; + print $stderr; + print "#### End standard error\n"; + } + chomp $stdout; + $stdout =~ s/\r//g if $Config{osname} eq 'msys'; + return $stdout; +} + +# Run a query once a second, until it returns 't' (i.e. SQL boolean true). +sub poll_query_until +{ + my ($self, $dbname, $query) = @_; + + my $max_attempts = 30; + my $attempts = 0; + my ($stdout, $stderr); + + while ($attempts < $max_attempts) + { + my $cmd = + [ 'psql', '-At', '-c', $query, '-d', $self->connstr($dbname) ]; + my $result = IPC::Run::run $cmd, '>', \$stdout, '2>', \$stderr; + + chomp($stdout); + $stdout =~ s/\r//g if $Config{osname} eq 'msys'; + if ($stdout eq "t") + { + return 1; + } + + # Wait a second before retrying. + sleep 1; + $attempts++; + } + + # The query result didn't change in 30 seconds. Give up. Print the stderr + # from the last attempt, hopefully that's useful for debugging. + diag $stderr; + return 0; +} + +sub command_ok +{ + my $self = shift; + + local $ENV{PGPORT} = $self->port; + + TestLib::command_ok(@_); +} + +sub command_fails +{ + my $self = shift; + + local $ENV{PGPORT} = $self->port; + + TestLib::command_fails(@_); +} + +sub command_like +{ + my $self = shift; + + local $ENV{PGPORT} = $self->port; + + TestLib::command_like(@_); +} + +# Run a command on the node, then verify that $expected_sql appears in the +# server log file. +sub issues_sql_like +{ + my ($self, $cmd, $expected_sql, $test_name) = @_; + + local $ENV{PGPORT} = $self->port; + + truncate $self->logfile, 0; + my $result = TestLib::run_log($cmd); + ok($result, "@$cmd exit code 0"); + my $log = TestLib::slurp_file($self->logfile); + like($log, $expected_sql, "$test_name: SQL found in server log"); +} + +1; diff --git a/src/test/perl/RecursiveCopy.pm b/src/test/perl/RecursiveCopy.pm new file mode 100644 index 00000000000..9362aa89590 --- /dev/null +++ b/src/test/perl/RecursiveCopy.pm @@ -0,0 +1,42 @@ +# RecursiveCopy, a simple recursive copy implementation +package RecursiveCopy; + +use strict; +use warnings; + +use File::Basename; +use File::Copy; + +sub copypath +{ + my $srcpath = shift; + my $destpath = shift; + + die "Cannot operate on symlinks" if -l $srcpath or -l $destpath; + + # This source path is a file, simply copy it to destination with the + # same name. + die "Destination path $destpath exists as file" if -f $destpath; + if (-f $srcpath) + { + copy($srcpath, $destpath) + or die "copy $srcpath -> $destpath failed: $!"; + return 1; + } + + die "Destination needs to be a directory" unless -d $srcpath; + mkdir($destpath) or die "mkdir($destpath) failed: $!"; + + # Scan existing source directory and recursively copy everything. + opendir(my $directory, $srcpath) or die "could not opendir($srcpath): $!"; + while (my $entry = readdir($directory)) + { + next if ($entry eq '.' || $entry eq '..'); + RecursiveCopy::copypath("$srcpath/$entry", "$destpath/$entry") + or die "copypath $srcpath/$entry -> $destpath/$entry failed"; + } + closedir($directory); + return 1; +} + +1; diff --git a/src/test/perl/TestLib.pm b/src/test/perl/TestLib.pm index 02533ebde53..af46dc8c7a2 100644 --- a/src/test/perl/TestLib.pm +++ b/src/test/perl/TestLib.pm @@ -1,3 +1,10 @@ +# TestLib, low-level routines and actions regression tests. +# +# This module contains a set of routines dedicated to environment setup for +# a PostgreSQL regression test tun, and includes some low-level routines +# aimed at controlling command execution, logging and test functions. This +# module should never depend on any other PostgreSQL regression test modules. + package TestLib; use strict; @@ -5,16 +12,17 @@ use warnings; use Config; use Exporter 'import'; +use File::Basename; +use File::Spec; +use File::Temp (); +use IPC::Run; +use SimpleTee; +use Test::More; + our @EXPORT = qw( - tempdir - tempdir_short - standard_initdb - configure_hba_for_replication - start_test_server - restart_test_server - psql slurp_dir slurp_file + append_to_file system_or_bail system_log run_log @@ -26,88 +34,82 @@ our @EXPORT = qw( program_version_ok program_options_handling_ok command_like - issues_sql_like - $tmp_check - $log_path $windows_os ); -use Cwd; -use File::Basename; -use File::Spec; -use File::Temp (); -use IPC::Run qw(run start); +our ($windows_os, $tmp_check, $log_path, $test_logfile); -use SimpleTee; - -use Test::More; - -our $windows_os = $Config{osname} eq 'MSWin32' || $Config{osname} eq 'msys'; - -# Open log file. For each test, the log file name uses the name of the -# file launching this module, without the .pl suffix. -our ($tmp_check, $log_path); -$tmp_check = $ENV{TESTDIR} ? "$ENV{TESTDIR}/tmp_check" : "tmp_check"; -$log_path = "$tmp_check/log"; -mkdir $tmp_check; -mkdir $log_path; -my $test_logfile = basename($0); -$test_logfile =~ s/\.[^.]+$//; -$test_logfile = "$log_path/regress_log_$test_logfile"; -open TESTLOG, '>', $test_logfile or die "Cannot open STDOUT to logfile: $!"; - -# Hijack STDOUT and STDERR to the log file -open(ORIG_STDOUT, ">&STDOUT"); -open(ORIG_STDERR, ">&STDERR"); -open(STDOUT, ">&TESTLOG"); -open(STDERR, ">&TESTLOG"); - -# The test output (ok ...) needs to be printed to the original STDOUT so -# that the 'prove' program can parse it, and display it to the user in -# real time. But also copy it to the log file, to provide more context -# in the log. -my $builder = Test::More->builder; -my $fh = $builder->output; -tie *$fh, "SimpleTee", *ORIG_STDOUT, *TESTLOG; -$fh = $builder->failure_output; -tie *$fh, "SimpleTee", *ORIG_STDERR, *TESTLOG; - -# Enable auto-flushing for all the file handles. Stderr and stdout are -# redirected to the same file, and buffering causes the lines to appear -# in the log in confusing order. -autoflush STDOUT 1; -autoflush STDERR 1; -autoflush TESTLOG 1; - -# Set to untranslated messages, to be able to compare program output -# with expected strings. -delete $ENV{LANGUAGE}; -delete $ENV{LC_ALL}; -$ENV{LC_MESSAGES} = 'C'; - -delete $ENV{PGCONNECT_TIMEOUT}; -delete $ENV{PGDATA}; -delete $ENV{PGDATABASE}; -delete $ENV{PGHOSTADDR}; -delete $ENV{PGREQUIRESSL}; -delete $ENV{PGSERVICE}; -delete $ENV{PGSSLMODE}; -delete $ENV{PGUSER}; - -if (!$ENV{PGPORT}) +BEGIN { - $ENV{PGPORT} = 65432; + + # Set to untranslated messages, to be able to compare program output + # with expected strings. + delete $ENV{LANGUAGE}; + delete $ENV{LC_ALL}; + $ENV{LC_MESSAGES} = 'C'; + + delete $ENV{PGCONNECT_TIMEOUT}; + delete $ENV{PGDATA}; + delete $ENV{PGDATABASE}; + delete $ENV{PGHOSTADDR}; + delete $ENV{PGREQUIRESSL}; + delete $ENV{PGSERVICE}; + delete $ENV{PGSSLMODE}; + delete $ENV{PGUSER}; + delete $ENV{PGPORT}; + delete $ENV{PGHOST}; + + # Must be set early + $windows_os = $Config{osname} eq 'MSWin32' || $Config{osname} eq 'msys'; } -$ENV{PGPORT} = int($ENV{PGPORT}) % 65536; +INIT +{ + # Determine output directories, and create them. The base path is the + # TESTDIR environment variable, which is normally set by the invoking + # Makefile. + $tmp_check = $ENV{TESTDIR} ? "$ENV{TESTDIR}/tmp_check" : "tmp_check"; + $log_path = "$tmp_check/log"; + + mkdir $tmp_check; + mkdir $log_path; + + # Open the test log file, whose name depends on the test name. + $test_logfile = basename($0); + $test_logfile =~ s/\.[^.]+$//; + $test_logfile = "$log_path/regress_log_$test_logfile"; + open TESTLOG, '>', $test_logfile + or die "could not open STDOUT to logfile \"$test_logfile\": $!"; + + # Hijack STDOUT and STDERR to the log file + open(ORIG_STDOUT, ">&STDOUT"); + open(ORIG_STDERR, ">&STDERR"); + open(STDOUT, ">&TESTLOG"); + open(STDERR, ">&TESTLOG"); + + # The test output (ok ...) needs to be printed to the original STDOUT so + # that the 'prove' program can parse it, and display it to the user in + # real time. But also copy it to the log file, to provide more context + # in the log. + my $builder = Test::More->builder; + my $fh = $builder->output; + tie *$fh, "SimpleTee", *ORIG_STDOUT, *TESTLOG; + $fh = $builder->failure_output; + tie *$fh, "SimpleTee", *ORIG_STDERR, *TESTLOG; + + # Enable auto-flushing for all the file handles. Stderr and stdout are + # redirected to the same file, and buffering causes the lines to appear + # in the log in confusing order. + autoflush STDOUT 1; + autoflush STDERR 1; + autoflush TESTLOG 1; +} # # Helper functions # - - sub tempdir { return File::Temp::tempdir( @@ -124,117 +126,31 @@ sub tempdir_short return File::Temp::tempdir(CLEANUP => 1); } -# Initialize a new cluster for testing. -# -# The PGHOST environment variable is set to connect to the new cluster. -# -# Authentication is set up so that only the current OS user can access the -# cluster. On Unix, we use Unix domain socket connections, with the socket in -# a directory that's only accessible to the current user to ensure that. -# On Windows, we use SSPI authentication to ensure the same (by pg_regress -# --config-auth). -sub standard_initdb -{ - my $pgdata = shift; - system_or_bail('initdb', '-D', "$pgdata", '-A' , 'trust', '-N'); - system_or_bail($ENV{PG_REGRESS}, '--config-auth', $pgdata); - - my $tempdir_short = tempdir_short; - - open CONF, ">>$pgdata/postgresql.conf"; - print CONF "\n# Added by TestLib.pm)\n"; - print CONF "fsync = off\n"; - if ($windows_os) - { - print CONF "listen_addresses = '127.0.0.1'\n"; - } - else - { - print CONF "unix_socket_directories = '$tempdir_short'\n"; - print CONF "listen_addresses = ''\n"; - } - close CONF; - - $ENV{PGHOST} = $windows_os ? "127.0.0.1" : $tempdir_short; -} - -# Set up the cluster to allow replication connections, in the same way that -# standard_initdb does for normal connections. -sub configure_hba_for_replication -{ - my $pgdata = shift; - - open HBA, ">>$pgdata/pg_hba.conf"; - print HBA "\n# Allow replication (set up by TestLib.pm)\n"; - if (! $windows_os) - { - print HBA "local replication all trust\n"; - } - else - { - print HBA "host replication all 127.0.0.1/32 sspi include_realm=1 map=regress\n"; - } - close HBA; -} - -my ($test_server_datadir, $test_server_logfile); - - -# Initialize a new cluster for testing in given directory, and start it. -sub start_test_server -{ - my ($tempdir) = @_; - my $ret; - - print("### Starting test server in $tempdir\n"); - standard_initdb "$tempdir/pgdata"; - - $ret = system_log('pg_ctl', '-D', "$tempdir/pgdata", '-w', '-l', - "$log_path/postmaster.log", '-o', "--log-statement=all", - 'start'); - - if ($ret != 0) - { - print "# pg_ctl failed; logfile:\n"; - system('cat', "$log_path/postmaster.log"); - BAIL_OUT("pg_ctl failed"); - } - - $test_server_datadir = "$tempdir/pgdata"; - $test_server_logfile = "$log_path/postmaster.log"; -} - -sub restart_test_server +sub system_log { - print("### Restarting test server\n"); - system_log('pg_ctl', '-D', $test_server_datadir, '-w', '-l', - $test_server_logfile, 'restart'); + print("# Running: " . join(" ", @_) . "\n"); + return system(@_); } -END +sub system_or_bail { - if ($test_server_datadir) + if (system_log(@_) != 0) { - system_log('pg_ctl', '-D', $test_server_datadir, '-m', - 'immediate', 'stop'); + BAIL_OUT("system $_[0] failed"); } } -sub psql +sub run_log { - my ($dbname, $sql) = @_; - my ($stdout, $stderr); - print("# Running SQL command: $sql\n"); - run [ 'psql', '-X', '-A', '-t', '-q', '-d', $dbname, '-f', '-' ], '<', \$sql, '>', \$stdout, '2>', \$stderr or die; - chomp $stdout; - $stdout =~ s/\r//g if $Config{osname} eq 'msys'; - return $stdout; + print("# Running: " . join(" ", @{ $_[0] }) . "\n"); + return run(@_); } sub slurp_dir { my ($dir) = @_; - opendir(my $dh, $dir) or die; + opendir(my $dh, $dir) + or die "could not opendir \"$dir\": $!"; my @direntries = readdir $dh; closedir $dh; return @direntries; @@ -249,32 +165,18 @@ sub slurp_file return $contents; } -sub system_or_bail -{ - if (system_log(@_) != 0) - { - BAIL_OUT("system $_[0] failed: $?"); - } -} - -sub system_log +sub append_to_file { - print("# Running: " . join(" ", @_) ."\n"); - return system(@_); -} + my ($filename, $str) = @_; -sub run_log -{ - print("# Running: " . join(" ", @{$_[0]}) ."\n"); - return run (@_); + open my $fh, ">>", $filename or die "could not open \"$filename\": $!"; + print $fh $str; + close $fh; } - # # Test functions # - - sub command_ok { my ($cmd, $test_name) = @_; @@ -292,8 +194,8 @@ sub command_fails sub command_exit_is { my ($cmd, $expected, $test_name) = @_; - print("# Running: " . join(" ", @{$cmd}) ."\n"); - my $h = start $cmd; + print("# Running: " . join(" ", @{$cmd}) . "\n"); + my $h = IPC::Run::start $cmd; $h->finish(); # On Windows, the exit status of the process is returned directly as the @@ -303,8 +205,10 @@ sub command_exit_is # assuming the Unix convention, which will always return 0 on Windows as # long as the process was not terminated by an exception. To work around # that, use $h->full_result on Windows instead. - my $result = ($Config{osname} eq "MSWin32") ? - ($h->full_results)[0] : $h->result(0); + my $result = + ($Config{osname} eq "MSWin32") + ? ($h->full_results)[0] + : $h->result(0); is($result, $expected, $test_name); } @@ -313,7 +217,8 @@ sub program_help_ok my ($cmd) = @_; my ($stdout, $stderr); print("# Running: $cmd --help\n"); - my $result = run [ $cmd, '--help' ], '>', \$stdout, '2>', \$stderr; + 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"); @@ -324,7 +229,8 @@ sub program_version_ok my ($cmd) = @_; my ($stdout, $stderr); print("# Running: $cmd --version\n"); - my $result = run [ $cmd, '--version' ], '>', \$stdout, '2>', \$stderr; + 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"); @@ -335,8 +241,9 @@ sub program_options_handling_ok my ($cmd) = @_; my ($stdout, $stderr); print("# Running: $cmd --not-a-valid-option\n"); - my $result = run [ $cmd, '--not-a-valid-option' ], '>', \$stdout, '2>', - \$stderr; + 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"); } @@ -346,20 +253,10 @@ sub command_like my ($cmd, $expected_stdout, $test_name) = @_; my ($stdout, $stderr); print("# Running: " . join(" ", @{$cmd}) . "\n"); - my $result = run $cmd, '>', \$stdout, '2>', \$stderr; + my $result = IPC::Run::run $cmd, '>', \$stdout, '2>', \$stderr; ok($result, "@$cmd exit code 0"); is($stderr, '', "@$cmd no stderr"); like($stdout, $expected_stdout, "$test_name: matches"); } -sub issues_sql_like -{ - my ($cmd, $expected_sql, $test_name) = @_; - truncate $test_server_logfile, 0; - my $result = run_log($cmd); - ok($result, "@$cmd exit code 0"); - my $log = slurp_file($test_server_logfile); - like($log, $expected_sql, "$test_name: SQL found in server log"); -} - 1; |