Commit 6fcc40b1 authored by Alvaro Herrera's avatar Alvaro Herrera

Add POD documentation to TestLib.pm

This module was pretty much undocumented.  Fix that.

Inspired by a preliminary patch sent by Ramanarayana, heavily updated by
Andrew Dunstan, and reviewed by Michael Paquier.

Discussion: https://postgr.es/m/CAF6A77G_WJTwBV9SBxCnQfZB09hm1p1O3stZ6eE5QiYd=X84Jg@mail.gmail.com
parent 7dedfd22
# 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 - helper module for writing PostgreSQL's C<prove> tests.
=head1 SYNOPSIS
use TestLib;
# Test basic output of a command
program_help_ok('initdb');
program_version_ok('initdb');
program_options_handling_ok('initdb');
# Test option combinations
command_fails(['initdb', '--invalid-option'],
'command fails with invalid option');
my $tempdir = TestLib::tempdir;
command_ok('initdb', '-D', $tempdir);
# Miscellanea
print "on Windows" if $TestLib::windows_os;
my $path = TestLib::perl2host($backup_dir);
ok(check_mode_recursive($stream_dir, 0700, 0600),
"check stream dir permissions");
TestLib::system_log('pg_ctl', 'kill', 'QUIT', $slow_pid);
=head1 DESCRIPTION
C<TestLib> 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.
=cut
# This module should never depend on any other PostgreSQL regression test
# modules.
package TestLib;
......@@ -22,7 +54,8 @@ use File::Temp ();
use IPC::Run;
use SimpleTee;
# specify a recent enough version of Test::More to support the done_testing() function
# specify a recent enough version of Test::More to support the
# done_testing() function
use Test::More 0.87;
our @EXPORT = qw(
......@@ -81,6 +114,20 @@ BEGIN
$windows_os = $Config{osname} eq 'MSWin32' || $Config{osname} eq 'msys';
}
=pod
=head1 EXPORTED VARIABLES
=over
=item C<$windows_os>
Set to true when running under Windows, except on Cygwin.
=back
=cut
INIT
{
......@@ -135,9 +182,20 @@ END
$File::Temp::KEEP_ALL = 1 unless all_tests_passing();
}
=pod
=head1 ROUTINES
=over
=item all_tests_passing()
Return 1 if all the tests run so far have passed. Otherwise, return 0.
=cut
sub all_tests_passing
{
my $fail_count = 0;
foreach my $status (Test::More->builder->summary)
{
return 0 unless $status;
......@@ -145,9 +203,19 @@ sub all_tests_passing
return 1;
}
#
# Helper functions
#
=pod
=item tempdir(prefix)
Securely create a temporary directory inside C<$tmp_check>, like C<mkdtemp>,
and return its name. The directory will be removed automatically at the
end of the tests.
If C<prefix> is given, the new directory is templated as C<${prefix}_XXXX>.
Otherwise the template is C<tmp_test_XXXX>.
=cut
sub tempdir
{
my ($prefix) = @_;
......@@ -158,17 +226,31 @@ sub tempdir
CLEANUP => 1);
}
=pod
=item tempdir_short()
As above, but the directory is outside the build tree so that it has a short
name, to avoid path 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);
}
# Translate a Perl file name to a host file name. Currently, this is a no-op
# except for the case of Perl=msys and host=mingw32. The subject need not
# exist, but its parent directory must exist.
=pod
=item perl2host()
Translate a Perl file name to a host file name. Currently, this is a no-op
except for the case of Perl=msys and host=mingw32. The subject need not
exist, but its parent directory must exist.
=cut
sub perl2host
{
my ($subject) = @_;
......@@ -193,12 +275,31 @@ sub perl2host
return $dir . $leaf;
}
=pod
=item system_log(@cmd)
Run (via C<system()>) the command passed as argument; the return
value is passed through.
=cut
sub system_log
{
print("# Running: " . join(" ", @_) . "\n");
return system(@_);
}
=pod
=item system_or_bail(@cmd)
Run (via C<system()>) the command passed as argument, and returns
if the command is successful.
On failure, abandon further tests and exit the program.
=cut
sub system_or_bail
{
if (system_log(@_) != 0)
......@@ -208,12 +309,31 @@ sub system_or_bail
return;
}
=pod
=item run_log(@cmd)
Run the given command via C<IPC::Run::run()>, noting it in the log.
The return value from the command is passed through.
=cut
sub run_log
{
print("# Running: " . join(" ", @{ $_[0] }) . "\n");
return IPC::Run::run(@_);
}
=pod
=item run_command(cmd)
Run (via C<IPC::Run::run()>) the command passed as argument.
The return value from the command is ignored.
The return value is C<($stdout, $stderr)>.
=cut
sub run_command
{
my ($cmd) = @_;
......@@ -224,7 +344,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) = @_;
......@@ -237,6 +364,14 @@ sub generate_ascii_string
return $res;
}
=pod
=item slurp_dir(dir)
Return the complete list of entries in the specified directory.
=cut
sub slurp_dir
{
my ($dir) = @_;
......@@ -247,6 +382,14 @@ sub slurp_dir
return @direntries;
}
=pod
=item slurp_file(filename)
Return the full contents of the specified file.
=cut
sub slurp_file
{
my ($filename) = @_;
......@@ -259,6 +402,15 @@ sub slurp_file
return $contents;
}
=pod
=item append_to_file(filename, str)
Append a string at the end of a given file. (Note: no newline is appended at
end of file.)
=cut
sub append_to_file
{
my ($filename, $str) = @_;
......@@ -269,8 +421,15 @@ 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 files in C<ignore_list> (basename only).
=cut
sub check_mode_recursive
{
my ($dir, $expected_dir_mode, $expected_file_mode, $ignore_list) = @_;
......@@ -353,7 +512,14 @@ sub check_mode_recursive
return $result;
}
# Change mode recursively on a directory
=pod
=item chmod_recursive(dir, dir_mode, file_mode)
C<chmod> recursively each file and directory within the given directory.
=cut
sub chmod_recursive
{
my ($dir, $dir_mode, $file_mode) = @_;
......@@ -377,9 +543,15 @@ 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)
Return the number of matches of the given regular expression
within the installation's C<pg_config.h>.
=cut
sub check_pg_config
{
my ($regexp) = @_;
......@@ -395,9 +567,20 @@ sub check_pg_config
return $match;
}
#
# Test functions
#
=pod
=back
=head1 Test::More-LIKE METHODS
=over
=item command_ok(cmd, test_name)
Check that the command runs (via C<run_log>) successfully.
=cut
sub command_ok
{
local $Test::Builder::Level = $Test::Builder::Level + 1;
......@@ -407,6 +590,14 @@ sub command_ok
return;
}
=pod
=item command_fails(cmd, test_name)
Check that the command fails (when run via C<run_log>).
=cut
sub command_fails
{
local $Test::Builder::Level = $Test::Builder::Level + 1;
......@@ -416,6 +607,14 @@ sub command_fails
return;
}
=pod
=item command_exit_is(cmd, expected, test_name)
Check that the command exit code matches the expected exit code.
=cut
sub command_exit_is
{
local $Test::Builder::Level = $Test::Builder::Level + 1;
......@@ -439,6 +638,14 @@ sub command_exit_is
return;
}
=pod
=item program_help_ok(cmd)
Check that the command supports the C<--help> option.
=cut
sub program_help_ok
{
local $Test::Builder::Level = $Test::Builder::Level + 1;
......@@ -453,6 +660,14 @@ sub program_help_ok
return;
}
=pod
=item program_version_ok(cmd)
Check that the command supports the C<--version> option.
=cut
sub program_version_ok
{
local $Test::Builder::Level = $Test::Builder::Level + 1;
......@@ -467,6 +682,15 @@ sub program_version_ok
return;
}
=pod
=item program_options_handling_ok(cmd)
Check that a command with an invalid option returns a non-zero
exit code and error message.
=cut
sub program_options_handling_ok
{
local $Test::Builder::Level = $Test::Builder::Level + 1;
......@@ -481,6 +705,15 @@ sub program_options_handling_ok
return;
}
=pod
=item command_like(cmd, expected_stdout, test_name)
Check that the command runs successfully and the output
matches the given regular expression.
=cut
sub command_like
{
local $Test::Builder::Level = $Test::Builder::Level + 1;
......@@ -494,6 +727,16 @@ sub command_like
return;
}
=pod
=item command_like_safe(cmd, expected_stdout, test_name)
Check that the command runs successfully and the output
matches the given regular expression. Doesn't assume that the
output files are closed.
=cut
sub command_like_safe
{
local $Test::Builder::Level = $Test::Builder::Level + 1;
......@@ -515,6 +758,15 @@ sub command_like_safe
return;
}
=pod
=item command_fails_like(cmd, expected_stderr, test_name)
Check that the command fails and the error message matches
the given regular expression.
=cut
sub command_fails_like
{
local $Test::Builder::Level = $Test::Builder::Level + 1;
......@@ -527,13 +779,29 @@ 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, ret, out, err, test_name)
Run a command and check its status and outputs.
Arguments:
=over
=item C<cmd>: Array reference of command and arguments to run
=item C<ret>: Expected exit code
=item C<out>: Expected stdout from command
=item C<err>: Expected stderr from command
=item C<test_name>: test name
=back
=cut
sub command_checks_all
{
local $Test::Builder::Level = $Test::Builder::Level + 1;
......@@ -570,4 +838,10 @@ sub command_checks_all
return;
}
=pod
=back
=cut
1;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment