diff options
Diffstat (limited to 'src/test/perl/TestLib.pm')
| -rw-r--r-- | src/test/perl/TestLib.pm | 93 |
1 files changed, 75 insertions, 18 deletions
diff --git a/src/test/perl/TestLib.pm b/src/test/perl/TestLib.pm index ef42366888e..0193d575ff7 100644 --- a/src/test/perl/TestLib.pm +++ b/src/test/perl/TestLib.pm @@ -12,6 +12,8 @@ our @EXPORT = qw( restart_test_server psql system_or_bail + system_log + run_log command_ok command_fails @@ -24,11 +26,47 @@ our @EXPORT = qw( ); use Cwd; +use File::Basename; use File::Spec; use File::Temp (); use IPC::Run qw(run start); + +use SimpleTee; + use Test::More; +# Open log file. For each test, the log file name uses the name of the +# file launching this module, without the .pl suffix. +my $log_path = 'tmp_check/log'; +mkdir 'tmp_check'; +mkdir $log_path; +my $test_logfile = basename($0); +$test_logfile =~ s/\.[^.]+$//; +$test_logfile = "$log_path/regress_log_$test_logfile"; +open TESTLOG, '>', $test_logfile or die "Cannot open STDOUT to logfile: $!"; + +# Hijack STDOUT and STDERR to the log file +open(ORIG_STDOUT, ">&STDOUT"); +open(ORIG_STDERR, ">&STDERR"); +open(STDOUT, ">&TESTLOG"); +open(STDERR, ">&TESTLOG"); + +# The test output (ok ...) needs to be printed to the original STDOUT so +# that the 'prove' program can parse it, and display it to the user in +# real time. But also copy it to the log file, to provide more context +# in the log. +my $builder = Test::More->builder; +my $fh = $builder->output; +tie *$fh, "SimpleTee", *ORIG_STDOUT, *TESTLOG; +$fh = $builder->failure_output; +tie *$fh, "SimpleTee", *ORIG_STDERR, *TESTLOG; + +# Enable auto-flushing for all the file handles. Stderr and stdout are +# redirected to the same file, and buffering causes the lines to appear +# in the log in confusing order. +autoflush STDOUT 1; +autoflush STDERR 1; +autoflush TESTLOG 1; # Set to untranslated messages, to be able to compare program output # with expected strings. @@ -77,7 +115,7 @@ sub tempdir_short sub standard_initdb { my $pgdata = shift; - system_or_bail("initdb -D '$pgdata' -A trust -N >/dev/null"); + system_or_bail('initdb', '-D', "$pgdata", '-A' , 'trust', '-N'); system_or_bail("$ENV{top_builddir}/src/test/regress/pg_regress", '--config-auth', $pgdata); } @@ -91,14 +129,15 @@ sub start_test_server my $tempdir_short = tempdir_short; + print("### Starting test server in $tempdir\n"); standard_initdb "$tempdir/pgdata"; - $ret = system 'pg_ctl', '-D', "$tempdir/pgdata", '-s', '-w', '-l', + $ret = system_log('pg_ctl', '-D', "$tempdir/pgdata", '-w', '-l', "$tempdir/logfile", '-o', -"--fsync=off -k $tempdir_short --listen-addresses='' --log-statement=all", - 'start'; - +"--fsync=off -k \"$tempdir_short\" --listen-addresses='' --log-statement=all", + 'start'); if ($ret != 0) { + print "# pg_ctl failed; logfile:\n"; system('cat', "$tempdir/logfile"); BAIL_OUT("pg_ctl failed"); } @@ -110,28 +149,45 @@ sub start_test_server sub restart_test_server { - system 'pg_ctl', '-s', '-D', $test_server_datadir, '-w', '-l', - $test_server_logfile, 'restart'; + print("### Restarting test server\n"); + system_log('pg_ctl', '-D', $test_server_datadir, '-w', '-l', + $test_server_logfile, 'restart'); } END { if ($test_server_datadir) { - system 'pg_ctl', '-D', $test_server_datadir, '-s', '-w', '-m', - 'immediate', 'stop'; + system_log('pg_ctl', '-D', $test_server_datadir, '-m', + 'immediate', 'stop'); } } sub psql { my ($dbname, $sql) = @_; + print("# Running SQL command: $sql\n"); run [ 'psql', '-X', '-q', '-d', $dbname, '-f', '-' ], '<', \$sql or die; } sub system_or_bail { - system(@_) == 0 or BAIL_OUT("system @_ failed: $?"); + if (system_log(@_) != 0) + { + BAIL_OUT("system $_[0] failed: $?"); + } +} + +sub system_log +{ + print("# Running: " . join(" ", @_) ."\n"); + return system(@_); +} + +sub run_log +{ + print("# Running: " . join(" ", @{$_[0]}) ."\n"); + return run (@_); } @@ -143,24 +199,22 @@ sub system_or_bail sub command_ok { my ($cmd, $test_name) = @_; - my $result = run $cmd, '>', File::Spec->devnull(), '2>', - File::Spec->devnull(); + my $result = run_log($cmd); ok($result, $test_name); } sub command_fails { my ($cmd, $test_name) = @_; - my $result = run $cmd, '>', File::Spec->devnull(), '2>', - File::Spec->devnull(); + my $result = run_log($cmd); ok(!$result, $test_name); } sub command_exit_is { my ($cmd, $expected, $test_name) = @_; - my $h = start $cmd, '>', File::Spec->devnull(), '2>', - File::Spec->devnull(); + print("# Running: " . join(" ", @{$cmd}) ."\n"); + my $h = start $cmd; $h->finish(); is($h->result(0), $expected, $test_name); } @@ -169,6 +223,7 @@ sub program_help_ok { my ($cmd) = @_; my ($stdout, $stderr); + print("# Running: $cmd --help\n"); my $result = run [ $cmd, '--help' ], '>', \$stdout, '2>', \$stderr; ok($result, "$cmd --help exit code 0"); isnt($stdout, '', "$cmd --help goes to stdout"); @@ -179,6 +234,7 @@ sub program_version_ok { my ($cmd) = @_; my ($stdout, $stderr); + print("# Running: $cmd --version\n"); my $result = run [ $cmd, '--version' ], '>', \$stdout, '2>', \$stderr; ok($result, "$cmd --version exit code 0"); isnt($stdout, '', "$cmd --version goes to stdout"); @@ -189,6 +245,7 @@ sub program_options_handling_ok { my ($cmd) = @_; my ($stdout, $stderr); + print("# Running: $cmd --not-a-valid-option\n"); my $result = run [ $cmd, '--not-a-valid-option' ], '>', \$stdout, '2>', \$stderr; ok(!$result, "$cmd with invalid option nonzero exit code"); @@ -199,6 +256,7 @@ sub command_like { my ($cmd, $expected_stdout, $test_name) = @_; my ($stdout, $stderr); + print("# Running: " . join(" ", @{$cmd}) . "\n"); my $result = run $cmd, '>', \$stdout, '2>', \$stderr; ok($result, "@$cmd exit code 0"); is($stderr, '', "@$cmd no stderr"); @@ -208,9 +266,8 @@ sub command_like sub issues_sql_like { my ($cmd, $expected_sql, $test_name) = @_; - my ($stdout, $stderr); truncate $test_server_logfile, 0; - my $result = run $cmd, '>', \$stdout, '2>', \$stderr; + my $result = run_log($cmd); ok($result, "@$cmd exit code 0"); my $log = `cat '$test_server_logfile'`; like($log, $expected_sql, "$test_name: SQL found in server log"); |