|
|
|
@ -21,7 +21,6 @@ TestLib - helper module for writing PostgreSQL's C<prove> tests. |
|
|
|
|
|
|
|
|
|
# Miscellanea |
|
|
|
|
print "on Windows" if $TestLib::windows_os; |
|
|
|
|
print "IO::Pty is available" if $TestLib::have_io_pty; |
|
|
|
|
my $path = TestLib::perl2host($backup_dir); |
|
|
|
|
ok(check_mode_recursive($stream_dir, 0700, 0600), |
|
|
|
|
"check stream dir permissions"); |
|
|
|
@ -84,12 +83,9 @@ our @EXPORT = qw( |
|
|
|
|
command_checks_all |
|
|
|
|
|
|
|
|
|
$windows_os |
|
|
|
|
$have_io_pty |
|
|
|
|
); |
|
|
|
|
|
|
|
|
|
our ($windows_os, $tmp_check, $log_path, $test_logfile, $have_io_pty); |
|
|
|
|
|
|
|
|
|
my @no_stdin; |
|
|
|
|
our ($windows_os, $tmp_check, $log_path, $test_logfile); |
|
|
|
|
|
|
|
|
|
BEGIN |
|
|
|
|
{ |
|
|
|
@ -121,9 +117,6 @@ BEGIN |
|
|
|
|
require Win32API::File; |
|
|
|
|
Win32API::File->import(qw(createFile OsFHandleOpen CloseHandle)); |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
eval { require IO::Pty; }; |
|
|
|
|
$have_io_pty = 1 unless $@; |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
=pod |
|
|
|
@ -138,12 +131,6 @@ Set to true when running under Windows, except on Cygwin. |
|
|
|
|
|
|
|
|
|
=back |
|
|
|
|
|
|
|
|
|
=item C<$have_io_pty> |
|
|
|
|
|
|
|
|
|
Set to true when IO::Pty is available. |
|
|
|
|
|
|
|
|
|
=back |
|
|
|
|
|
|
|
|
|
=cut |
|
|
|
|
|
|
|
|
|
INIT |
|
|
|
@ -191,20 +178,6 @@ INIT |
|
|
|
|
autoflush STDOUT 1; |
|
|
|
|
autoflush STDERR 1; |
|
|
|
|
autoflush $testlog 1; |
|
|
|
|
|
|
|
|
|
# Settings to close stdin for certain commands. |
|
|
|
|
# If IO::Pty is present, use a pseudo-terminal, so that libraries like |
|
|
|
|
# openssl which open the tty if they think stdin isn't one for a password |
|
|
|
|
# don't block. Elsewhere just provide an empty string for stdin. |
|
|
|
|
if ($have_io_pty) |
|
|
|
|
{ |
|
|
|
|
use charnames ':full'; |
|
|
|
|
@no_stdin = ('<pty<', \"\N{END OF TRANSMISSION}"); |
|
|
|
|
} |
|
|
|
|
else |
|
|
|
|
{ |
|
|
|
|
@no_stdin = ('<', \""); |
|
|
|
|
} |
|
|
|
|
} |
|
|
|
|
|
|
|
|
|
END |
|
|
|
@ -370,7 +343,7 @@ sub run_command |
|
|
|
|
{ |
|
|
|
|
my ($cmd) = @_; |
|
|
|
|
my ($stdout, $stderr); |
|
|
|
|
my $result = IPC::Run::run $cmd, '>', \$stdout, '2>', \$stderr, @no_stdin; |
|
|
|
|
my $result = IPC::Run::run $cmd, '>', \$stdout, '2>', \$stderr; |
|
|
|
|
chomp($stdout); |
|
|
|
|
chomp($stderr); |
|
|
|
|
return ($stdout, $stderr); |
|
|
|
@ -603,7 +576,7 @@ sub check_pg_config |
|
|
|
|
my ($regexp) = @_; |
|
|
|
|
my ($stdout, $stderr); |
|
|
|
|
my $result = IPC::Run::run [ 'pg_config', '--includedir' ], '>', |
|
|
|
|
\$stdout, '2>', \$stderr, @no_stdin |
|
|
|
|
\$stdout, '2>', \$stderr |
|
|
|
|
or die "could not execute pg_config"; |
|
|
|
|
chomp($stdout); |
|
|
|
|
$stdout =~ s/\r$//; |
|
|
|
@ -700,7 +673,7 @@ sub program_help_ok |
|
|
|
|
my ($stdout, $stderr); |
|
|
|
|
print("# Running: $cmd --help\n"); |
|
|
|
|
my $result = IPC::Run::run [ $cmd, '--help' ], '>', \$stdout, '2>', |
|
|
|
|
\$stderr, @no_stdin; |
|
|
|
|
\$stderr; |
|
|
|
|
ok($result, "$cmd --help exit code 0"); |
|
|
|
|
isnt($stdout, '', "$cmd --help goes to stdout"); |
|
|
|
|
is($stderr, '', "$cmd --help nothing to stderr"); |
|
|
|
@ -722,7 +695,7 @@ sub program_version_ok |
|
|
|
|
my ($stdout, $stderr); |
|
|
|
|
print("# Running: $cmd --version\n"); |
|
|
|
|
my $result = IPC::Run::run [ $cmd, '--version' ], '>', \$stdout, '2>', |
|
|
|
|
\$stderr, @no_stdin; |
|
|
|
|
\$stderr; |
|
|
|
|
ok($result, "$cmd --version exit code 0"); |
|
|
|
|
isnt($stdout, '', "$cmd --version goes to stdout"); |
|
|
|
|
is($stderr, '', "$cmd --version nothing to stderr"); |
|
|
|
@ -745,7 +718,8 @@ sub program_options_handling_ok |
|
|
|
|
my ($stdout, $stderr); |
|
|
|
|
print("# Running: $cmd --not-a-valid-option\n"); |
|
|
|
|
my $result = IPC::Run::run [ $cmd, '--not-a-valid-option' ], '>', |
|
|
|
|
\$stdout, '2>', \$stderr, @no_stdin; |
|
|
|
|
\$stdout, |
|
|
|
|
'2>', \$stderr; |
|
|
|
|
ok(!$result, "$cmd with invalid option nonzero exit code"); |
|
|
|
|
isnt($stderr, '', "$cmd with invalid option prints error message"); |
|
|
|
|
return; |
|
|
|
@ -766,7 +740,7 @@ sub command_like |
|
|
|
|
my ($cmd, $expected_stdout, $test_name) = @_; |
|
|
|
|
my ($stdout, $stderr); |
|
|
|
|
print("# Running: " . join(" ", @{$cmd}) . "\n"); |
|
|
|
|
my $result = IPC::Run::run $cmd, '>', \$stdout, '2>', \$stderr, @no_stdin; |
|
|
|
|
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"); |
|
|
|
@ -795,8 +769,7 @@ sub command_like_safe |
|
|
|
|
my $stdoutfile = File::Temp->new(); |
|
|
|
|
my $stderrfile = File::Temp->new(); |
|
|
|
|
print("# Running: " . join(" ", @{$cmd}) . "\n"); |
|
|
|
|
my $result = IPC::Run::run $cmd, '>', $stdoutfile, '2>', $stderrfile, |
|
|
|
|
@no_stdin; |
|
|
|
|
my $result = IPC::Run::run $cmd, '>', $stdoutfile, '2>', $stderrfile; |
|
|
|
|
$stdout = slurp_file($stdoutfile); |
|
|
|
|
$stderr = slurp_file($stderrfile); |
|
|
|
|
ok($result, "$test_name: exit code 0"); |
|
|
|
@ -820,7 +793,7 @@ sub command_fails_like |
|
|
|
|
my ($cmd, $expected_stderr, $test_name) = @_; |
|
|
|
|
my ($stdout, $stderr); |
|
|
|
|
print("# Running: " . join(" ", @{$cmd}) . "\n"); |
|
|
|
|
my $result = IPC::Run::run $cmd, '>', \$stdout, '2>', \$stderr, @no_stdin; |
|
|
|
|
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; |
|
|
|
@ -858,7 +831,7 @@ sub command_checks_all |
|
|
|
|
# run command |
|
|
|
|
my ($stdout, $stderr); |
|
|
|
|
print("# Running: " . join(" ", @{$cmd}) . "\n"); |
|
|
|
|
IPC::Run::run($cmd, '>', \$stdout, '2>', \$stderr, @no_stdin); |
|
|
|
|
IPC::Run::run($cmd, '>', \$stdout, '2>', \$stderr); |
|
|
|
|
|
|
|
|
|
# See http://perldoc.perl.org/perlvar.html#%24CHILD_ERROR |
|
|
|
|
my $ret = $?; |
|
|
|
|