diff options
Diffstat (limited to 'src/test/perl/PostgresNode.pm')
| -rw-r--r-- | src/test/perl/PostgresNode.pm | 77 |
1 files changed, 77 insertions, 0 deletions
diff --git a/src/test/perl/PostgresNode.pm b/src/test/perl/PostgresNode.pm index ec202f1b6e5..598906ad649 100644 --- a/src/test/perl/PostgresNode.pm +++ b/src/test/perl/PostgresNode.pm @@ -1876,6 +1876,18 @@ instead of the default. If this regular expression is set, matches it with the output generated. +=item log_like => [ qr/required message/ ] + +If given, it must be an array reference containing a list of regular +expressions that must match against the server log, using +C<Test::More::like()>. + +=item log_unlike => [ qr/prohibited message/ ] + +If given, it must be an array reference containing a list of regular +expressions that must NOT match against the server log. They will be +passed to C<Test::More::unlike()>. + =back =cut @@ -1895,6 +1907,22 @@ sub connect_ok $sql = "SELECT \$\$connected with $connstr\$\$"; } + my (@log_like, @log_unlike); + if (defined($params{log_like})) + { + @log_like = @{ $params{log_like} }; + } + if (defined($params{log_unlike})) + { + @log_unlike = @{ $params{log_unlike} }; + } + + if (@log_like or @log_unlike) + { + # Don't let previous log entries match for this connection. + truncate $self->logfile, 0; + } + # Never prompt for a password, any callers of this routine should # have set up things properly, and this should not block. my ($ret, $stdout, $stderr) = $self->psql( @@ -1910,6 +1938,19 @@ sub connect_ok { like($stdout, $params{expected_stdout}, "$test_name: matches"); } + if (@log_like or @log_unlike) + { + my $log_contents = TestLib::slurp_file($self->logfile); + + while (my $regex = shift @log_like) + { + like($log_contents, $regex, "$test_name: log matches"); + } + while (my $regex = shift @log_unlike) + { + unlike($log_contents, $regex, "$test_name: log does not match"); + } + } } =pod @@ -1925,6 +1966,12 @@ to fail. If this regular expression is set, matches it with the output generated. +=item log_like => [ qr/required message/ ] + +=item log_unlike => [ qr/prohibited message/ ] + +See C<connect_ok(...)>, above. + =back =cut @@ -1934,6 +1981,22 @@ sub connect_fails local $Test::Builder::Level = $Test::Builder::Level + 1; my ($self, $connstr, $test_name, %params) = @_; + my (@log_like, @log_unlike); + if (defined($params{log_like})) + { + @log_like = @{ $params{log_like} }; + } + if (defined($params{log_unlike})) + { + @log_unlike = @{ $params{log_unlike} }; + } + + if (@log_like or @log_unlike) + { + # Don't let previous log entries match for this connection. + truncate $self->logfile, 0; + } + # Never prompt for a password, any callers of this routine should # have set up things properly, and this should not block. my ($ret, $stdout, $stderr) = $self->psql( @@ -1948,6 +2011,20 @@ sub connect_fails { like($stderr, $params{expected_stderr}, "$test_name: matches"); } + + if (@log_like or @log_unlike) + { + my $log_contents = TestLib::slurp_file($self->logfile); + + while (my $regex = shift @log_like) + { + like($log_contents, $regex, "$test_name: log matches"); + } + while (my $regex = shift @log_unlike) + { + unlike($log_contents, $regex, "$test_name: log does not match"); + } + } } =pod |