From 3606ab7bc5e8b277bab1cecb0e791fe001b7e5d1 Mon Sep 17 00:00:00 2001
From: Andrew Dunstan <andrew@dunslane.net>
Date: Mon, 28 Sep 2026 12:07:58 -0400
Subject: [PATCH] Fix TAP tests with recent IPC::Run on Windows

Recent IPC::Run releases default to binary mode on Windows, so
captured command output retains CRLF that comparisons against expected
text don't expect.  Some tests also rely on implicit standard streams,
which recent IPC::Run fails outright on Windows.  Andrew A. Bille
diagnosed both problems and posted a fix that requests text mode at
each affected redirection individually.

Instead, add ipc_run()/ipc_start() wrappers in PostgreSQL::Test::Utils
that default every non-PTY stream redirection to text mode automatically,
per a suggestion from Michael Paquier.

Discussion: https://postgr.es/m/CAJnzarxyuspsEcyG4iNqBQSVMj7B0mgZ3V4_EEhsKAhGtGX-Yg@mail.gmail.com
---
 src/bin/pg_dump/t/010_dump_connstr.pl         |   2 +
 src/bin/pg_rewind/t/RewindTest.pm             |   4 +-
 src/interfaces/libpq/t/001_uri.pl             |   3 +-
 .../modules/test_escape/t/001_test_escape.pl  |   4 +-
 .../perl/PostgreSQL/Test/BackgroundPsql.pm    |   8 +-
 src/test/perl/PostgreSQL/Test/Cluster.pm      |  41 ++++--
 src/test/perl/PostgreSQL/Test/Utils.pm        | 123 ++++++++++++++----
 src/test/recovery/t/021_row_visibility.pl     |   4 +-
 src/test/recovery/t/032_relfilenode_reuse.pl  |   4 +-
 9 files changed, 148 insertions(+), 45 deletions(-)

diff --git a/src/bin/pg_dump/t/010_dump_connstr.pl b/src/bin/pg_dump/t/010_dump_connstr.pl
index bf2c3b6d00b..3cf54a4502f 100644
--- a/src/bin/pg_dump/t/010_dump_connstr.pl
+++ b/src/bin/pg_dump/t/010_dump_connstr.pl
@@ -247,6 +247,7 @@ $envar_node->run_log(
 	local $ENV{PGPORT} = $envar_node->port;
 	local $ENV{PGUSER} = $restore_super;
 	$result = run_log([ 'psql', '--no-psqlrc', '--file' => $plain ],
+		'>' => sub { print STDOUT $_[0]; },
 		'2>' => \$stderr);
 }
 ok($result,
@@ -286,6 +287,7 @@ $cmdline_node->run_log(
 			'--no-psqlrc',
 			'--file' => $plain,
 		],
+		'>' => sub { print STDOUT $_[0]; },
 		'2>' => \$stderr);
 }
 ok($result,
diff --git a/src/bin/pg_rewind/t/RewindTest.pm b/src/bin/pg_rewind/t/RewindTest.pm
index 32aeca80f13..5b109414649 100644
--- a/src/bin/pg_rewind/t/RewindTest.pm
+++ b/src/bin/pg_rewind/t/RewindTest.pm
@@ -38,7 +38,6 @@ use Carp;
 use Exporter 'import';
 use File::Copy;
 use File::Path qw(rmtree);
-use IPC::Run   qw(run);
 use PostgreSQL::Test::Cluster;
 use PostgreSQL::Test::RecursiveCopy;
 use PostgreSQL::Test::Utils;
@@ -96,14 +95,13 @@ sub check_query
 	my ($stdout, $stderr);

 	# we want just the output, no formatting
-	my $result = run [
+	my $result = ipc_run [
 		'psql', '--quiet', '--no-align', '--tuples-only', '--no-psqlrc',
 		'--dbname' => $node_primary->connstr('postgres'),
 		'--command' => $query
 	  ],
 	  '>' => \$stdout,
 	  '2>' => \$stderr;
-
 	is($result, 1, "$test_name: psql exit code");
 	is($stderr, '', "$test_name: psql no stderr");
 	is($stdout, $expected_stdout, "$test_name: query result matches");
diff --git a/src/interfaces/libpq/t/001_uri.pl b/src/interfaces/libpq/t/001_uri.pl
index 64f257ae046..ae63b3c283a 100644
--- a/src/interfaces/libpq/t/001_uri.pl
+++ b/src/interfaces/libpq/t/001_uri.pl
@@ -4,7 +4,6 @@ use warnings FATAL => 'all';

 use PostgreSQL::Test::Utils;
 use Test::More;
-use IPC::Run;


 # List of URIs tests. For each test the first element is the input string, the
@@ -268,7 +267,7 @@ sub test_uri
 	%ENV = (%ENV, %envvars);

 	my $cmd = [ 'libpq_uri_regress', $uri ];
-	$result{exit} = IPC::Run::run $cmd,
+	$result{exit} = ipc_run $cmd,
 	  '>' => \$result{stdout},
 	  '2>' => \$result{stderr};

diff --git a/src/test/modules/test_escape/t/001_test_escape.pl b/src/test/modules/test_escape/t/001_test_escape.pl
index 3c6c968c07b..99c15331bef 100644
--- a/src/test/modules/test_escape/t/001_test_escape.pl
+++ b/src/test/modules/test_escape/t/001_test_escape.pl
@@ -20,7 +20,9 @@ my $cmd =
 # There currently is no good other way to transport test results from a C
 # program that requires just the node being set-up...
 my ($stderr, $stdout);
-my $result = IPC::Run::run $cmd, '>', \$stdout, '2>', \$stderr;
+my $result = ipc_run $cmd,
+  '>' => \$stdout,
+  '2>' => \$stderr;

 is($result, 1, "test_escape returns 0");
 is($stderr, '', "test_escape stderr is empty");
diff --git a/src/test/perl/PostgreSQL/Test/BackgroundPsql.pm b/src/test/perl/PostgreSQL/Test/BackgroundPsql.pm
index d7797225451..9b8a1b0132f 100644
--- a/src/test/perl/PostgreSQL/Test/BackgroundPsql.pm
+++ b/src/test/perl/PostgreSQL/Test/BackgroundPsql.pm
@@ -59,7 +59,7 @@ use warnings FATAL => 'all';
 use Carp;
 use Config;
 use IPC::Run;
-use PostgreSQL::Test::Utils qw(pump_until);
+use PostgreSQL::Test::Utils qw(ipc_start pump_until);
 use Test::More;

 =pod
@@ -107,7 +107,9 @@ sub new

 	if ($interactive)
 	{
-		$run = IPC::Run::start $psql_params,
+		# The pty streams are left alone; the stderr pipe is a plain
+		# (non-pty) stream, so ipc_start() still defaults it to text mode.
+		$run = ipc_start $psql_params,
 		  '<pty<' => \$psql->{stdin},
 		  '>pty>' => \$psql->{stdout},
 		  '2>' => \$psql->{stderr},
@@ -115,7 +117,7 @@ sub new
 	}
 	else
 	{
-		$run = IPC::Run::start $psql_params,
+		$run = ipc_start $psql_params,
 		  '<' => \$psql->{stdin},
 		  '>' => \$psql->{stdout},
 		  '2>' => \$psql->{stderr},
diff --git a/src/test/perl/PostgreSQL/Test/Cluster.pm b/src/test/perl/PostgreSQL/Test/Cluster.pm
index 920d831be9e..c5ec73b8ffd 100644
--- a/src/test/perl/PostgreSQL/Test/Cluster.pm
+++ b/src/test/perl/PostgreSQL/Test/Cluster.pm
@@ -505,11 +505,10 @@ sub config_data

 	my ($stdout, $stderr);
 	my $result =
-	  IPC::Run::run [ $self->installed_command('pg_config'), @options ],
+	  PostgreSQL::Test::Utils::ipc_run
+	  [ $self->installed_command('pg_config'), @options ],
 	  '>', \$stdout, '2>', \$stderr
 	  or croak "could not execute pg_config";
-	# standardize line endings
-	$stdout =~ s/\r(?=\n)//g;
 	# no options, scalar context: just hand back the output
 	return $stdout unless (wantarray || @options);
 	chomp($stdout);
@@ -2271,11 +2270,31 @@ sub psql
 		local $@;
 		eval {
 			my @ipcrun_opts = (\@psql_params, '<' => \$sql);
-			push @ipcrun_opts, '>' => $stdout if defined $stdout;
-			push @ipcrun_opts, '2>' => $stderr if defined $stderr;
+
+			# ipc_run() defaults these to text mode, so tests aren't
+			# tripped up by platform-specific line endings.
+			if (defined $stdout)
+			{
+				push @ipcrun_opts, '>' => $stdout;
+			}
+			elsif ($PostgreSQL::Test::Utils::windows_os)
+			{
+				# Preserve pass-through behavior explicitly on Windows.
+				push @ipcrun_opts, '>' => sub { print STDOUT $_[0]; };
+			}
+
+			if (defined $stderr)
+			{
+				push @ipcrun_opts, '2>' => $stderr;
+			}
+			elsif ($PostgreSQL::Test::Utils::windows_os)
+			{
+				push @ipcrun_opts, '2>' => sub { print STDERR $_[0]; };
+			}
+
 			push @ipcrun_opts, $timeout if defined $timeout;

-			IPC::Run::run @ipcrun_opts;
+			PostgreSQL::Test::Utils::ipc_run @ipcrun_opts;
 			$ret = $?;
 		};
 		my $exc_save = $@;
@@ -2787,7 +2806,7 @@ sub poll_query_until

 	while ($attempts < $max_attempts)
 	{
-		my $result = IPC::Run::run $cmd,
+		my $result = PostgreSQL::Test::Utils::ipc_run $cmd,
 		  '<' => \$query,
 		  '>' => \$stdout,
 		  '2>' => \$stderr;
@@ -3811,7 +3830,11 @@ sub pg_recvlogical_upto
 	{
 		local $@;
 		eval {
-			IPC::Run::run(\@cmd, '>' => \$stdout, '2>' => \$stderr, $timeout);
+			PostgreSQL::Test::Utils::ipc_run(
+				\@cmd,
+				'>' => \$stdout,
+				'2>' => \$stderr,
+				$timeout);
 			$ret = $?;
 		};
 		my $exc_save = $@;
@@ -3923,7 +3946,7 @@ sub create_logical_slot_on_standby

 	my $handle;

-	$handle = IPC::Run::start(
+	$handle = PostgreSQL::Test::Utils::ipc_start(
 		[
 			'pg_recvlogical',
 			'--dbname' => $self->connstr($dbname),
diff --git a/src/test/perl/PostgreSQL/Test/Utils.pm b/src/test/perl/PostgreSQL/Test/Utils.pm
index d3e6abf7a68..cedf4acb7f3 100644
--- a/src/test/perl/PostgreSQL/Test/Utils.pm
+++ b/src/test/perl/PostgreSQL/Test/Utils.pm
@@ -83,6 +83,9 @@ our @EXPORT = qw(
   scan_server_header
   system_or_bail
   system_log
+  ipc_run_text_mode
+  ipc_run
+  ipc_start
   run_log
   run_command
   pump_until
@@ -421,9 +424,80 @@ sub system_or_bail

 =pod

+=item ipc_run_text_mode()
+
+Return a filter suitable for C<IPC::Run> redirections that requests text mode.
+Most callers should use C<ipc_run()>/C<ipc_start()> instead, which apply this
+automatically; this is exposed for the rare filter chain that needs it
+explicitly (e.g. a non-terminal stage of a filter chain).
+
+=cut
+
+sub ipc_run_text_mode
+{
+	return IPC::Run::binary(0);
+}
+
+=pod
+
+=item ipc_run(@args)
+
+Wrapper for C<IPC::Run::run()> that defaults every non-PTY stream
+redirection ('<', '>', '>>', '2>', '2>>') to text mode, so that command
+output TAP tests treat as text doesn't retain platform-specific line
+endings (notably CRLF on Windows).  Callers do not need to request this
+themselves; pass an explicit C<IPC::Run::binary(1)> filter to opt out for a
+particular redirection.  PTY redirections ('<pty<', '>pty>') are left
+untouched, since IPC::Run handles ptys differently and text mode does not
+apply to them.
+
+=cut
+
+sub ipc_run
+{
+	return IPC::Run::run(_ipc_run_default_text_mode(@_));
+}
+
+=pod
+
+=item ipc_start(@args)
+
+As C<ipc_run()> above, but wraps C<IPC::Run::start()>.
+
+=cut
+
+sub ipc_start
+{
+	return IPC::Run::start(_ipc_run_default_text_mode(@_));
+}
+
+# Insert an explicit ipc_run_text_mode() filter after every non-PTY stream
+# redirection token in @args that doesn't already have one, so ipc_run()
+# and ipc_start() apply it by default without every call site needing to
+# remember to ask for it.
+sub _ipc_run_default_text_mode
+{
+	my @args = @_;
+	my @out;
+	for my $i (0 .. $#args)
+	{
+		push @out, $args[$i];
+		next if ref $args[$i];
+		next unless $args[$i] =~ /^\d*>>?$/;
+		my $next_arg = $args[$i + 1];
+		next
+		  if ref $next_arg
+		  && UNIVERSAL::isa($next_arg, 'IPC::Run::binmode_pseudo_filter');
+		push @out, ipc_run_text_mode();
+	}
+	return @out;
+}
+
+=pod
+
 =item run_log(@cmd)

-Run the given command via C<IPC::Run::run()>, noting it in the log.
+Run the given command via C<ipc_run()>, noting it in the log.
 The return value from the command is passed through.

 =cut
@@ -431,14 +505,14 @@ The return value from the command is passed through.
 sub run_log
 {
 	print("# Running: " . join(" ", @{ $_[0] }) . "\n");
-	return IPC::Run::run(@_);
+	return ipc_run(@_);
 }

 =pod

 =item run_command(cmd)

-Run (via C<IPC::Run::run()>) the command passed as argument.
+Run (via C<ipc_run()>) the command passed as argument.
 The return value from the command is ignored.
 The return value is C<($stdout, $stderr)>.

@@ -448,7 +522,7 @@ sub run_command
 {
 	my ($cmd) = @_;
 	my ($stdout, $stderr);
-	my $result = IPC::Run::run $cmd, '>' => \$stdout, '2>' => \$stderr;
+	my $result = ipc_run $cmd, '>' => \$stdout, '2>' => \$stderr;
 	chomp($stdout);
 	chomp($stderr);
 	return ($stdout, $stderr);
@@ -801,12 +875,11 @@ sub scan_server_header
 	my ($header_path, $regexp) = @_;

 	my ($stdout, $stderr);
-	my $result = IPC::Run::run [ 'pg_config', '--includedir-server' ],
+	my $result = ipc_run [ 'pg_config', '--includedir-server' ],
 	  '>' => \$stdout,
 	  '2>' => \$stderr
 	  or croak "could not execute pg_config";
 	chomp($stdout);
-	$stdout =~ s/\r$//;

 	open my $header_h, '<', "$stdout/$header_path" or croak "$!";

@@ -840,12 +913,11 @@ sub check_pg_config
 {
 	my ($regexp) = @_;
 	my ($stdout, $stderr);
-	my $result = IPC::Run::run [ 'pg_config', '--includedir' ],
+	my $result = ipc_run [ 'pg_config', '--includedir' ],
 	  '>' => \$stdout,
 	  '2>' => \$stderr
 	  or croak "could not execute pg_config";
 	chomp($stdout);
-	$stdout =~ s/\r$//;

 	open my $pg_config_h, '<', "$stdout/pg_config.h" or croak "$!";
 	my $match = (grep { /^$regexp/ } <$pg_config_h>);
@@ -1009,8 +1081,12 @@ sub command_ok
 	local $Test::Builder::Level = $Test::Builder::Level + 1;
 	my ($cmd, $test_name) = @_;
 	my ($stdout, $stderr);
+	my $stdin = '';
 	print("# Running: " . join(" ", @{$cmd}) . "\n");
-	my $result = IPC::Run::run $cmd, '>' => \$stdout, '2>' => \$stderr;
+	my $result = ipc_run $cmd,
+	  '<' => \$stdin,
+	  '>' => \$stdout,
+	  '2>' => \$stderr;
 	ok($result, $test_name) or do
 	{
 		diag("---------- command failed ----------");
@@ -1033,7 +1109,7 @@ sub command_fails
 	my ($cmd, $test_name) = @_;
 	my ($stdout, $stderr);
 	print("# Running: " . join(" ", @{$cmd}) . "\n");
-	my $result = IPC::Run::run $cmd, '>' => \$stdout, '2>' => \$stderr;
+	my $result = ipc_run $cmd, '>' => \$stdout, '2>' => \$stderr;
 	ok(!$result, $test_name) or do
 	{
 		diag("-- command succeeded unexpectedly --");
@@ -1055,7 +1131,7 @@ sub command_exit_is
 	local $Test::Builder::Level = $Test::Builder::Level + 1;
 	my ($cmd, $expected, $test_name) = @_;
 	print("# Running: " . join(" ", @{$cmd}) . "\n");
-	my $h = IPC::Run::start $cmd;
+	my $h = ipc_start $cmd;
 	$h->finish();

 	# Normally, if the child called exit(N), IPC::Run::result() returns N.  On
@@ -1083,9 +1159,7 @@ sub program_help_ok
 	my ($cmd) = @_;
 	my ($stdout, $stderr);
 	print("# Running: $cmd --help\n");
-	my $result = IPC::Run::run [ $cmd, '--help' ],
-	  '>' => \$stdout,
-	  '2>' => \$stderr;
+	my $result = ipc_run [ $cmd, '--help' ], '>' => \$stdout, '2>' => \$stderr;
 	ok($result, "$cmd --help exit code 0");
 	isnt($stdout, '', "$cmd --help goes to stdout");
 	is($stderr, '', "$cmd --help nothing to stderr");
@@ -1115,9 +1189,8 @@ sub program_version_ok
 	my ($cmd) = @_;
 	my ($stdout, $stderr);
 	print("# Running: $cmd --version\n");
-	my $result = IPC::Run::run [ $cmd, '--version' ],
-	  '>' => \$stdout,
-	  '2>' => \$stderr;
+	my $result =
+	  ipc_run [ $cmd, '--version' ], '>' => \$stdout, '2>' => \$stderr;
 	ok($result, "$cmd --version exit code 0");
 	isnt($stdout, '', "$cmd --version goes to stdout");
 	is($stderr, '', "$cmd --version nothing to stderr");
@@ -1139,7 +1212,7 @@ sub program_options_handling_ok
 	my ($cmd) = @_;
 	my ($stdout, $stderr);
 	print("# Running: $cmd --not-a-valid-option\n");
-	my $result = IPC::Run::run [ $cmd, '--not-a-valid-option' ],
+	my $result = ipc_run [ $cmd, '--not-a-valid-option' ],
 	  '>' => \$stdout,
 	  '2>' => \$stderr;
 	ok(!$result, "$cmd with invalid option nonzero exit code");
@@ -1162,7 +1235,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;
+	my $result = ipc_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");
@@ -1191,7 +1264,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;
+	my $result = ipc_run $cmd, '>' => $stdoutfile, '2>' => $stderrfile;
 	$stdout = slurp_file($stdoutfile);
 	$stderr = slurp_file($stderrfile);
 	ok($result, "$test_name: exit code 0");
@@ -1215,7 +1288,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;
+	my $result = ipc_run $cmd, '>' => \$stdout, '2>' => \$stderr;
 	ok(!$result, "$test_name: exit code not 0");
 	like($stderr, $expected_stderr, "$test_name: matches");
 	return;
@@ -1235,8 +1308,12 @@ sub command_ok_or_fails_like
 	local $Test::Builder::Level = $Test::Builder::Level + 1;
 	my ($cmd, $expected_stdout, $expected_stderr, $test_name) = @_;
 	my ($stdout, $stderr);
+	my $stdin = '';
 	print("# Running: " . join(" ", @{$cmd}) . "\n");
-	my $result = IPC::Run::run $cmd, '>' => \$stdout, '2>' => \$stderr;
+	my $result = ipc_run $cmd,
+	  '<' => \$stdin,
+	  '>' => \$stdout,
+	  '2>' => \$stderr;
 	if (!$result)
 	{
 		like($stdout, $expected_stdout, "$test_name: stdout matches");
@@ -1277,7 +1354,7 @@ sub command_checks_all
 	# run command
 	my ($stdout, $stderr);
 	print("# Running: " . join(" ", @{$cmd}) . "\n");
-	IPC::Run::run($cmd, '>' => \$stdout, '2>' => \$stderr);
+	ipc_run($cmd, '>' => \$stdout, '2>' => \$stderr);

 	# See http://perldoc.perl.org/perlvar.html#%24CHILD_ERROR
 	my $ret = $?;
diff --git a/src/test/recovery/t/021_row_visibility.pl b/src/test/recovery/t/021_row_visibility.pl
index 0a4d22b3698..44ecc940927 100644
--- a/src/test/recovery/t/021_row_visibility.pl
+++ b/src/test/recovery/t/021_row_visibility.pl
@@ -37,7 +37,7 @@ my $psql_timeout =
 # One psql to primary and standby each, for all queries. That allows
 # to check uncommitted changes being replicated and such.
 my %psql_primary = (stdin => '', stdout => '', stderr => '');
-$psql_primary{run} = IPC::Run::start(
+$psql_primary{run} = ipc_start(
 	[
 		'psql', '--no-psqlrc', '--no-align',
 		'--file' => '-',
@@ -49,7 +49,7 @@ $psql_primary{run} = IPC::Run::start(
 	$psql_timeout);

 my %psql_standby = ('stdin' => '', 'stdout' => '', 'stderr' => '');
-$psql_standby{run} = IPC::Run::start(
+$psql_standby{run} = ipc_start(
 	[
 		'psql', '--no-psqlrc', '--no-align',
 		'--file' => '-',
diff --git a/src/test/recovery/t/032_relfilenode_reuse.pl b/src/test/recovery/t/032_relfilenode_reuse.pl
index d9e22e9bcaa..88438a78cb5 100644
--- a/src/test/recovery/t/032_relfilenode_reuse.pl
+++ b/src/test/recovery/t/032_relfilenode_reuse.pl
@@ -35,7 +35,7 @@ $node_standby->start;
 my $psql_timeout = IPC::Run::timer($PostgreSQL::Test::Utils::timeout_default);

 my %psql_primary = (stdin => '', stdout => '', stderr => '');
-$psql_primary{run} = IPC::Run::start(
+$psql_primary{run} = ipc_start(
 	[
 		'psql', '--no-psqlrc', '--no-align',
 		'--file' => '-',
@@ -47,7 +47,7 @@ $psql_primary{run} = IPC::Run::start(
 	$psql_timeout);

 my %psql_standby = ('stdin' => '', 'stdout' => '', 'stderr' => '');
-$psql_standby{run} = IPC::Run::start(
+$psql_standby{run} = ipc_start(
 	[
 		'psql', '--no-psqlrc', '--no-align',
 		'--file' => '-',
--
2.43.0
