diff --git a/src/test/perl/TestLib.pm b/src/test/perl/TestLib.pm index a164cdb..fe11f9d 100644 --- a/src/test/perl/TestLib.pm +++ b/src/test/perl/TestLib.pm @@ -1,564 +1,868 @@ -# TestLib, low-level routines and actions regression tests. -# -# This module contains a set of routines dedicated to environment setup for -# a PostgreSQL regression test run 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; -use warnings; - -use Config; -use Cwd; -use Exporter 'import'; -use Fcntl qw(:mode); -use File::Basename; -use File::Find; -use File::Spec; -use File::stat qw(stat); -use File::Temp (); -use IPC::Run; -use SimpleTee; - -# specify a recent enough version of Test::More to support the done_testing() function -use Test::More 0.87; - -our @EXPORT = qw( - generate_ascii_string - slurp_dir - slurp_file - append_to_file - check_mode_recursive - chmod_recursive - check_pg_config - system_or_bail - system_log - run_log - run_command - - command_ok - command_fails - command_exit_is - program_help_ok - program_version_ok - program_options_handling_ok - command_like - command_like_safe - command_fails_like - command_checks_all - - $windows_os -); - -our ($windows_os, $tmp_check, $log_path, $test_logfile); - -BEGIN -{ - - # 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}; - delete $ENV{PG_COLOR}; - - $ENV{PGAPPNAME} = basename($0); - - # Must be set early - $windows_os = $Config{osname} eq 'MSWin32' || $Config{osname} eq 'msys'; -} - -INIT -{ - - # Return EPIPE instead of killing the process with SIGPIPE. An affected - # test may still fail, but it's more likely to report useful facts. - $SIG{PIPE} = 'IGNORE'; - - # 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 my $testlog, '>', $test_logfile - or die "could not open STDOUT to logfile \"$test_logfile\": $!"; - - # Hijack STDOUT and STDERR to the log file - open(my $orig_stdout, '>&', \*STDOUT); - open(my $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; -} - -END -{ - - # Preserve temporary directory for this test on failure - $File::Temp::KEEP_ALL = 1 unless all_tests_passing(); -} - -sub all_tests_passing -{ - my $fail_count = 0; - foreach my $status (Test::More->builder->summary) - { - return 0 unless $status; - } - return 1; -} - -# -# Helper functions -# -sub tempdir -{ - my ($prefix) = @_; - $prefix = "tmp_test" unless defined $prefix; - return File::Temp::tempdir( - $prefix . '_XXXX', - DIR => $tmp_check, - CLEANUP => 1); -} - -sub tempdir_short -{ - - # Use a separate temp dir outside the build tree for the - # Unix-domain socket, to avoid file name length issues. - return File::Temp::tempdir(CLEANUP => 1); -} - -# Return the real directory for a virtual path directory under msys. -# The directory must exist. If it's not an existing directory or we're -# not under msys, return the input argument unchanged. -sub real_dir -{ - my $dir = "$_[0]"; - return $dir unless -d $dir; - return $dir unless $Config{osname} eq 'msys'; - my $here = cwd; - chdir $dir; - - # this odd way of calling 'pwd -W' is the only way that seems to work. - $dir = qx{sh -c "pwd -W"}; - chomp $dir; - chdir $here; - return $dir; -} - -sub system_log -{ - print("# Running: " . join(" ", @_) . "\n"); - return system(@_); -} - -sub system_or_bail -{ - if (system_log(@_) != 0) - { - BAIL_OUT("system $_[0] failed"); - } - return; -} - -sub run_log -{ - print("# Running: " . join(" ", @{ $_[0] }) . "\n"); - return IPC::Run::run(@_); -} - -sub run_command -{ - my ($cmd) = @_; - my ($stdout, $stderr); - my $result = IPC::Run::run $cmd, '>', \$stdout, '2>', \$stderr; - chomp($stdout); - chomp($stderr); - return ($stdout, $stderr); -} - -# Generate a string made of the given range of ASCII characters -sub generate_ascii_string -{ - my ($from_char, $to_char) = @_; - my $res; - - for my $i ($from_char .. $to_char) - { - $res .= sprintf("%c", $i); - } - return $res; -} - -sub slurp_dir -{ - my ($dir) = @_; - opendir(my $dh, $dir) - or die "could not opendir \"$dir\": $!"; - my @direntries = readdir $dh; - closedir $dh; - return @direntries; -} - -sub slurp_file -{ - my ($filename) = @_; - local $/; - open(my $in, '<', $filename) - or die "could not read \"$filename\": $!"; - my $contents = <$in>; - close $in; - $contents =~ s/\r//g if $Config{osname} eq 'msys'; - return $contents; -} - -sub append_to_file -{ - my ($filename, $str) = @_; - open my $fh, ">>", $filename - or die "could not write \"$filename\": $!"; - print $fh $str; - close $fh; - return; -} - -# Check that all file/dir modes in a directory match the expected values, -# ignoring the mode of any specified files. -sub check_mode_recursive -{ - my ($dir, $expected_dir_mode, $expected_file_mode, $ignore_list) = @_; - - # Result defaults to true - my $result = 1; - - find( - { - follow_fast => 1, - wanted => sub { - # Is file in the ignore list? - foreach my $ignore ($ignore_list ? @{$ignore_list} : []) - { - if ("$dir/$ignore" eq $File::Find::name) - { - return; - } - } - - # Allow ENOENT. A running server can delete files, such as - # those in pg_stat. Other stat() failures are fatal. - my $file_stat = stat($File::Find::name); - unless (defined($file_stat)) - { - my $is_ENOENT = $!{ENOENT}; - my $msg = "unable to stat $File::Find::name: $!"; - if ($is_ENOENT) - { - warn $msg; - return; - } - else - { - die $msg; - } - } - - my $file_mode = S_IMODE($file_stat->mode); - - # Is this a file? - if (S_ISREG($file_stat->mode)) - { - if ($file_mode != $expected_file_mode) - { - print( - *STDERR, - sprintf("$File::Find::name mode must be %04o\n", - $expected_file_mode)); - - $result = 0; - return; - } - } - - # Else a directory? - elsif (S_ISDIR($file_stat->mode)) - { - if ($file_mode != $expected_dir_mode) - { - print( - *STDERR, - sprintf("$File::Find::name mode must be %04o\n", - $expected_dir_mode)); - - $result = 0; - return; - } - } - - # Else something we can't handle - else - { - die "unknown file type for $File::Find::name"; - } - } - }, - $dir); - - return $result; -} - -# Change mode recursively on a directory -sub chmod_recursive -{ - my ($dir, $dir_mode, $file_mode) = @_; - - find( - { - follow_fast => 1, - wanted => sub { - my $file_stat = stat($File::Find::name); - - if (defined($file_stat)) - { - chmod( - S_ISDIR($file_stat->mode) ? $dir_mode : $file_mode, - $File::Find::name - ) or die "unable to chmod $File::Find::name"; - } - } - }, - $dir); - return; -} - -# Check presence of a given regexp within pg_config.h for the installation -# where tests are running, returning a match status result depending on -# that. -sub check_pg_config -{ - my ($regexp) = @_; - my ($stdout, $stderr); - my $result = IPC::Run::run [ 'pg_config', '--includedir' ], '>', - \$stdout, '2>', \$stderr - or die "could not execute pg_config"; - chomp($stdout); - - open my $pg_config_h, '<', "$stdout/pg_config.h" or die "$!"; - my $match = (grep { /^$regexp/ } <$pg_config_h>); - close $pg_config_h; - return $match; -} - -# -# Test functions -# -sub command_ok -{ - local $Test::Builder::Level = $Test::Builder::Level + 1; - my ($cmd, $test_name) = @_; - my $result = run_log($cmd); - ok($result, $test_name); - return; -} - -sub command_fails -{ - local $Test::Builder::Level = $Test::Builder::Level + 1; - my ($cmd, $test_name) = @_; - my $result = run_log($cmd); - ok(!$result, $test_name); - return; -} - -sub command_exit_is -{ - local $Test::Builder::Level = $Test::Builder::Level + 1; - my ($cmd, $expected, $test_name) = @_; - 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 - # process's exit code, while on Unix, it's returned in the high bits - # of the exit code (see WEXITSTATUS macro in the standard - # header file). IPC::Run's result function always returns exit code >> 8, - # 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); - is($result, $expected, $test_name); - return; -} - -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"); - return; -} - -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"); - return; -} - -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"); - return; -} - -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"); - return; -} - -sub command_like_safe -{ - local $Test::Builder::Level = $Test::Builder::Level + 1; - - # Doesn't rely on detecting end of file on the file descriptors, - # which can fail, causing the process to hang, notably on Msys - # when used with 'pg_ctl start' - my ($cmd, $expected_stdout, $test_name) = @_; - my ($stdout, $stderr); - my $stdoutfile = File::Temp->new(); - my $stderrfile = File::Temp->new(); - print("# Running: " . join(" ", @{$cmd}) . "\n"); - my $result = IPC::Run::run $cmd, '>', $stdoutfile, '2>', $stderrfile; - $stdout = slurp_file($stdoutfile); - $stderr = slurp_file($stderrfile); - ok($result, "$test_name: exit code 0"); - is($stderr, '', "$test_name: no stderr"); - like($stdout, $expected_stdout, "$test_name: matches"); - return; -} - -sub command_fails_like -{ - local $Test::Builder::Level = $Test::Builder::Level + 1; - my ($cmd, $expected_stderr, $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 not 0"); - like($stderr, $expected_stderr, "$test_name: matches"); - return; -} - -# 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 -{ - local $Test::Builder::Level = $Test::Builder::Level + 1; - - my ($cmd, $expected_ret, $out, $err, $test_name) = @_; - - # run command - my ($stdout, $stderr); - print("# Running: " . join(" ", @{$cmd}) . "\n"); - IPC::Run::run($cmd, '>', \$stdout, '2>', \$stderr); - - # See http://perldoc.perl.org/perlvar.html#%24CHILD_ERROR - my $ret = $?; - die "command exited with signal " . ($ret & 127) - if $ret & 127; - $ret = $ret >> 8; - - # check status - ok($ret == $expected_ret, - "$test_name status (got $ret vs expected $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/"); - } - - return; -} - -1; +=pod + +=head1 NAME + +TestLib - class containing routines for environment setup, low-level routines for command execution, logging and test functions + +=head1 SYNOPSIS + + use TestLib; + + #Checks if all the tests passed or not + all_tests_passing() + + #Creates a temporary directory + tempdir(prefix) + + #Creates a temporary directory outside the build tree for the Unix-domain socket + tempdir_short() + + #Returns the real directory for a virtual path directory under msys + real_dir(dir) + + #Runs the input command and returns its exit status + system_log() + + #Runs the input command. On failure terminates the execution of other tests + system_or_bail() + + #Runs the input command. Returns both the stdout and stderr + run_log() + + #Returns the output after running a command + run_command(dir) + + #Generate a string made of the given range of ASCII characters + generate_ascii_string(from_char, to_char) + + #Returns the contents of a directory + slurp_dir(dir) + + #Returns the contents of a file + slurp_file(filename) + + #Appends a string at the end of a given file + append_to_file(filename, str) + + #Check that all file/dir modes in a directory match the expected values + check_mode_recursive(dir, expected_dir_mode, expected_file_mode, ignore_list) + + #Change mode recursively on a directory + chmod_recursive(dir, dir_mode, file_mode) + + #Check presence of a given regexp within pg_config.h + check_pg_config(regexp) + + #Test function to check that the command runs successfully + command_ok(cmd, test_name) + + #Test function to check that the command fails + command_fails(cmd, test_name) + + #Test function to check that the command exit code matches with the expected exit code + command_exit_is(cmd, expected, test_name) + + #Test function to check that the command supports --help option + program_help_ok(cmd) + + #Test function to check that the command supports --version option + program_version_ok(cmd) + + #Test function to check that a command with invalid option returns non-zero exit code and error message + program_options_handling_ok(cmd) + + #Test function to check that the command runs successfully and the output + matches with the given regular expression + command_like(cmd, expected_stdout, test_name) + + #Test function to check that the command runs successfully and the output + matches with the given regular expression + command_like_safe(cmd, expected_stdout, test_name) + + #Test function to check that the command fails and the error message + matches with the given regular expression + command_fails_like(cmd, expected_stderr, test_name) + + #Test function to run a command and check its status and outputs + command_checks_all(cmd, expected_ret, out, err, test_name) + + +=head1 DESCRIPTION + +Testlib module contains a set of routines dedicated to environment setup for +a PostgreSQL regression test run 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. + +The IPC::Run module is required. + +=cut + +package TestLib; + +use strict; +use warnings; + +use Config; +use Cwd; +use Exporter 'import'; +use Fcntl qw(:mode); +use File::Basename; +use File::Find; +use File::Spec; +use File::stat qw(stat); +use File::Temp (); +use IPC::Run; +use SimpleTee; + +# specify a recent enough version of Test::More to support the done_testing() function +use Test::More 0.87; + +our @EXPORT = qw( + generate_ascii_string + slurp_dir + slurp_file + append_to_file + check_mode_recursive + chmod_recursive + check_pg_config + system_or_bail + system_log + run_log + run_command + + command_ok + command_fails + command_exit_is + program_help_ok + program_version_ok + program_options_handling_ok + command_like + command_like_safe + command_fails_like + command_checks_all + + $windows_os +); + +our ($windows_os, $tmp_check, $log_path, $test_logfile); + +BEGIN +{ + + # 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}; + delete $ENV{PG_COLOR}; + + $ENV{PGAPPNAME} = basename($0); + + # Must be set early + $windows_os = $Config{osname} eq 'MSWin32' || $Config{osname} eq 'msys'; +} + +INIT +{ + + # Return EPIPE instead of killing the process with SIGPIPE. An affected + # test may still fail, but it's more likely to report useful facts. + $SIG{PIPE} = 'IGNORE'; + + # 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 my $testlog, '>', $test_logfile + or die "could not open STDOUT to logfile \"$test_logfile\": $!"; + + # Hijack STDOUT and STDERR to the log file + open(my $orig_stdout, '>&', \*STDOUT); + open(my $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; +} + +END +{ + + # Preserve temporary directory for this test on failure + $File::Temp::KEEP_ALL = 1 unless all_tests_passing(); +} + + +=pod + +=head1 METHODS + +=over + +=item all_tests_passing() + +Returns 1 if all the tests pass. Otherwise returns 0 + +=cut + +sub all_tests_passing +{ + my $fail_count = 0; + foreach my $status (Test::More->builder->summary) + { + return 0 unless $status; + } + return 1; +} + +=pod + +=item tempdir(prefix) + +Creates a temporary directory with name prefix_XXXX if prefix argument is passed. Otherwise a temporary directory with name tmp_test_XXXX is created. +XXXX represents four random characters.Temporary directory is created inside the folder represented by $tmp_check and it is deleted at the end of the tests. + +=cut + +sub tempdir +{ + my ($prefix) = @_; + $prefix = "tmp_test" unless defined $prefix; + return File::Temp::tempdir( + $prefix . '_XXXX', + DIR => $tmp_check, + CLEANUP => 1); +} + + +=pod + +=item tempdir_short() + +Use a separate temp dir outside the build tree for the +Unix-domain socket, to avoid file name length issues. + +=cut + +sub tempdir_short +{ + + return File::Temp::tempdir(CLEANUP => 1); +} + +=pod + +=item real_dir(dir) + +Return the real directory for a virtual path directory under msys. +The directory must exist. If it's not an existing directory or we're +not under msys, return the input argument unchanged. + +=cut + +sub real_dir +{ + my $dir = "$_[0]"; + return $dir unless -d $dir; + return $dir unless $Config{osname} eq 'msys'; + my $here = cwd; + chdir $dir; + + # this odd way of calling 'pwd -W' is the only way that seems to work. + $dir = qx{sh -c "pwd -W"}; + chomp $dir; + chdir $here; + return $dir; +} + +=pod + +=item system_log() + +Runs the input command and returns its exit status + +=cut + +sub system_log +{ + print("# Running: " . join(" ", @_) . "\n"); + return system(@_); +} + +=pod + +=item system_or_bail() + +Runs the input command. On failure terminates the execution of other tests + +=cut + +sub system_or_bail +{ + if (system_log(@_) != 0) + { + BAIL_OUT("system $_[0] failed"); + } + return; +} + +=pod + +=item run_log() + +Returns the output after running a command + +=cut + +sub run_log +{ + print("# Running: " . join(" ", @{ $_[0] }) . "\n"); + return IPC::Run::run(@_); +} + +=pod + +=item run_command(cmd) + +Returns the output after running the command + +=cut + +sub run_command +{ + my ($cmd) = @_; + my ($stdout, $stderr); + my $result = IPC::Run::run $cmd, '>', \$stdout, '2>', \$stderr; + chomp($stdout); + chomp($stderr); + return ($stdout, $stderr); +} + +=pod + +=item generate_ascii_string(from_char, to_char) + +Generate a string made of the given range of ASCII characters + +=cut + +sub generate_ascii_string +{ + my ($from_char, $to_char) = @_; + my $res; + + for my $i ($from_char .. $to_char) + { + $res .= sprintf("%c", $i); + } + return $res; +} + +=pod + +=item slurp_dir(dir) + +Returns the contents of a directory + +=cut + +sub slurp_dir +{ + my ($dir) = @_; + opendir(my $dh, $dir) + or die "could not opendir \"$dir\": $!"; + my @direntries = readdir $dh; + closedir $dh; + return @direntries; +} + +=pod + +=item slurp_file(filename) + +Returns the contents of a file + +=cut + +sub slurp_file +{ + my ($filename) = @_; + local $/; + open(my $in, '<', $filename) + or die "could not read \"$filename\": $!"; + my $contents = <$in>; + close $in; + $contents =~ s/\r//g if $Config{osname} eq 'msys'; + return $contents; +} + +=pod + +=item append_to_file(filename, str) + +Append a string at the end of a given file + +=cut + + +sub append_to_file +{ + my ($filename, $str) = @_; + open my $fh, ">>", $filename + or die "could not write \"$filename\": $!"; + print $fh $str; + close $fh; + return; +} + + +=pod + +=item check_mode_recursive(dir, expected_dir_mode, expected_file_mode, ignore_list) + +Check that all file/dir modes in a directory match the expected values, +ignoring the mode of any specified files. + +=cut + +sub check_mode_recursive +{ + my ($dir, $expected_dir_mode, $expected_file_mode, $ignore_list) = @_; + + # Result defaults to true + my $result = 1; + + find( + { + follow_fast => 1, + wanted => sub { + # Is file in the ignore list? + foreach my $ignore ($ignore_list ? @{$ignore_list} : []) + { + if ("$dir/$ignore" eq $File::Find::name) + { + return; + } + } + + # Allow ENOENT. A running server can delete files, such as + # those in pg_stat. Other stat() failures are fatal. + my $file_stat = stat($File::Find::name); + unless (defined($file_stat)) + { + my $is_ENOENT = $!{ENOENT}; + my $msg = "unable to stat $File::Find::name: $!"; + if ($is_ENOENT) + { + warn $msg; + return; + } + else + { + die $msg; + } + } + + my $file_mode = S_IMODE($file_stat->mode); + + # Is this a file? + if (S_ISREG($file_stat->mode)) + { + if ($file_mode != $expected_file_mode) + { + print( + *STDERR, + sprintf("$File::Find::name mode must be %04o\n", + $expected_file_mode)); + + $result = 0; + return; + } + } + + # Else a directory? + elsif (S_ISDIR($file_stat->mode)) + { + if ($file_mode != $expected_dir_mode) + { + print( + *STDERR, + sprintf("$File::Find::name mode must be %04o\n", + $expected_dir_mode)); + + $result = 0; + return; + } + } + + # Else something we can't handle + else + { + die "unknown file type for $File::Find::name"; + } + } + }, + $dir); + + return $result; +} + +=pod + +=item chmod_recursive(dir, dir_mode, file_mode) + +Change mode recursively on a directory + +=cut + +sub chmod_recursive +{ + my ($dir, $dir_mode, $file_mode) = @_; + + find( + { + follow_fast => 1, + wanted => sub { + my $file_stat = stat($File::Find::name); + + if (defined($file_stat)) + { + chmod( + S_ISDIR($file_stat->mode) ? $dir_mode : $file_mode, + $File::Find::name + ) or die "unable to chmod $File::Find::name"; + } + } + }, + $dir); + return; +} + + +=pod + +=item check_pg_config(regexp) + +Check presence of a given regexp within pg_config.h for the installation +where tests are running, returning a match status result depending on +that. + +=cut + +sub check_pg_config +{ + my ($regexp) = @_; + my ($stdout, $stderr); + my $result = IPC::Run::run [ 'pg_config', '--includedir' ], '>', + \$stdout, '2>', \$stderr + or die "could not execute pg_config"; + chomp($stdout); + + open my $pg_config_h, '<', "$stdout/pg_config.h" or die "$!"; + my $match = (grep { /^$regexp/ } <$pg_config_h>); + close $pg_config_h; + return $match; +} + + +=pod + +=item command_ok(cmd, test_name) + +Test function to check that the command runs successfully + +=cut + +sub command_ok +{ + local $Test::Builder::Level = $Test::Builder::Level + 1; + my ($cmd, $test_name) = @_; + my $result = run_log($cmd); + ok($result, $test_name); + return; +} + +=pod + +=item command_fails(cmd, test_name) + +Test function to check that the command fails + +=cut + +sub command_fails +{ + local $Test::Builder::Level = $Test::Builder::Level + 1; + my ($cmd, $test_name) = @_; + my $result = run_log($cmd); + ok(!$result, $test_name); + return; +} + +=pod + +=item command_exit_is(cmd, expected, test_name) + +Test function to check that the command exit code matches with the expected exit code. + +=cut + +sub command_exit_is +{ + local $Test::Builder::Level = $Test::Builder::Level + 1; + my ($cmd, $expected, $test_name) = @_; + 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 + # process's exit code, while on Unix, it's returned in the high bits + # of the exit code (see WEXITSTATUS macro in the standard + # header file). IPC::Run's result function always returns exit code >> 8, + # 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); + is($result, $expected, $test_name); + return; +} + +=pod + +=item program_help_ok(cmd) + +Test function to check that the command supports --help option. + +=cut + +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"); + return; +} + +=pod + +=item program_version_ok(cmd) + +Test function to check that the command supports --version option. + +=cut + +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"); + return; +} + +=pod + +=item program_options_handling_ok(cmd) + +Test function to check that a command with invalid option returns non-zero exit code and error message. + +=cut + +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"); + return; +} + +=pod + +=item command_like(cmd, expected_stdout, test_name) + +Test function to check that the command runs successfully and the output matches with the given regular expression. + +=cut + +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"); + return; +} + +=pod + +=item command_like_safe(cmd, expected_stdout, test_name) + +Test function to check that the command runs successfully and the output matches with the given regular expression. + + +=cut + +sub command_like_safe +{ + local $Test::Builder::Level = $Test::Builder::Level + 1; + + # Doesn't rely on detecting end of file on the file descriptors, + # which can fail, causing the process to hang, notably on Msys + # when used with 'pg_ctl start' + my ($cmd, $expected_stdout, $test_name) = @_; + my ($stdout, $stderr); + my $stdoutfile = File::Temp->new(); + my $stderrfile = File::Temp->new(); + print("# Running: " . join(" ", @{$cmd}) . "\n"); + my $result = IPC::Run::run $cmd, '>', $stdoutfile, '2>', $stderrfile; + $stdout = slurp_file($stdoutfile); + $stderr = slurp_file($stderrfile); + ok($result, "$test_name: exit code 0"); + is($stderr, '', "$test_name: no stderr"); + like($stdout, $expected_stdout, "$test_name: matches"); + return; +} + +=pod + +=item command_fails_like(cmd, expected_stderr, test_name) + +Test function to check that the command fails and the error message matches with the given regular expression. + +=cut + +sub command_fails_like +{ + local $Test::Builder::Level = $Test::Builder::Level + 1; + my ($cmd, $expected_stderr, $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 not 0"); + like($stderr, $expected_stderr, "$test_name: matches"); + return; +} + + +=pod + +=item command_checks_all(cmd, expected_ret, out, err, test_name) + +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 + +=cut + +sub command_checks_all +{ + local $Test::Builder::Level = $Test::Builder::Level + 1; + + my ($cmd, $expected_ret, $out, $err, $test_name) = @_; + + # run command + my ($stdout, $stderr); + print("# Running: " . join(" ", @{$cmd}) . "\n"); + IPC::Run::run($cmd, '>', \$stdout, '2>', \$stderr); + + # See http://perldoc.perl.org/perlvar.html#%24CHILD_ERROR + my $ret = $?; + die "command exited with signal " . ($ret & 127) + if $ret & 127; + $ret = $ret >> 8; + + # check status + ok($ret == $expected_ret, + "$test_name status (got $ret vs expected $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/"); + } + + return; +} + +=pod + +=back + +=cut + +1; diff --git a/src/test/perl/TestLib2.pm b/src/test/perl/TestLib2.pm new file mode 100644 index 0000000..3bef7b8 --- /dev/null +++ b/src/test/perl/TestLib2.pm @@ -0,0 +1,874 @@ +=pod + +=head1 NAME + +TestLib - class containing routines for environment setup, low-level routines for command execution, logging and test functions + +=head1 SYNOPSIS + + use TestLib; + + #Checks if all the tests passed or not + all_tests_passing() + + #Creates a temporary directory + tempdir(prefix) + + #Creates a temporary directory outside the build tree for the Unix-domain socket + tempdir_short() + + #Returns the real directory for a virtual path directory under msys + real_dir(dir) + + #Runs the command which is passed as an argument + system_log() + + #Runs the command which is passed as an argument. On failure abandons all other tests + system_or_bail() + + #Runs the command which is passed as an argument. + run_log() + + #Returns the output after running a command + run_command(dir) + + #Generate a string made of the given range of ASCII characters + generate_ascii_string(from_char, to_char) + + #Read the contents of the directory + slurp_dir(dir) + + #Read the contents of the file + slurp_file(filename) + + #Appends a string at the end of a given file + append_to_file(filename, str) + + #Check that all file/dir modes in a directory match the expected values + check_mode_recursive(dir, expected_dir_mode, expected_file_mode, ignore_list) + + #Change mode recursively on a directory + chmod_recursive(dir, dir_mode, file_mode) + + #Check presence of a given regexp within pg_config.h + check_pg_config(regexp) + + #Test function to check that the command runs successfully + command_ok(cmd, test_name) + + #Test function to check that the command fails + command_fails(cmd, test_name) + + #Test function to check that the command exit code matches with the expected exit code + command_exit_is(cmd, expected, test_name) + + #Test function to check that the command supports --help option + program_help_ok(cmd) + + #Test function to check that the command supports --version option + program_version_ok(cmd) + + #Test function to check that a command with invalid option returns non-zero exit code and error message + program_options_handling_ok(cmd) + + #Test function to check that the command runs successfully and the output + matches with the given regular expression + command_like(cmd, expected_stdout, test_name) + + #TODO + command_like_safe(cmd, expected_stdout, test_name) + + #Test function to check that the command fails and the error message + matches with the given regular expression + command_fails_like(cmd, expected_stderr, test_name) + + #Test function to run a command and check its status and outputs + command_checks_all(cmd, expected_ret, out, err, test_name) + + +=head1 DESCRIPTION + +Testlib module contains a set of routines dedicated to environment setup for +a PostgreSQL regression test run 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. + +The IPC::Run module is required. + +=cut + +package TestLib; + +use strict; +use warnings; + +use Config; +use Cwd; +use Exporter 'import'; +use Fcntl qw(:mode); +use File::Basename; +use File::Find; +use File::Spec; +use File::stat qw(stat); +use File::Temp (); +use IPC::Run; +use SimpleTee; + +# specify a recent enough version of Test::More to support the done_testing() function +use Test::More 0.87; + +our @EXPORT = qw( + generate_ascii_string + slurp_dir + slurp_file + append_to_file + check_mode_recursive + chmod_recursive + check_pg_config + system_or_bail + system_log + run_log + run_command + + command_ok + command_fails + command_exit_is + program_help_ok + program_version_ok + program_options_handling_ok + command_like + command_like_safe + command_fails_like + command_checks_all + + $windows_os +); + +our ($windows_os, $tmp_check, $log_path, $test_logfile); + +BEGIN +{ + + # 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}; + + $ENV{PGAPPNAME} = basename($0); + + # Must be set early + $windows_os = $Config{osname} eq 'MSWin32' || $Config{osname} eq 'msys'; +} + +INIT +{ + + # Return EPIPE instead of killing the process with SIGPIPE. An affected + # test may still fail, but it's more likely to report useful facts. + $SIG{PIPE} = 'IGNORE'; + + # 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 my $testlog, '>', $test_logfile + or die "could not open STDOUT to logfile \"$test_logfile\": $!"; + + # Hijack STDOUT and STDERR to the log file + open(my $orig_stdout, '>&', \*STDOUT); + open(my $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; +} + +END +{ + + # Preserve temporary directory for this test on failure + $File::Temp::KEEP_ALL = 1 unless all_tests_passing(); +} + + +=pod + +=head1 METHODS + +=over + +=item all_tests_passing() + +Returns 1 if all the tests pass. Otherwise returns 0 + +=cut + +sub all_tests_passing +{ + my $fail_count = 0; + foreach my $status (Test::More->builder->summary) + { + return 0 unless $status; + } + return 1; +} + +=pod + +=item tempdir(prefix) + +Creates a temporary directory with name prefix_XXXX if prefix argument is passed. Otherwise a temporary directory with name tmp_test_XXXX is created. +XXXX represents four random characters.Temporary directory is created inside the folder represented by $tmp_check and it is deleted at the end of the tests. + +=cut + +sub tempdir +{ + my ($prefix) = @_; + $prefix = "tmp_test" unless defined $prefix; + return File::Temp::tempdir( + $prefix . '_XXXX', + DIR => $tmp_check, + CLEANUP => 1); +} + + +=pod + +=item tempdir_short() + +Use a separate temp dir outside the build tree for the +Unix-domain socket, to avoid file name length issues. + +=cut + +sub tempdir_short +{ + + return File::Temp::tempdir(CLEANUP => 1); +} + +=pod + +=item real_dir(dir) + +Return the real directory for a virtual path directory under msys. +The directory must exist. If it's not an existing directory or we're +not under msys, return the input argument unchanged. + +=cut + +sub real_dir +{ + my $dir = "$_[0]"; + return $dir unless -d $dir; + return $dir unless $Config{osname} eq 'msys'; + my $here = cwd; + chdir $dir; + + # this odd way of calling 'pwd -W' is the only way that seems to work. + $dir = qx{sh -c "pwd -W"}; + chomp $dir; + chdir $here; + return $dir; +} + +=pod + +=item system_log() + +Runs the command which is passed as argument to the function and returns 0 if successful. Otherwise returns non-zero value. + +=cut + +sub system_log +{ + print("# Running: " . join(" ", @_) . "\n"); + return system(@_); +} + +=pod + +=item system_or_bail() + +Runs the command which is passed as argument to the function. On failure it abandons further tests and exits the program. + +=cut + +sub system_or_bail +{ + if (system_log(@_) != 0) + { + BAIL_OUT("system $_[0] failed"); + } + return; +} + +=pod + +=item run_log() + +Runs the command which is passed as argument to the function + +=cut + +sub run_log +{ + print("# Running: " . join(" ", @{ $_[0] }) . "\n"); + return IPC::Run::run(@_); +} + +=pod + +=item run_command(cmd) + +Returns the output after running the command + +=cut + +sub run_command +{ + my ($cmd) = @_; + my ($stdout, $stderr); + my $result = IPC::Run::run $cmd, '>', \$stdout, '2>', \$stderr; + chomp($stdout); + chomp($stderr); + return ($stdout, $stderr); +} + +=pod + +=item generate_ascii_string(from_char, to_char) + +Generate a string made of the given range of ASCII characters + +=cut + +sub generate_ascii_string +{ + my ($from_char, $to_char) = @_; + my $res; + + for my $i ($from_char .. $to_char) + { + $res .= sprintf("%c", $i); + } + return $res; +} + +=pod + +=item slurp_dir(dir) + +Opens the directory provided as an argument to the function. + +If the opendir function returns false, the error message is printed to STDERR and comes out of the program. + +If the directory is opened successfully, the readdir returns the next directory entry for a directory +opened by opendir. + +=cut + +sub slurp_dir +{ + my ($dir) = @_; + opendir(my $dh, $dir) + or die "could not opendir \"$dir\": $!"; + my @direntries = readdir $dh; + closedir $dh; + return @direntries; +} + +=pod + +=item slurp_file(filename) + +Opens the file provided as an argument to the function in read mode(as indicated by <). + +If the open function returns 0, the error message is printed to STDERR and comes out of the program. + +If the file is opened successfully, the contents are read using the filehandle and the file is closed. + +=cut + +sub slurp_file +{ + my ($filename) = @_; + local $/; + open(my $in, '<', $filename) + or die "could not read \"$filename\": $!"; + my $contents = <$in>; + close $in; + $contents =~ s/\r//g if $Config{osname} eq 'msys'; + return $contents; +} + +=pod + +=item append_to_file(filename, str) + +Append a string at the end of a given file + +=cut + + +sub append_to_file +{ + my ($filename, $str) = @_; + open my $fh, ">>", $filename + or die "could not write \"$filename\": $!"; + print $fh $str; + close $fh; + return; +} + + +=pod + +=item check_mode_recursive(dir, expected_dir_mode, expected_file_mode, ignore_list) + +Check that all file/dir modes in a directory match the expected values, +ignoring the mode of any specified files. + +=cut + +sub check_mode_recursive +{ + my ($dir, $expected_dir_mode, $expected_file_mode, $ignore_list) = @_; + + # Result defaults to true + my $result = 1; + + find( + { + follow_fast => 1, + wanted => sub { + # Is file in the ignore list? + foreach my $ignore ($ignore_list ? @{$ignore_list} : []) + { + if ("$dir/$ignore" eq $File::Find::name) + { + return; + } + } + + # Allow ENOENT. A running server can delete files, such as + # those in pg_stat. Other stat() failures are fatal. + my $file_stat = stat($File::Find::name); + unless (defined($file_stat)) + { + my $is_ENOENT = $!{ENOENT}; + my $msg = "unable to stat $File::Find::name: $!"; + if ($is_ENOENT) + { + warn $msg; + return; + } + else + { + die $msg; + } + } + + my $file_mode = S_IMODE($file_stat->mode); + + # Is this a file? + if (S_ISREG($file_stat->mode)) + { + if ($file_mode != $expected_file_mode) + { + print( + *STDERR, + sprintf("$File::Find::name mode must be %04o\n", + $expected_file_mode)); + + $result = 0; + return; + } + } + + # Else a directory? + elsif (S_ISDIR($file_stat->mode)) + { + if ($file_mode != $expected_dir_mode) + { + print( + *STDERR, + sprintf("$File::Find::name mode must be %04o\n", + $expected_dir_mode)); + + $result = 0; + return; + } + } + + # Else something we can't handle + else + { + die "unknown file type for $File::Find::name"; + } + } + }, + $dir); + + return $result; +} + +=pod + +=item chmod_recursive(dir, dir_mode, file_mode) + +Change mode recursively on a directory + +=cut + +sub chmod_recursive +{ + my ($dir, $dir_mode, $file_mode) = @_; + + find( + { + follow_fast => 1, + wanted => sub { + my $file_stat = stat($File::Find::name); + + if (defined($file_stat)) + { + chmod( + S_ISDIR($file_stat->mode) ? $dir_mode : $file_mode, + $File::Find::name + ) or die "unable to chmod $File::Find::name"; + } + } + }, + $dir); + return; +} + + +=pod + +=item check_pg_config(regexp) + +Check presence of a given regexp within pg_config.h for the installation +where tests are running, returning a match status result depending on +that. + +=cut + +sub check_pg_config +{ + my ($regexp) = @_; + my ($stdout, $stderr); + my $result = IPC::Run::run [ 'pg_config', '--includedir' ], '>', + \$stdout, '2>', \$stderr + or die "could not execute pg_config"; + chomp($stdout); + + open my $pg_config_h, '<', "$stdout/pg_config.h" or die "$!"; + my $match = (grep { /^$regexp/ } <$pg_config_h>); + close $pg_config_h; + return $match; +} + + +=pod + +=item command_ok(cmd, test_name) + +Test function to check that the command runs successfully + +=cut + +sub command_ok +{ + local $Test::Builder::Level = $Test::Builder::Level + 1; + my ($cmd, $test_name) = @_; + my $result = run_log($cmd); + ok($result, $test_name); + return; +} + +=pod + +=item command_fails(cmd, test_name) + +Test function to check that the command fails + +=cut + +sub command_fails +{ + local $Test::Builder::Level = $Test::Builder::Level + 1; + my ($cmd, $test_name) = @_; + my $result = run_log($cmd); + ok(!$result, $test_name); + return; +} + +=pod + +=item command_exit_is(cmd, expected, test_name) + +Test function to check that the command exit code matches with the expected exit code. + +=cut + +sub command_exit_is +{ + local $Test::Builder::Level = $Test::Builder::Level + 1; + my ($cmd, $expected, $test_name) = @_; + 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 + # process's exit code, while on Unix, it's returned in the high bits + # of the exit code (see WEXITSTATUS macro in the standard + # header file). IPC::Run's result function always returns exit code >> 8, + # 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); + is($result, $expected, $test_name); + return; +} + +=pod + +=item program_help_ok(cmd) + +Test function to check that the command supports --help option. + +=cut + +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"); + return; +} + +=pod + +=item program_version_ok(cmd) + +Test function to check that the command supports --version option. + +=cut + +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"); + return; +} + +=pod + +=item program_options_handling_ok(cmd) + +Test function to check that a command with invalid option returns non-zero exit code and error message. + +=cut + +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"); + return; +} + +=pod + +=item command_like(cmd, expected_stdout, test_name) + +Test function to check that the command runs successfully and the output matches with the given regular expression. + +=cut + +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"); + return; +} + +=pod + +=item command_like_safe(cmd, expected_stdout, test_name) + +TODO + +=cut + +sub command_like_safe +{ + local $Test::Builder::Level = $Test::Builder::Level + 1; + + # Doesn't rely on detecting end of file on the file descriptors, + # which can fail, causing the process to hang, notably on Msys + # when used with 'pg_ctl start' + my ($cmd, $expected_stdout, $test_name) = @_; + my ($stdout, $stderr); + my $stdoutfile = File::Temp->new(); + my $stderrfile = File::Temp->new(); + print("# Running: " . join(" ", @{$cmd}) . "\n"); + my $result = IPC::Run::run $cmd, '>', $stdoutfile, '2>', $stderrfile; + $stdout = slurp_file($stdoutfile); + $stderr = slurp_file($stderrfile); + ok($result, "$test_name: exit code 0"); + is($stderr, '', "$test_name: no stderr"); + like($stdout, $expected_stdout, "$test_name: matches"); + return; +} + +=pod + +=item command_fails_like(cmd, expected_stderr, test_name) + +Test function to check that the command fails and the error message matches with the given regular expression. + +=cut + +sub command_fails_like +{ + local $Test::Builder::Level = $Test::Builder::Level + 1; + my ($cmd, $expected_stderr, $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 not 0"); + like($stderr, $expected_stderr, "$test_name: matches"); + return; +} + + +=pod + +=item command_checks_all(cmd, expected_ret, out, err, test_name) + +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 + +=cut + +sub command_checks_all +{ + local $Test::Builder::Level = $Test::Builder::Level + 1; + + my ($cmd, $expected_ret, $out, $err, $test_name) = @_; + + # run command + my ($stdout, $stderr); + print("# Running: " . join(" ", @{$cmd}) . "\n"); + IPC::Run::run($cmd, '>', \$stdout, '2>', \$stderr); + + # See http://perldoc.perl.org/perlvar.html#%24CHILD_ERROR + my $ret = $?; + die "command exited with signal " . ($ret & 127) + if $ret & 127; + $ret = $ret >> 8; + + # check status + ok($ret == $expected_ret, + "$test_name status (got $ret vs expected $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/"); + } + + return; +} + +=pod + +=back + +=cut + +1; diff --git a/src/test/perl/v1_perldoc_testlib.patch b/src/test/perl/v1_perldoc_testlib.patch new file mode 100644 index 0000000..a1ccf11 --- /dev/null +++ b/src/test/perl/v1_perldoc_testlib.patch @@ -0,0 +1,550 @@ +diff --git a/src/test/perl/TestLib.pm b/src/test/perl/TestLib.pm +index ce59401..61018f1 100644 +--- a/src/test/perl/TestLib.pm ++++ b/src/test/perl/TestLib.pm +@@ -1,9 +1,101 @@ +-# TestLib, low-level routines and actions regression tests. +-# +-# This module contains a set of routines dedicated to environment setup for +-# a PostgreSQL regression test run 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. ++=pod ++ ++=head1 NAME ++ ++TestLib - class containing routines for environment setup, low-level routines for command execution, logging and test functions ++ ++=head1 SYNOPSIS ++ ++ use TestLib; ++ ++ #Checks if all the tests passed or not ++ all_tests_passing() ++ ++ #Creates a temporary directory ++ tempdir(prefix) ++ ++ #Creates a temporary directory outside the build tree for the Unix-domain socket ++ tempdir_short() ++ ++ #Returns the real directory for a virtual path directory under msys ++ real_dir(dir) ++ ++ #TODO ++ system_log() ++ ++ #TODO ++ system_or_bail() ++ ++ #TODO ++ run_log() ++ ++ #Returns the output after running a command ++ run_command(dir) ++ ++ #Generate a string made of the given range of ASCII characters ++ generate_ascii_string(from_char, to_char) ++ ++ #TODO ++ slurp_dir(dir) ++ ++ #TODO ++ slurp_file(filename) ++ ++ #Appends a string at the end of a given file ++ append_to_file(filename, str) ++ ++ #Check that all file/dir modes in a directory match the expected values ++ check_mode_recursive(dir, expected_dir_mode, expected_file_mode, ignore_list) ++ ++ #Change mode recursively on a directory ++ chmod_recursive(dir, dir_mode, file_mode) ++ ++ #Check presence of a given regexp within pg_config.h ++ check_pg_config(regexp) ++ ++ #Test function to check that the command runs successfully ++ command_ok(cmd, test_name) ++ ++ #Test function to check that the command fails ++ command_fails(cmd, test_name) ++ ++ #Test function to check that the command exit code matches with the expected exit code ++ command_exit_is(cmd, expected, test_name) ++ ++ #Test function to check that the command supports --help option ++ program_help_ok(cmd) ++ ++ #Test function to check that the command supports --version option ++ program_version_ok(cmd) ++ ++ #Test function to check that a command with invalid option returns non-zero exit code and error message ++ program_options_handling_ok(cmd) ++ ++ #Test function to check that the command runs successfully and the output ++ matches with the given regular expression ++ command_like(cmd, expected_stdout, test_name) ++ ++ #TODO ++ command_like_safe(cmd, expected_stdout, test_name) ++ ++ #Test function to check that the command fails and the error message ++ matches with the given regular expression ++ command_fails_like(cmd, expected_stderr, test_name) ++ ++ #Test function to run a command and check its status and outputs ++ command_checks_all(cmd, expected_ret, out, err, test_name) ++ ++ ++=head1 DESCRIPTION ++ ++Testlib module contains a set of routines dedicated to environment setup for ++a PostgreSQL regression test run 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. ++ ++The IPC::Run module is required. ++ ++=cut + + package TestLib; + +@@ -134,6 +226,19 @@ END + $File::Temp::KEEP_ALL = 1 unless all_tests_passing(); + } + ++ ++=pod ++ ++=head1 METHODS ++ ++=over ++ ++=item all_tests_passing() ++ ++Returns 1 if all the tests pass. Otherwise returns 0 ++ ++=cut ++ + sub all_tests_passing + { + my $fail_count = 0; +@@ -144,9 +249,15 @@ sub all_tests_passing + return 1; + } + +-# +-# Helper functions +-# ++=pod ++ ++=item tempdir(prefix) ++ ++Creates a temporary directory with name prefix_XXXX if prefix argument is passed. Otherwise a temporary directory with name tmp_test_XXXX is created. ++XXXX represents four random characters.Temporary directory is created inside the folder represented by $tmp_check and it is deleted at the end of the tests. ++ ++=cut ++ + sub tempdir + { + my ($prefix) = @_; +@@ -157,17 +268,32 @@ sub tempdir + CLEANUP => 1); + } + ++ ++=pod ++ ++=item tempdir_short() ++ ++Use a separate temp dir outside the build tree for the ++Unix-domain socket, to avoid file name length issues. ++ ++=cut ++ + sub tempdir_short + { + +- # Use a separate temp dir outside the build tree for the +- # Unix-domain socket, to avoid file name length issues. + return File::Temp::tempdir(CLEANUP => 1); + } + +-# Return the real directory for a virtual path directory under msys. +-# The directory must exist. If it's not an existing directory or we're +-# not under msys, return the input argument unchanged. ++=pod ++ ++=item real_dir(dir) ++ ++Return the real directory for a virtual path directory under msys. ++The directory must exist. If it's not an existing directory or we're ++not under msys, return the input argument unchanged. ++ ++=cut ++ + sub real_dir + { + my $dir = "$_[0]"; +@@ -183,12 +309,28 @@ sub real_dir + return $dir; + } + ++=pod ++ ++=item system_log() ++ ++TODO ++ ++=cut ++ + sub system_log + { + print("# Running: " . join(" ", @_) . "\n"); + return system(@_); + } + ++=pod ++ ++=item system_or_bail() ++ ++TODO ++ ++=cut ++ + sub system_or_bail + { + if (system_log(@_) != 0) +@@ -198,12 +340,28 @@ sub system_or_bail + return; + } + ++=pod ++ ++=item run_log() ++ ++TODO ++ ++=cut ++ + sub run_log + { + print("# Running: " . join(" ", @{ $_[0] }) . "\n"); + return IPC::Run::run(@_); + } + ++=pod ++ ++=item run_command(cmd) ++ ++Returns the output after running the command ++ ++=cut ++ + sub run_command + { + my ($cmd) = @_; +@@ -214,7 +372,14 @@ sub run_command + return ($stdout, $stderr); + } + +-# Generate a string made of the given range of ASCII characters ++=pod ++ ++=item generate_ascii_string(from_char, to_char) ++ ++Generate a string made of the given range of ASCII characters ++ ++=cut ++ + sub generate_ascii_string + { + my ($from_char, $to_char) = @_; +@@ -227,6 +392,14 @@ sub generate_ascii_string + return $res; + } + ++=pod ++ ++=item slurp_dir(dir) ++ ++TODO ++ ++=cut ++ + sub slurp_dir + { + my ($dir) = @_; +@@ -237,6 +410,14 @@ sub slurp_dir + return @direntries; + } + ++=pod ++ ++=item slurp_file(filename) ++ ++TODO ++ ++=cut ++ + sub slurp_file + { + my ($filename) = @_; +@@ -249,6 +430,15 @@ sub slurp_file + return $contents; + } + ++=pod ++ ++=item append_to_file(filename, str) ++ ++Append a string at the end of a given file ++ ++=cut ++ ++ + sub append_to_file + { + my ($filename, $str) = @_; +@@ -259,8 +449,16 @@ sub append_to_file + return; + } + +-# Check that all file/dir modes in a directory match the expected values, +-# ignoring the mode of any specified files. ++ ++=pod ++ ++=item check_mode_recursive(dir, expected_dir_mode, expected_file_mode, ignore_list) ++ ++Check that all file/dir modes in a directory match the expected values, ++ignoring the mode of any specified files. ++ ++=cut ++ + sub check_mode_recursive + { + my ($dir, $expected_dir_mode, $expected_file_mode, $ignore_list) = @_; +@@ -343,7 +541,14 @@ sub check_mode_recursive + return $result; + } + +-# Change mode recursively on a directory ++=pod ++ ++=item chmod_recursive(dir, dir_mode, file_mode) ++ ++Change mode recursively on a directory ++ ++=cut ++ + sub chmod_recursive + { + my ($dir, $dir_mode, $file_mode) = @_; +@@ -367,9 +572,17 @@ sub chmod_recursive + return; + } + +-# Check presence of a given regexp within pg_config.h for the installation +-# where tests are running, returning a match status result depending on +-# that. ++ ++=pod ++ ++=item check_pg_config(regexp) ++ ++Check presence of a given regexp within pg_config.h for the installation ++where tests are running, returning a match status result depending on ++that. ++ ++=cut ++ + sub check_pg_config + { + my ($regexp) = @_; +@@ -385,9 +598,15 @@ sub check_pg_config + return $match; + } + +-# +-# Test functions +-# ++ ++=pod ++ ++=item command_ok(cmd, test_name) ++ ++Test function to check that the command runs successfully ++ ++=cut ++ + sub command_ok + { + local $Test::Builder::Level = $Test::Builder::Level + 1; +@@ -397,6 +616,14 @@ sub command_ok + return; + } + ++=pod ++ ++=item command_fails(cmd, test_name) ++ ++Test function to check that the command fails ++ ++=cut ++ + sub command_fails + { + local $Test::Builder::Level = $Test::Builder::Level + 1; +@@ -406,6 +633,14 @@ sub command_fails + return; + } + ++=pod ++ ++=item command_exit_is(cmd, expected, test_name) ++ ++Test function to check that the command exit code matches with the expected exit code. ++ ++=cut ++ + sub command_exit_is + { + local $Test::Builder::Level = $Test::Builder::Level + 1; +@@ -429,6 +664,14 @@ sub command_exit_is + return; + } + ++=pod ++ ++=item program_help_ok(cmd) ++ ++Test function to check that the command supports --help option. ++ ++=cut ++ + sub program_help_ok + { + local $Test::Builder::Level = $Test::Builder::Level + 1; +@@ -443,6 +686,14 @@ sub program_help_ok + return; + } + ++=pod ++ ++=item program_version_ok(cmd) ++ ++Test function to check that the command supports --version option. ++ ++=cut ++ + sub program_version_ok + { + local $Test::Builder::Level = $Test::Builder::Level + 1; +@@ -457,6 +708,14 @@ sub program_version_ok + return; + } + ++=pod ++ ++=item program_options_handling_ok(cmd) ++ ++Test function to check that a command with invalid option returns non-zero exit code and error message. ++ ++=cut ++ + sub program_options_handling_ok + { + local $Test::Builder::Level = $Test::Builder::Level + 1; +@@ -471,6 +730,14 @@ sub program_options_handling_ok + return; + } + ++=pod ++ ++=item command_like(cmd, expected_stdout, test_name) ++ ++Test function to check that the command runs successfully and the output matches with the given regular expression. ++ ++=cut ++ + sub command_like + { + local $Test::Builder::Level = $Test::Builder::Level + 1; +@@ -484,6 +751,15 @@ sub command_like + return; + } + ++=pod ++ ++=item command_like_safe(cmd, expected_stdout, test_name) ++ ++TODO ++ ++ ++=cut ++ + sub command_like_safe + { + local $Test::Builder::Level = $Test::Builder::Level + 1; +@@ -505,6 +781,14 @@ sub command_like_safe + return; + } + ++=pod ++ ++=item command_fails_like(cmd, expected_stderr, test_name) ++ ++Test function to check that the command fails and the error message matches with the given regular expression. ++ ++=cut ++ + sub command_fails_like + { + local $Test::Builder::Level = $Test::Builder::Level + 1; +@@ -517,13 +801,26 @@ sub command_fails_like + return; + } + +-# 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 ++ ++=pod ++ ++=item command_checks_all(cmd, expected_ret, out, err, test_name) ++ ++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 ++ ++=cut ++ + sub command_checks_all + { + local $Test::Builder::Level = $Test::Builder::Level + 1; +@@ -560,4 +857,10 @@ sub command_checks_all + return; + } + ++=pod ++ ++=back ++ ++=cut ++ + 1; diff --git a/src/test/perl/v2_perldoc_testlib.patch b/src/test/perl/v2_perldoc_testlib.patch new file mode 100644 index 0000000..3a44de2 --- /dev/null +++ b/src/test/perl/v2_perldoc_testlib.patch @@ -0,0 +1,572 @@ +diff --git a/src/test/perl/TestLib.pm b/src/test/perl/TestLib.pm +index ce59401cef..a352e912ce 100644 +--- a/src/test/perl/TestLib.pm ++++ b/src/test/perl/TestLib.pm +@@ -1,9 +1,102 @@ +-# TestLib, low-level routines and actions regression tests. +-# +-# This module contains a set of routines dedicated to environment setup for +-# a PostgreSQL regression test run 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. ++=pod ++ ++=head1 NAME ++ ++TestLib - class containing routines for environment setup, low-level routines for command execution, logging and test functions ++ ++=head1 SYNOPSIS ++ ++ use TestLib; ++ ++ #Checks if all the tests passed or not ++ all_tests_passing() ++ ++ #Creates a temporary directory ++ tempdir(prefix) ++ ++ #Creates a temporary directory outside the build tree for the Unix-domain socket ++ tempdir_short() ++ ++ #Returns the real directory for a virtual path directory under msys ++ real_dir(dir) ++ ++ #Returns the exit status of the command run using the system function ++ system_log() ++ ++ #Abandons all the remaining tests when a particular system execution fails ++ system_or_bail() ++ ++ #Returns the exit status of the command passed as an argument to the run() function. ++ run_log() ++ ++ #Returns the output after running a command ++ run_command(dir) ++ ++ #Generate a string made of the given range of ASCII characters ++ generate_ascii_string(from_char, to_char) ++ ++ #Read the contents of the directory ++ slurp_dir(dir) ++ ++ #Read the contents of the file ++ slurp_file(filename) ++ ++ #Appends a string at the end of a given file ++ append_to_file(filename, str) ++ ++ #Check that all file/dir modes in a directory match the expected values ++ check_mode_recursive(dir, expected_dir_mode, expected_file_mode, ignore_list) ++ ++ #Change mode recursively on a directory ++ chmod_recursive(dir, dir_mode, file_mode) ++ ++ #Check presence of a given regexp within pg_config.h ++ check_pg_config(regexp) ++ ++ #Test function to check that the command runs successfully ++ command_ok(cmd, test_name) ++ ++ #Test function to check that the command fails ++ command_fails(cmd, test_name) ++ ++ #Test function to check that the command exit code matches with the expected exit code ++ command_exit_is(cmd, expected, test_name) ++ ++ #Test function to check that the command supports --help option ++ program_help_ok(cmd) ++ ++ #Test function to check that the command supports --version option ++ program_version_ok(cmd) ++ ++ #Test function to check that a command with invalid option returns non-zero exit code and error message ++ program_options_handling_ok(cmd) ++ ++ #Test function to check that the command runs successfully and the output ++ matches with the given regular expression ++ command_like(cmd, expected_stdout, test_name) ++ ++ #Test function to check the command's successful execution which is safer option as the output is compared ++ using a temporary file. ++ command_like_safe(cmd, expected_stdout, test_name) ++ ++ #Test function to check that the command fails and the error message ++ matches with the given regular expression ++ command_fails_like(cmd, expected_stderr, test_name) ++ ++ #Test function to run a command and check its status and outputs ++ command_checks_all(cmd, expected_ret, out, err, test_name) ++ ++ ++=head1 DESCRIPTION ++ ++Testlib module contains a set of routines dedicated to environment setup for ++a PostgreSQL regression test run 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. ++ ++The IPC::Run module is required. ++ ++=cut + + package TestLib; + +@@ -134,6 +227,19 @@ END + $File::Temp::KEEP_ALL = 1 unless all_tests_passing(); + } + ++ ++=pod ++ ++=head1 METHODS ++ ++=over ++ ++=item all_tests_passing() ++ ++Returns 1 if all the tests pass. Otherwise returns 0 ++ ++=cut ++ + sub all_tests_passing + { + my $fail_count = 0; +@@ -144,9 +250,15 @@ sub all_tests_passing + return 1; + } + +-# +-# Helper functions +-# ++=pod ++ ++=item tempdir(prefix) ++ ++Creates a temporary directory with name prefix_XXXX if prefix argument is passed. Otherwise a temporary directory with name tmp_test_XXXX is created. ++XXXX represents four random characters.Temporary directory is created inside the folder represented by $tmp_check and it is deleted at the end of the tests. ++ ++=cut ++ + sub tempdir + { + my ($prefix) = @_; +@@ -157,17 +269,32 @@ sub tempdir + CLEANUP => 1); + } + ++ ++=pod ++ ++=item tempdir_short() ++ ++Use a separate temp dir outside the build tree for the ++Unix-domain socket, to avoid file name length issues. ++ ++=cut ++ + sub tempdir_short + { + +- # Use a separate temp dir outside the build tree for the +- # Unix-domain socket, to avoid file name length issues. + return File::Temp::tempdir(CLEANUP => 1); + } + +-# Return the real directory for a virtual path directory under msys. +-# The directory must exist. If it's not an existing directory or we're +-# not under msys, return the input argument unchanged. ++=pod ++ ++=item real_dir(dir) ++ ++Return the real directory for a virtual path directory under msys. ++The directory must exist. If it's not an existing directory or we're ++not under msys, return the input argument unchanged. ++ ++=cut ++ + sub real_dir + { + my $dir = "$_[0]"; +@@ -183,12 +310,32 @@ sub real_dir + return $dir; + } + ++=pod ++ ++=item system_log() ++ ++This function executes the command specified by the first argument,followed by passing ++options/parameters as subsequent arguments to the command. ++ ++The return value is the exit status of the program as returned by the wait function. ++ ++=cut ++ + sub system_log + { + print("# Running: " . join(" ", @_) . "\n"); + return system(@_); + } + ++=pod ++ ++=item system_or_bail() ++ ++If the command execution fails with system_log function returning a non zero exit status, ++the BAIL_OUT function is called which terminates the further tests and exits from the program. ++ ++=cut ++ + sub system_or_bail + { + if (system_log(@_) != 0) +@@ -198,12 +345,31 @@ sub system_or_bail + return; + } + ++=pod ++ ++=item run_log() ++ ++Runs the particular command passed as an argument and returns 0 if the command is executed successfully. ++The return value is opposite to that returned by the system() function. ++ ++Various redirection operators can be used in colloboration with the run function. ++ ++=cut ++ + sub run_log + { + print("# Running: " . join(" ", @{ $_[0] }) . "\n"); + return IPC::Run::run(@_); + } + ++=pod ++ ++=item run_command(cmd) ++ ++Returns the output after running the command ++ ++=cut ++ + sub run_command + { + my ($cmd) = @_; +@@ -214,7 +380,14 @@ sub run_command + return ($stdout, $stderr); + } + +-# Generate a string made of the given range of ASCII characters ++=pod ++ ++=item generate_ascii_string(from_char, to_char) ++ ++Generate a string made of the given range of ASCII characters ++ ++=cut ++ + sub generate_ascii_string + { + my ($from_char, $to_char) = @_; +@@ -227,6 +400,19 @@ sub generate_ascii_string + return $res; + } + ++=pod ++ ++=item slurp_dir(dir) ++ ++Opens the directory provided as an argument to the function. ++ ++If the opendir function returns false, the error message is printed to STDERR and comes out of the program. ++ ++If the directory is opened successfully, the readdir returns the next directory entry for a directory ++opened by opendir. ++ ++=cut ++ + sub slurp_dir + { + my ($dir) = @_; +@@ -237,6 +423,18 @@ sub slurp_dir + return @direntries; + } + ++=pod ++ ++=item slurp_file(filename) ++ ++Opens the file provided as an argument to the function in read mode(as indicated by <). ++ ++If the open function returns 0, the error message is printed to STDERR and comes out of the program. ++ ++If the file is opened successfully, the contents are read using the filehandle and the file is closed. ++ ++=cut ++ + sub slurp_file + { + my ($filename) = @_; +@@ -249,6 +447,15 @@ sub slurp_file + return $contents; + } + ++=pod ++ ++=item append_to_file(filename, str) ++ ++Append a string at the end of a given file ++ ++=cut ++ ++ + sub append_to_file + { + my ($filename, $str) = @_; +@@ -259,8 +466,16 @@ sub append_to_file + return; + } + +-# Check that all file/dir modes in a directory match the expected values, +-# ignoring the mode of any specified files. ++ ++=pod ++ ++=item check_mode_recursive(dir, expected_dir_mode, expected_file_mode, ignore_list) ++ ++Check that all file/dir modes in a directory match the expected values, ++ignoring the mode of any specified files. ++ ++=cut ++ + sub check_mode_recursive + { + my ($dir, $expected_dir_mode, $expected_file_mode, $ignore_list) = @_; +@@ -343,7 +558,14 @@ sub check_mode_recursive + return $result; + } + +-# Change mode recursively on a directory ++=pod ++ ++=item chmod_recursive(dir, dir_mode, file_mode) ++ ++Change mode recursively on a directory ++ ++=cut ++ + sub chmod_recursive + { + my ($dir, $dir_mode, $file_mode) = @_; +@@ -367,9 +589,17 @@ sub chmod_recursive + return; + } + +-# Check presence of a given regexp within pg_config.h for the installation +-# where tests are running, returning a match status result depending on +-# that. ++ ++=pod ++ ++=item check_pg_config(regexp) ++ ++Check presence of a given regexp within pg_config.h for the installation ++where tests are running, returning a match status result depending on ++that. ++ ++=cut ++ + sub check_pg_config + { + my ($regexp) = @_; +@@ -385,9 +615,15 @@ sub check_pg_config + return $match; + } + +-# +-# Test functions +-# ++ ++=pod ++ ++=item command_ok(cmd, test_name) ++ ++Test function to check that the command runs successfully ++ ++=cut ++ + sub command_ok + { + local $Test::Builder::Level = $Test::Builder::Level + 1; +@@ -397,6 +633,14 @@ sub command_ok + return; + } + ++=pod ++ ++=item command_fails(cmd, test_name) ++ ++Test function to check that the command fails ++ ++=cut ++ + sub command_fails + { + local $Test::Builder::Level = $Test::Builder::Level + 1; +@@ -406,6 +650,14 @@ sub command_fails + return; + } + ++=pod ++ ++=item command_exit_is(cmd, expected, test_name) ++ ++Test function to check that the command exit code matches with the expected exit code. ++ ++=cut ++ + sub command_exit_is + { + local $Test::Builder::Level = $Test::Builder::Level + 1; +@@ -429,6 +681,14 @@ sub command_exit_is + return; + } + ++=pod ++ ++=item program_help_ok(cmd) ++ ++Test function to check that the command supports --help option. ++ ++=cut ++ + sub program_help_ok + { + local $Test::Builder::Level = $Test::Builder::Level + 1; +@@ -443,6 +703,14 @@ sub program_help_ok + return; + } + ++=pod ++ ++=item program_version_ok(cmd) ++ ++Test function to check that the command supports --version option. ++ ++=cut ++ + sub program_version_ok + { + local $Test::Builder::Level = $Test::Builder::Level + 1; +@@ -457,6 +725,14 @@ sub program_version_ok + return; + } + ++=pod ++ ++=item program_options_handling_ok(cmd) ++ ++Test function to check that a command with invalid option returns non-zero exit code and error message. ++ ++=cut ++ + sub program_options_handling_ok + { + local $Test::Builder::Level = $Test::Builder::Level + 1; +@@ -471,6 +747,14 @@ sub program_options_handling_ok + return; + } + ++=pod ++ ++=item command_like(cmd, expected_stdout, test_name) ++ ++Test function to check that the command runs successfully and the output matches with the given regular expression. ++ ++=cut ++ + sub command_like + { + local $Test::Builder::Level = $Test::Builder::Level + 1; +@@ -484,6 +768,20 @@ sub command_like + return; + } + ++=pod ++ ++=item command_like_safe(cmd, expected_stdout, test_name) ++ ++Test function to check whether the command runs successfully wherein the output and error log is redirected ++to temporary files instead of variables. The contents of the files are later copied into variables using the ++slurp_file() function. Also checks whether the output of the command matches with the expected output. ++ ++This is a safer option for the command_like() as the output of the command is redirected to a temporary file ++rather than variables wherein the newline characters can be clearly extracted. ++ ++ ++=cut ++ + sub command_like_safe + { + local $Test::Builder::Level = $Test::Builder::Level + 1; +@@ -505,6 +803,14 @@ sub command_like_safe + return; + } + ++=pod ++ ++=item command_fails_like(cmd, expected_stderr, test_name) ++ ++Test function to check that the command fails and the error message matches with the given regular expression. ++ ++=cut ++ + sub command_fails_like + { + local $Test::Builder::Level = $Test::Builder::Level + 1; +@@ -517,13 +823,26 @@ sub command_fails_like + return; + } + +-# 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 ++ ++=pod ++ ++=item command_checks_all(cmd, expected_ret, out, err, test_name) ++ ++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 ++ ++=cut ++ + sub command_checks_all + { + local $Test::Builder::Level = $Test::Builder::Level + 1; +@@ -560,4 +879,10 @@ sub command_checks_all + return; + } + ++=pod ++ ++=back ++ ++=cut ++ + 1;