From 6fcc40b1d4b91471f667fdf3ebe9665fbab95849 Mon Sep 17 00:00:00 2001 From: Alvaro Herrera Date: Mon, 2 Sep 2019 13:37:57 -0400 Subject: [PATCH] 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 --- src/test/perl/TestLib.pm | 340 +++++++++++++++++++++++++++++++++++---- 1 file changed, 307 insertions(+), 33 deletions(-) diff --git a/src/test/perl/TestLib.pm b/src/test/perl/TestLib.pm index 6195c21c598..92199792eba 100644 --- a/src/test/perl/TestLib.pm +++ b/src/test/perl/TestLib.pm @@ -1,9 +1,41 @@ -# 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 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 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, +and return its name. The directory will be removed automatically at the +end of the tests. + +If C is given, the new directory is templated as C<${prefix}_XXXX>. +Otherwise the template is C. + +=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) 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) 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, 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) 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 (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 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. + +=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) 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). + +=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: Array reference of command and arguments to run + +=item C: Expected exit code + +=item C: Expected stdout from command + +=item C: Expected stderr from command + +=item C: 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;