src/tools/msvc/vcregress.pl - cloudberry - Git at Google

 # -*-perl-*- hey - emacs - this is a perl file

 # Copyright (c) 2021, PostgreSQL Global Development Group

 # src/tools/msvc/vcregress.pl

 use strict;
 use warnings;

 our $config;

 use Cwd;
 use File::Basename;
 use File::Copy;
 use File::Find ();
 use File::Path qw(rmtree);
 use File::Spec qw(devnull);

 use FindBin;
 use lib $FindBin::RealBin;

 use Install qw(Install);

 my $startdir = getcwd();

 chdir "../../.." if (-d "../../../src/tools/msvc");

 my $topdir         = getcwd();
 my $tmp_installdir = "$topdir/tmp_install";

 do './src/tools/msvc/config_default.pl';
 do './src/tools/msvc/config.pl' if (-f 'src/tools/msvc/config.pl');

 my $devnull = File::Spec->devnull;

 # These values are defaults that can be overridden by the calling environment
 # (see buildenv.pl processing below).  We assume that the ones listed here
 # always exist by default.  Other values may optionally be set for bincheck
 # or taptest, see set_command_env() below.
 # c.f. src/Makefile.global.in and configure.ac
 $ENV{TAR} ||= 'tar';

 # buildenv.pl is for specifying the build environment settings
 # it should contain lines like:
 # $ENV{PATH} = "c:/path/to/bison/bin;$ENV{PATH}";

 if (-e "src/tools/msvc/buildenv.pl")
 {
 	do "./src/tools/msvc/buildenv.pl";
 }

 my $what = shift || "";
 if ($what =~
 	/^(check|installcheck|plcheck|contribcheck|modulescheck|ecpgcheck|isolationcheck|upgradecheck|bincheck|recoverycheck|taptest)$/i
   )
 {
 	$what = uc $what;
 }
 else
 {
 	usage();
 }

 # use a capital C here because config.pl has $config
 my $Config = -e "release/postgres/postgres.exe" ? "Release" : "Debug";

 copy("$Config/refint/refint.dll",                 "src/test/regress");
 copy("$Config/autoinc/autoinc.dll",               "src/test/regress");
 copy("$Config/regress/regress.dll",               "src/test/regress");
 copy("$Config/dummy_seclabel/dummy_seclabel.dll", "src/test/regress");

 # Configuration settings used by TAP tests
 $ENV{with_ssl} = $config->{openssl} ? 'openssl' : 'no';
 $ENV{with_ldap} = $config->{ldap} ? 'yes' : 'no';
 $ENV{with_icu} = $config->{icu} ? 'yes' : 'no';
 $ENV{with_gssapi} = $config->{gss} ? 'yes' : 'no';
 $ENV{with_krb_srvnam} = $config->{krb_srvnam} || 'postgres';
 $ENV{with_readline} = 'no';

 $ENV{PATH} = "$topdir/$Config/libpq;$ENV{PATH}";

 if ($ENV{PERL5LIB})
 {
 	$ENV{PERL5LIB} = "$topdir/src/tools/msvc;$ENV{PERL5LIB}";
 }
 else
 {
 	$ENV{PERL5LIB} = "$topdir/src/tools/msvc";
 }

 my $maxconn = "";
 $maxconn = "--max-connections=$ENV{MAX_CONNECTIONS}"
   if $ENV{MAX_CONNECTIONS};

 my $temp_config = "";
 $temp_config = "--temp-config=\"$ENV{TEMP_CONFIG}\""
   if $ENV{TEMP_CONFIG};

 chdir "src/test/regress";

 my %command = (
 	CHECK          => \&check,
 	PLCHECK        => \&plcheck,
 	INSTALLCHECK   => \&installcheck,
 	ECPGCHECK      => \&ecpgcheck,
 	CONTRIBCHECK   => \&contribcheck,
 	MODULESCHECK   => \&modulescheck,
 	ISOLATIONCHECK => \&isolationcheck,
 	BINCHECK       => \&bincheck,
 	RECOVERYCHECK  => \&recoverycheck,
 	UPGRADECHECK   => \&upgradecheck,
 	TAPTEST        => \&taptest,);

 my $proc = $command{$what};

 exit 3 unless $proc;

 &$proc(@ARGV);

 exit 0;

 ########################################################################

 # Helper function for set_command_env, to set one environment command.
 sub set_single_env
 {
 	my $envname    = shift;
 	my $envdefault = shift;

 	# If a command is defined by the environment, just use it.
 	return if (defined($ENV{$envname}));

 	# Nothing is defined, so attempt to assign a default.  The command
 	# may not be in the current environment, hence check if it can be
 	# executed.
 	my $rc = system("$envdefault --version >$devnull 2>&1");

 	# Set the environment to the default if it exists, else leave it.
 	$ENV{$envname} = $envdefault if $rc == 0;
 	return;
 }

 # Set environment values for various command types.  These can be used
 # in the TAP tests.
 sub set_command_env
 {
 	set_single_env('GZIP_PROGRAM', 'gzip');
 	set_single_env('LZ4',          'lz4');
 }

 sub installcheck_internal
 {
 	my ($schedule, @EXTRA_REGRESS_OPTS) = @_;
 	# for backwards compatibility, "serial" runs the tests in
 	# parallel_schedule one by one.
 	my $maxconn = $maxconn;
 	$maxconn  = "--max-connections=1" if $schedule eq 'serial';
 	$schedule = 'parallel'            if $schedule eq 'serial';

 	my @args = (
 		"../../../$Config/pg_regress/pg_regress",
 		"--dlpath=.",
 		"--bindir=../../../$Config/psql",
 		"--schedule=${schedule}_schedule",
 		"--max-concurrent-tests=20",
 		"--make-testtablespace-dir",
 		"--encoding=SQL_ASCII",
 		"--no-locale");
 	push(@args, $maxconn) if $maxconn;
 	push(@args, @EXTRA_REGRESS_OPTS);
 	system(@args);
 	my $status = $? >> 8;
 	exit $status if $status;
 	return;
 }

 sub installcheck
 {
 	my $schedule = shift || 'serial';
 	installcheck_internal($schedule);
 	return;
 }

 sub check
 {
 	my $schedule = shift || 'parallel';
 	# for backwards compatibility, "serial" runs the tests in
 	# parallel_schedule one by one.
 	my $maxconn = $maxconn;
 	$maxconn  = "--max-connections=1" if $schedule eq 'serial';
 	$schedule = 'parallel'            if $schedule eq 'serial';

 	InstallTemp();
 	chdir "${topdir}/src/test/regress";
 	my @args = (
 		"../../../$Config/pg_regress/pg_regress",
 		"--dlpath=.",
 		"--bindir=",
 		"--schedule=${schedule}_schedule",
 		"--max-concurrent-tests=20",
 		"--make-testtablespace-dir",
 		"--encoding=SQL_ASCII",
 		"--no-locale",
 		"--temp-instance=./tmp_check");
 	push(@args, $maxconn)     if $maxconn;
 	push(@args, $temp_config) if $temp_config;
 	system(@args);
 	my $status = $? >> 8;
 	exit $status if $status;
 	return;
 }

 sub ecpgcheck
 {
 	my $msbflags = $ENV{MSBFLAGS} || "";
 	chdir $startdir;
 	system("msbuild ecpg_regression.proj $msbflags /p:config=$Config");
 	my $status = $? >> 8;
 	exit $status if $status;
 	InstallTemp();
 	chdir "$topdir/src/interfaces/ecpg/test";
 	my $schedule = "ecpg";
 	my @args     = (
 		"../../../../$Config/pg_regress_ecpg/pg_regress_ecpg",
 		"--bindir=",
 		"--dbname=ecpg1_regression,ecpg2_regression",
 		"--create-role=regress_ecpg_user1,regress_ecpg_user2",
 		"--schedule=${schedule}_schedule",
 		"--encoding=SQL_ASCII",
 		"--no-locale",
 		"--temp-instance=./tmp_chk");
 	push(@args, $maxconn) if $maxconn;
 	system(@args);
 	$status = $? >> 8;
 	exit $status if $status;
 	return;
 }

 sub isolationcheck
 {
 	chdir "../isolation";
 	copy("../../../$Config/isolationtester/isolationtester.exe",
 		"../../../$Config/pg_isolation_regress");
 	my @args = (
 		"../../../$Config/pg_isolation_regress/pg_isolation_regress",
 		"--bindir=../../../$Config/psql",
 		"--inputdir=.",
 		"--schedule=./isolation_schedule");
 	push(@args, $maxconn) if $maxconn;
 	system(@args);
 	my $status = $? >> 8;
 	exit $status if $status;
 	return;
 }

 sub tap_check
 {
 	die "Tap tests not enabled in configuration"
 	  unless $config->{tap_tests};

 	my @flags;
 	foreach my $arg (0 .. scalar(@_) - 1)
 	{
 		next unless $_[$arg] =~ /^PROVE_FLAGS=(.*)/;
 		@flags = split(/\s+/, $1);
 		splice(@_, $arg, 1);
 		last;
 	}

 	my $dir = shift;
 	chdir $dir;

 	# Fetch and adjust PROVE_TESTS, applying glob() to each element
 	# defined to build a list of all the tests matching patterns.
 	my $prove_tests_val = $ENV{PROVE_TESTS} || "t/*.pl";
 	my @prove_tests_array = split(/\s+/, $prove_tests_val);
 	my @prove_tests = ();
 	foreach (@prove_tests_array)
 	{
 		push(@prove_tests, glob($_));
 	}

 	# Fetch and adjust PROVE_FLAGS, handling multiple arguments.
 	my $prove_flags_val = $ENV{PROVE_FLAGS} || "";
 	my @prove_flags = split(/\s+/, $prove_flags_val);

 	my @args = ("prove", @flags, @prove_tests, @prove_flags);

 	# adjust the environment for just this test
 	local %ENV = %ENV;
 	$ENV{PERL5LIB}      = "$topdir/src/test/perl;$ENV{PERL5LIB}";
 	$ENV{PG_REGRESS}    = "$topdir/$Config/pg_regress/pg_regress";
 	$ENV{REGRESS_SHLIB} = "$topdir/src/test/regress/regress.dll";

 	$ENV{TESTDIR} = "$dir";
 	my $module = basename $dir;
 	# add the module build dir as the second element in the PATH
 	$ENV{PATH} =~ s!;!;$topdir/$Config/$module;!;

 	rmtree('tmp_check');
 	system(@args);
 	my $status = $? >> 8;
 	return $status;
 }

 sub bincheck
 {
 	InstallTemp();

 	set_command_env();

 	my $mstat = 0;

 	# Find out all the existing TAP tests by looking for t/ directories
 	# in the tree.
 	my @bin_dirs = glob("$topdir/src/bin/*");

 	# Process each test
 	foreach my $dir (@bin_dirs)
 	{
 		next unless -d "$dir/t";
 		my $status = tap_check($dir);
 		$mstat ||= $status;
 	}
 	exit $mstat if $mstat;
 	return;
 }

 sub taptest
 {
 	my $dir = shift;
 	my @args;

 	if ($dir =~ /^PROVE_FLAGS=/)
 	{
 		push(@args, $dir);
 		$dir = shift;
 	}

 	die "no tests found!" unless -d "$topdir/$dir/t";

 	push(@args, "$topdir/$dir");

 	InstallTemp();

 	set_command_env();

 	my $status = tap_check(@args);
 	exit $status if $status;
 	return;
 }

 sub mangle_plpython3
 {
 	my $tests = shift;
 	mkdir "results" unless -d "results";
 	mkdir "sql/python3";
 	mkdir "results/python3";
 	mkdir "expected/python3";

 	foreach my $test (@$tests)
 	{
 		local $/ = undef;
 		foreach my $dir ('sql', 'expected')
 		{
 			my $extension = ($dir eq 'sql' ? 'sql' : 'out');

 			my @files =
 			  glob("$dir/$test.$extension $dir/${test}_[0-9].$extension");
 			foreach my $file (@files)
 			{
 				open(my $handle, '<', $file)
 				  || die "test file $file not found";
 				my $contents = <$handle>;
 				close($handle);
 				do
 				{
 					s/<type 'exceptions\.([[:alpha:]]*)'>/<class '$1'>/g;
 					s/<type 'long'>/<class 'int'>/g;
 					s/([0-9][0-9]*)L/$1/g;
 					s/([ [{])u"/$1"/g;
 					s/([ [{])u'/$1'/g;
 					s/def next/def __next__/g;
 					s/LANGUAGE plpython2?u/LANGUAGE plpython3u/g;
 					s/EXTENSION (\S*?)plpython2?u/EXTENSION $1plpython3u/g;
 					s/installing required extension "plpython2u"/installing required extension "plpython3u"/g;
 				  }
 				  for ($contents);
 				my $base = basename $file;
 				open($handle, '>', "$dir/python3/$base")
 				  || die "opening python 3 file for $file";
 				print $handle $contents;
 				close($handle);
 			}
 		}
 	}
 	do { s!^!python3/!; }
 	  foreach (@$tests);
 	return @$tests;
 }

 sub plcheck
 {
 	chdir "$topdir/src/pl";

 	foreach my $dir (glob("*/src *"))
 	{
 		next unless -d "$dir/sql" && -d "$dir/expected";
 		my $lang;
 		if ($dir eq 'plpgsql/src')
 		{
 			$lang = 'plpgsql';
 		}
 		elsif ($dir eq 'tcl')
 		{
 			$lang = 'pltcl';
 		}
 		else
 		{
 			$lang = $dir;
 		}
 		if ($lang eq 'plpython')
 		{
 			next
 			  unless -d "$topdir/$Config/plpython2"
 			  || -d "$topdir/$Config/plpython3";
 			$lang = 'plpythonu';
 		}
 		else
 		{
 			next unless -d "$topdir/$Config/$lang";
 		}
 		my @lang_args = ("--load-extension=$lang");
 		chdir $dir;
 		my @tests = fetchTests();
 		@tests = mangle_plpython3(\@tests)
 		  if $lang eq 'plpythonu' && -d "$topdir/$Config/plpython3";
 		if ($lang eq 'plperl')
 		{

 			# plperl tests will install the extensions themselves
 			@lang_args = ();

 			# assume we're using this perl to built postgres
 			# test if we can run two interpreters in one backend, and if so
 			# run the trusted/untrusted interaction tests
 			use Config;
 			if ($Config{usemultiplicity} eq 'define')
 			{
 				push(@tests, 'plperl_plperlu');
 			}
 		}
 		elsif ($lang eq 'plpythonu' && -d "$topdir/$Config/plpython3")
 		{
 			@lang_args = ();
 		}

 		# Move on if no tests are listed.
 		next if (scalar @tests == 0);

 		print
 		  "============================================================\n";
 		print "Checking $lang\n";
 		my @args = (
 			"$topdir/$Config/pg_regress/pg_regress",
 			"--bindir=$topdir/$Config/psql",
 			"--dbname=pl_regression", @lang_args, @tests);
 		system(@args);
 		my $status = $? >> 8;
 		exit $status if $status;
 		chdir "$topdir/src/pl";
 	}

 	chdir "$topdir";
 	return;
 }

 sub subdircheck
 {
 	my $module = shift;

 	if (   !-d "$module/sql"
 		|| !-d "$module/expected"
 		|| (!-f "$module/GNUmakefile" && !-f "$module/Makefile"))
 	{
 		return;
 	}

 	chdir $module;
 	my @tests = fetchTests();

 	# Leave if no tests are listed in the module.
 	if (scalar @tests == 0)
 	{
 		chdir "..";
 		return;
 	}

 	my @opts = fetchRegressOpts();

 	# Special processing for python transform modules, see their respective
 	# Makefiles for more details regarding Python-version specific
 	# dependencies.
 	if ($module =~ /_plpython$/)
 	{
 		die "Python not enabled in configuration"
 		  if !defined($config->{python});

 		@opts = grep { $_ !~ /plpythonu/ } @opts;

 		if (-d "$topdir/$Config/plpython2")
 		{
 			push @opts, "--load-extension=plpythonu";
 			push @opts, '--load-extension=' . $module . 'u';
 		}
 		else
 		{
 			# must be python 3
 			@tests = mangle_plpython3(\@tests);
 		}
 	}

 	print "============================================================\n";
 	print "Checking $module\n";
 	my @args = (
 		"$topdir/$Config/pg_regress/pg_regress",
 		"--bindir=${topdir}/${Config}/psql",
 		"--dbname=contrib_regression", @opts, @tests);
 	print join(' ', @args), "\n";
 	system(@args);
 	chdir "..";
 	return;
 }

 sub contribcheck
 {
 	chdir "../../../contrib";
 	my $mstat = 0;
 	foreach my $module (glob("*"))
 	{
 		# these configuration-based exclusions must match Install.pm
 		next if ($module eq "uuid-ossp"  && !defined($config->{uuid}));
 		next if ($module eq "sslinfo"    && !defined($config->{openssl}));
 		next if ($module eq "xml2"       && !defined($config->{xml}));
 		next if ($module =~ /_plperl$/   && !defined($config->{perl}));
 		next if ($module =~ /_plpython$/ && !defined($config->{python}));
 		next if ($module eq "sepgsql");

 		subdircheck($module);
 		my $status = $? >> 8;
 		$mstat ||= $status;
 	}
 	exit $mstat if $mstat;
 	return;
 }

 sub modulescheck
 {
 	chdir "../../../src/test/modules";
 	my $mstat = 0;
 	foreach my $module (glob("*"))
 	{
 		subdircheck($module);
 		my $status = $? >> 8;
 		$mstat ||= $status;
 	}
 	exit $mstat if $mstat;
 	return;
 }

 sub recoverycheck
 {
 	InstallTemp();

 	my $mstat  = 0;
 	my $dir    = "$topdir/src/test/recovery";
 	my $status = tap_check($dir);
 	exit $status if $status;
 	return;
 }

 # Run "initdb", then reconfigure authentication.
 sub standard_initdb
 {
 	return (
 		system('initdb', '-N') == 0 and system(
 			"$topdir/$Config/pg_regress/pg_regress", '--config-auth',
 			$ENV{PGDATA}) == 0);
 }

 # Run "initdb", then reconfigure authentication.
 sub standard_initdb
 {
 	return (
 		system('initdb', '-N') == 0 and system(
 			"$topdir/$Config/pg_regress/pg_regress", '--config-auth',
 			$ENV{PGDATA}) == 0);
 }

 # This is similar to appendShellString().  Perl system(@args) bypasses
 # cmd.exe, so omit the caret escape layer.
 sub quote_system_arg
 {
 	my $arg = shift;

 	# Change N >= 0 backslashes before a double quote to 2N+1 backslashes.
 	$arg =~ s/(\\*)"/${\($1 . $1)}\\"/gs;

 	# Change N >= 1 backslashes at end of argument to 2N backslashes.
 	$arg =~ s/(\\+)$/${\($1 . $1)}/gs;

 	# Wrap the whole thing in unescaped double quotes.
 	return "\"$arg\"";
 }

 # Generate a database with a name made of a range of ASCII characters, useful
 # for testing pg_upgrade.
 sub generate_db
 {
 	my ($prefix, $from_char, $to_char, $suffix) = @_;

 	my $dbname = $prefix;
 	for my $i ($from_char .. $to_char)
 	{
 		next if $i == 7 || $i == 10 || $i == 13;    # skip BEL, LF, and CR
 		$dbname = $dbname . sprintf('%c', $i);
 	}
 	$dbname .= $suffix;

 	system('createdb', quote_system_arg($dbname));
 	my $status = $? >> 8;
 	exit $status if $status;
 	return;
 }

 sub upgradecheck
 {
 	my $status;
 	my $cwd = getcwd();

 	# Much of this comes from the pg_upgrade test.sh script,
 	# but it only covers the --install case, and not the case
 	# where the old and new source or bin dirs are different.
 	# i.e. only this version to this version check. That's
 	# what pg_upgrade's "make check" does.

 	$ENV{PGHOST} = 'localhost';
 	$ENV{PGPORT} ||= 50432;
 	my $tmp_root = "$topdir/src/bin/pg_upgrade/tmp_check";
 	rmtree($tmp_root);
 	mkdir $tmp_root || die $!;
 	my $upg_tmp_install = "$tmp_root/install";    # unshared temp install
 	print "Setting up temp install\n\n";
 	Install($upg_tmp_install, "all", $config);

 	# Install does a chdir, so change back after that
 	chdir $cwd;
 	my ($bindir, $libdir, $oldsrc, $newsrc) =
 	  ("$upg_tmp_install/bin", "$upg_tmp_install/lib", $topdir, $topdir);
 	$ENV{PATH} = "$bindir;$ENV{PATH}";
 	my $data = "$tmp_root/data";
 	$ENV{PGDATA} = "$data.old";
 	my $outputdir          = "$tmp_root/regress";
 	my @EXTRA_REGRESS_OPTS = ("--outputdir=$outputdir");
 	mkdir "$outputdir" || die $!;

 	my $logdir = "$topdir/src/bin/pg_upgrade/log";
 	rmtree($logdir);
 	mkdir $logdir || die $!;
 	print "\nRunning initdb on old cluster\n\n";
 	standard_initdb() or exit 1;
 	print "\nStarting old cluster\n\n";
 	my @args = ('pg_ctl', 'start', '-l', "$logdir/postmaster1.log");
 	system(@args) == 0 or exit 1;

 	print "\nCreating databases with names covering most ASCII bytes\n\n";
 	generate_db("\\\"\\", 1,  45,  "\\\\\"\\\\\\");
 	generate_db('',       46, 90,  '');
 	generate_db('',       91, 127, '');

 	print "\nSetting up data for upgrading\n\n";
 	installcheck_internal('parallel', @EXTRA_REGRESS_OPTS);

 	# now we can chdir into the source dir
 	chdir "$topdir/src/bin/pg_upgrade";
 	print "\nDumping old cluster\n\n";
 	@args = ('pg_dumpall', '-f', "$tmp_root/dump1.sql");
 	system(@args) == 0 or exit 1;
 	print "\nStopping old cluster\n\n";
 	system("pg_ctl stop") == 0 or exit 1;
 	$ENV{PGDATA} = "$data";
 	print "\nSetting up new cluster\n\n";
 	standard_initdb() or exit 1;
 	print "\nRunning pg_upgrade\n\n";
 	@args = ('pg_upgrade', '-d', "$data.old", '-D', $data, '-b', $bindir);
 	system(@args) == 0 or exit 1;
 	print "\nStarting new cluster\n\n";
 	@args = ('pg_ctl', '-l', "$logdir/postmaster2.log", 'start');
 	system(@args) == 0 or exit 1;
 	print "\nDumping new cluster\n\n";
 	@args = ('pg_dumpall', '-f', "$tmp_root/dump2.sql");
 	system(@args) == 0 or exit 1;
 	print "\nStopping new cluster\n\n";
 	system("pg_ctl stop") == 0 or exit 1;
 	print "\nDeleting old cluster\n\n";
 	system(".\\delete_old_cluster.bat") == 0 or exit 1;
 	print "\nComparing old and new cluster dumps\n\n";

 	@args = ('diff', '-q', "$tmp_root/dump1.sql", "$tmp_root/dump2.sql");
 	system(@args);
 	$status = $?;
 	if (!$status)
 	{
 		print "PASSED\n";
 	}
 	else
 	{
 		print "dumps not identical!\n";
 		exit(1);
 	}
 	return;
 }

 sub fetchRegressOpts
 {
 	my $handle;
 	open($handle, '<', "GNUmakefile")
 	  || open($handle, '<', "Makefile")
 	  || die "Could not open Makefile";
 	local ($/) = undef;
 	my $m = <$handle>;
 	close($handle);
 	my @opts;

 	$m =~ s{\\\r?\n}{}g;
 	if ($m =~ /^\s*REGRESS_OPTS\s*\+?=(.*)/m)
 	{

 		# Substitute known Makefile variables, then ignore options that retain
 		# an unhandled variable reference.  Ignore anything that isn't an
 		# option starting with "--".
 		@opts = grep { !/\$\(/ && /^--/ }
 		  map { (my $x = $_) =~ s/\Q$(top_builddir)\E/\"$topdir\"/; $x; }
 		  split(/\s+/, $1);
 	}
 	if ($m =~ /^\s*ENCODING\s*=\s*(\S+)/m)
 	{
 		push @opts, "--encoding=$1";
 	}
 	if ($m =~ /^\s*NO_LOCALE\s*=\s*\S+/m)
 	{
 		push @opts, "--no-locale";
 	}
 	return @opts;
 }

 # Fetch the list of tests by parsing a module's Makefile.  An empty
 # list is returned if the module does not need to run anything.
 sub fetchTests
 {

 	my $handle;
 	open($handle, '<', "GNUmakefile")
 	  || open($handle, '<', "Makefile")
 	  || die "Could not open Makefile";
 	local ($/) = undef;
 	my $m = <$handle>;
 	close($handle);
 	my $t = "";

 	$m =~ s{\\\r?\n}{}g;

 	# A module specifying NO_INSTALLCHECK does not support installcheck,
 	# so bypass its run by returning an empty set of tests.
 	if ($m =~ /^\s*NO_INSTALLCHECK\s*=\s*\S+/m)
 	{
 		return ();
 	}

 	if ($m =~ /^REGRESS\s*=\s*(.*)$/gm)
 	{
 		$t = $1;
 		$t =~ s/\s+/ /g;

 		if ($m =~ /contrib\/pgcrypto/)
 		{

 			# pgcrypto is special since the tests depend on the
 			# configuration of the build

 			my $cftests =
 			  $config->{openssl}
 			  ? GetTests("OSSL_TESTS", $m)
 			  : GetTests("INT_TESTS",  $m);
 			my $pgptests =
 			  $config->{zlib}
 			  ? GetTests("ZLIB_TST",     $m)
 			  : GetTests("ZLIB_OFF_TST", $m);
 			$t =~ s/\$\(CF_TESTS\)/$cftests/;
 			$t =~ s/\$\(CF_PGP_TESTS\)/$pgptests/;
 		}
 	}

 	return split(/\s+/, $t);
 }

 sub GetTests
 {
 	my $testname = shift;
 	my $m        = shift;
 	if ($m =~ /^$testname\s*=\s*(.*)$/gm)
 	{
 		return $1;
 	}
 	return "";
 }

 sub InstallTemp
 {
 	unless ($ENV{NO_TEMP_INSTALL})
 	{
 		print "Setting up temp install\n\n";
 		Install("$tmp_installdir", "all", $config);
 	}
 	$ENV{PATH} = "$tmp_installdir/bin;$ENV{PATH}";
 	return;
 }

 sub usage
 {
 	print STDERR
 	  "Usage: vcregress.pl <mode> [ <arg>]\n\n",
 	  "Options for <mode>:\n",
 	  "  bincheck       run tests of utilities in src/bin/\n",
 	  "  check          deploy instance and run regression tests on it\n",
 	  "  contribcheck   run tests of modules in contrib/\n",
 	  "  ecpgcheck      run regression tests of ECPG\n",
 	  "  installcheck   run regression tests on existing instance\n",
 	  "  isolationcheck run isolation tests\n",
 	  "  modulescheck   run tests of modules in src/test/modules/\n",
 	  "  plcheck        run tests of PL languages\n",
 	  "  recoverycheck  run recovery test suite\n",
 	  "  taptest        run an arbitrary TAP test set\n",
 	  "  upgradecheck   run tests of pg_upgrade\n",
 	  "\nOptions for <arg>: (used by check and installcheck)\n",
 	  "  serial         serial mode\n",
 	  "  parallel       parallel mode\n",
 	  "\nOption for <arg>: for taptest\n",
 	  "  TEST_DIR       (required) directory where tests reside\n";
 	exit(1);
 }
	# --perl-- hey - emacs - this is a perl file

	# Copyright (c) 2021, PostgreSQL Global Development Group

	# src/tools/msvc/vcregress.pl

	use strict;
	use warnings;

	our $config;

	use Cwd;
	use File::Basename;
	use File::Copy;
	use File::Find ();
	use File::Path qw(rmtree);
	use File::Spec qw(devnull);

	use FindBin;
	use lib $FindBin::RealBin;

	use Install qw(Install);

	my $startdir = getcwd();

	chdir "../../.." if (-d "../../../src/tools/msvc");

	my $topdir = getcwd();
	my $tmp_installdir = "$topdir/tmp_install";

	do './src/tools/msvc/config_default.pl';
	do './src/tools/msvc/config.pl' if (-f 'src/tools/msvc/config.pl');

	my $devnull = File::Spec->devnull;

	# These values are defaults that can be overridden by the calling environment
	# (see buildenv.pl processing below). We assume that the ones listed here
	# always exist by default. Other values may optionally be set for bincheck
	# or taptest, see set_command_env() below.
	# c.f. src/Makefile.global.in and configure.ac
	$ENV{TAR} \|\|= 'tar';

	# buildenv.pl is for specifying the build environment settings
	# it should contain lines like:
	# $ENV{PATH} = "c:/path/to/bison/bin;$ENV{PATH}";

	if (-e "src/tools/msvc/buildenv.pl")
	{
	do "./src/tools/msvc/buildenv.pl";
	}

	my $what = shift \|\| "";
	if ($what =~
	/^(check\|installcheck\|plcheck\|contribcheck\|modulescheck\|ecpgcheck\|isolationcheck\|upgradecheck\|bincheck\|recoverycheck\|taptest)$/i
	)
	{
	$what = uc $what;
	}
	else
	{
	usage();
	}

	# use a capital C here because config.pl has $config
	my $Config = -e "release/postgres/postgres.exe" ? "Release" : "Debug";

	copy("$Config/refint/refint.dll", "src/test/regress");
	copy("$Config/autoinc/autoinc.dll", "src/test/regress");
	copy("$Config/regress/regress.dll", "src/test/regress");
	copy("$Config/dummy_seclabel/dummy_seclabel.dll", "src/test/regress");

	# Configuration settings used by TAP tests
	$ENV{with_ssl} = $config->{openssl} ? 'openssl' : 'no';
	$ENV{with_ldap} = $config->{ldap} ? 'yes' : 'no';
	$ENV{with_icu} = $config->{icu} ? 'yes' : 'no';
	$ENV{with_gssapi} = $config->{gss} ? 'yes' : 'no';
	$ENV{with_krb_srvnam} = $config->{krb_srvnam} \|\| 'postgres';
	$ENV{with_readline} = 'no';

	$ENV{PATH} = "$topdir/$Config/libpq;$ENV{PATH}";

	if ($ENV{PERL5LIB})
	{
	$ENV{PERL5LIB} = "$topdir/src/tools/msvc;$ENV{PERL5LIB}";
	}
	else
	{
	$ENV{PERL5LIB} = "$topdir/src/tools/msvc";
	}

	my $maxconn = "";
	$maxconn = "--max-connections=$ENV{MAX_CONNECTIONS}"
	if $ENV{MAX_CONNECTIONS};

	my $temp_config = "";
	$temp_config = "--temp-config=\"$ENV{TEMP_CONFIG}\""
	if $ENV{TEMP_CONFIG};

	chdir "src/test/regress";

	my %command = (
	CHECK => \&check,
	PLCHECK => \&plcheck,
	INSTALLCHECK => \&installcheck,
	ECPGCHECK => \&ecpgcheck,
	CONTRIBCHECK => \&contribcheck,
	MODULESCHECK => \&modulescheck,
	ISOLATIONCHECK => \&isolationcheck,
	BINCHECK => \&bincheck,
	RECOVERYCHECK => \&recoverycheck,
	UPGRADECHECK => \&upgradecheck,
	TAPTEST => \&taptest,);

	my $proc = $command{$what};

	exit 3 unless $proc;

	&$proc(@ARGV);

	exit 0;

	########################################################################

	# Helper function for set_command_env, to set one environment command.
	sub set_single_env
	{
	my $envname = shift;
	my $envdefault = shift;

	# If a command is defined by the environment, just use it.
	return if (defined($ENV{$envname}));

	# Nothing is defined, so attempt to assign a default. The command
	# may not be in the current environment, hence check if it can be
	# executed.
	my $rc = system("$envdefault --version >$devnull 2>&1");

	# Set the environment to the default if it exists, else leave it.
	$ENV{$envname} = $envdefault if $rc == 0;
	return;
	}

	# Set environment values for various command types. These can be used
	# in the TAP tests.
	sub set_command_env
	{
	set_single_env('GZIP_PROGRAM', 'gzip');
	set_single_env('LZ4', 'lz4');
	}

	sub installcheck_internal
	{
	my ($schedule, @EXTRA_REGRESS_OPTS) = @_;
	# for backwards compatibility, "serial" runs the tests in
	# parallel_schedule one by one.
	my $maxconn = $maxconn;
	$maxconn = "--max-connections=1" if $schedule eq 'serial';
	$schedule = 'parallel' if $schedule eq 'serial';

	my @args = (
	"../../../$Config/pg_regress/pg_regress",
	"--dlpath=.",
	"--bindir=../../../$Config/psql",
	"--schedule=${schedule}_schedule",
	"--max-concurrent-tests=20",
	"--make-testtablespace-dir",
	"--encoding=SQL_ASCII",
	"--no-locale");
	push(@args, $maxconn) if $maxconn;
	push(@args, @EXTRA_REGRESS_OPTS);
	system(@args);
	my $status = $? >> 8;
	exit $status if $status;
	return;
	}

	sub installcheck
	{
	my $schedule = shift \|\| 'serial';
	installcheck_internal($schedule);
	return;
	}

	sub check
	{
	my $schedule = shift \|\| 'parallel';
	# for backwards compatibility, "serial" runs the tests in
	# parallel_schedule one by one.
	my $maxconn = $maxconn;
	$maxconn = "--max-connections=1" if $schedule eq 'serial';
	$schedule = 'parallel' if $schedule eq 'serial';

	InstallTemp();
	chdir "${topdir}/src/test/regress";
	my @args = (
	"../../../$Config/pg_regress/pg_regress",
	"--dlpath=.",
	"--bindir=",
	"--schedule=${schedule}_schedule",
	"--max-concurrent-tests=20",
	"--make-testtablespace-dir",
	"--encoding=SQL_ASCII",
	"--no-locale",
	"--temp-instance=./tmp_check");
	push(@args, $maxconn) if $maxconn;
	push(@args, $temp_config) if $temp_config;
	system(@args);
	my $status = $? >> 8;
	exit $status if $status;
	return;
	}

	sub ecpgcheck
	{
	my $msbflags = $ENV{MSBFLAGS} \|\| "";
	chdir $startdir;
	system("msbuild ecpg_regression.proj $msbflags /p:config=$Config");
	my $status = $? >> 8;
	exit $status if $status;
	InstallTemp();
	chdir "$topdir/src/interfaces/ecpg/test";
	my $schedule = "ecpg";
	my @args = (
	"../../../../$Config/pg_regress_ecpg/pg_regress_ecpg",
	"--bindir=",
	"--dbname=ecpg1_regression,ecpg2_regression",
	"--create-role=regress_ecpg_user1,regress_ecpg_user2",
	"--schedule=${schedule}_schedule",
	"--encoding=SQL_ASCII",
	"--no-locale",
	"--temp-instance=./tmp_chk");
	push(@args, $maxconn) if $maxconn;
	system(@args);
	$status = $? >> 8;
	exit $status if $status;
	return;
	}

	sub isolationcheck
	{
	chdir "../isolation";
	copy("../../../$Config/isolationtester/isolationtester.exe",
	"../../../$Config/pg_isolation_regress");
	my @args = (
	"../../../$Config/pg_isolation_regress/pg_isolation_regress",
	"--bindir=../../../$Config/psql",
	"--inputdir=.",
	"--schedule=./isolation_schedule");
	push(@args, $maxconn) if $maxconn;
	system(@args);
	my $status = $? >> 8;
	exit $status if $status;
	return;
	}

	sub tap_check
	{
	die "Tap tests not enabled in configuration"
	unless $config->{tap_tests};

	my @flags;
	foreach my $arg (0 .. scalar(@_) - 1)
	{
	next unless $_[$arg] =~ /^PROVE_FLAGS=(.*)/;
	@flags = split(/\s+/, $1);
	splice(@_, $arg, 1);
	last;
	}

	my $dir = shift;
	chdir $dir;

	# Fetch and adjust PROVE_TESTS, applying glob() to each element
	# defined to build a list of all the tests matching patterns.
	my $prove_tests_val = $ENV{PROVE_TESTS} \|\| "t/*.pl";
	my @prove_tests_array = split(/\s+/, $prove_tests_val);
	my @prove_tests = ();
	foreach (@prove_tests_array)
	{
	push(@prove_tests, glob($_));
	}

	# Fetch and adjust PROVE_FLAGS, handling multiple arguments.
	my $prove_flags_val = $ENV{PROVE_FLAGS} \|\| "";
	my @prove_flags = split(/\s+/, $prove_flags_val);

	my @args = ("prove", @flags, @prove_tests, @prove_flags);

	# adjust the environment for just this test
	local %ENV = %ENV;
	$ENV{PERL5LIB} = "$topdir/src/test/perl;$ENV{PERL5LIB}";
	$ENV{PG_REGRESS} = "$topdir/$Config/pg_regress/pg_regress";
	$ENV{REGRESS_SHLIB} = "$topdir/src/test/regress/regress.dll";

	$ENV{TESTDIR} = "$dir";
	my $module = basename $dir;
	# add the module build dir as the second element in the PATH
	$ENV{PATH} =~ s!;!;$topdir/$Config/$module;!;

	rmtree('tmp_check');
	system(@args);
	my $status = $? >> 8;
	return $status;
	}

	sub bincheck
	{
	InstallTemp();

	set_command_env();

	my $mstat = 0;

	# Find out all the existing TAP tests by looking for t/ directories
	# in the tree.
	my @bin_dirs = glob("$topdir/src/bin/*");

	# Process each test
	foreach my $dir (@bin_dirs)
	{
	next unless -d "$dir/t";
	my $status = tap_check($dir);
	$mstat \|\|= $status;
	}
	exit $mstat if $mstat;
	return;
	}

	sub taptest
	{
	my $dir = shift;
	my @args;

	if ($dir =~ /^PROVE_FLAGS=/)
	{
	push(@args, $dir);
	$dir = shift;
	}

	die "no tests found!" unless -d "$topdir/$dir/t";

	push(@args, "$topdir/$dir");

	InstallTemp();

	set_command_env();

	my $status = tap_check(@args);
	exit $status if $status;
	return;
	}

	sub mangle_plpython3
	{
	my $tests = shift;
	mkdir "results" unless -d "results";
	mkdir "sql/python3";
	mkdir "results/python3";
	mkdir "expected/python3";

	foreach my $test (@$tests)
	{
	local $/ = undef;
	foreach my $dir ('sql', 'expected')
	{
	my $extension = ($dir eq 'sql' ? 'sql' : 'out');

	my @files =
	glob("$dir/$test.$extension $dir/${test}_[0-9].$extension");
	foreach my $file (@files)
	{
	open(my $handle, '<', $file)
	\|\| die "test file $file not found";
	my $contents = <$handle>;
	close($handle);
	do
	{
	s/<type 'exceptions\.([[:alpha:]]*)'>/<class '$1'>/g;
	s/<type 'long'>/<class 'int'>/g;
	s/([0-9][0-9]*)L/$1/g;
	s/([ [{])u"/$1"/g;
	s/([ [{])u'/$1'/g;
	s/def next/def __next__/g;
	s/LANGUAGE plpython2?u/LANGUAGE plpython3u/g;
	s/EXTENSION (\S*?)plpython2?u/EXTENSION $1plpython3u/g;
	s/installing required extension "plpython2u"/installing required extension "plpython3u"/g;
	}
	for ($contents);
	my $base = basename $file;
	open($handle, '>', "$dir/python3/$base")
	\|\| die "opening python 3 file for $file";
	print $handle $contents;
	close($handle);
	}
	}
	}
	do { s!^!python3/!; }
	foreach (@$tests);
	return @$tests;
	}

	sub plcheck
	{
	chdir "$topdir/src/pl";

	foreach my $dir (glob("/src "))
	{
	next unless -d "$dir/sql" && -d "$dir/expected";
	my $lang;
	if ($dir eq 'plpgsql/src')
	{
	$lang = 'plpgsql';
	}
	elsif ($dir eq 'tcl')
	{
	$lang = 'pltcl';
	}
	else
	{
	$lang = $dir;
	}
	if ($lang eq 'plpython')
	{
	next
	unless -d "$topdir/$Config/plpython2"
	\|\| -d "$topdir/$Config/plpython3";
	$lang = 'plpythonu';
	}
	else
	{
	next unless -d "$topdir/$Config/$lang";
	}
	my @lang_args = ("--load-extension=$lang");
	chdir $dir;
	my @tests = fetchTests();
	@tests = mangle_plpython3(\@tests)
	if $lang eq 'plpythonu' && -d "$topdir/$Config/plpython3";
	if ($lang eq 'plperl')
	{

	# plperl tests will install the extensions themselves
	@lang_args = ();

	# assume we're using this perl to built postgres
	# test if we can run two interpreters in one backend, and if so
	# run the trusted/untrusted interaction tests
	use Config;
	if ($Config{usemultiplicity} eq 'define')
	{
	push(@tests, 'plperl_plperlu');
	}
	}
	elsif ($lang eq 'plpythonu' && -d "$topdir/$Config/plpython3")
	{
	@lang_args = ();
	}

	# Move on if no tests are listed.
	next if (scalar @tests == 0);

	print
	"============================================================\n";
	print "Checking $lang\n";
	my @args = (
	"$topdir/$Config/pg_regress/pg_regress",
	"--bindir=$topdir/$Config/psql",
	"--dbname=pl_regression", @lang_args, @tests);
	system(@args);
	my $status = $? >> 8;
	exit $status if $status;
	chdir "$topdir/src/pl";
	}

	chdir "$topdir";
	return;
	}

	sub subdircheck
	{
	my $module = shift;

	if ( !-d "$module/sql"
	\|\| !-d "$module/expected"
	\|\| (!-f "$module/GNUmakefile" && !-f "$module/Makefile"))
	{
	return;
	}

	chdir $module;
	my @tests = fetchTests();

	# Leave if no tests are listed in the module.
	if (scalar @tests == 0)
	{
	chdir "..";
	return;
	}

	my @opts = fetchRegressOpts();

	# Special processing for python transform modules, see their respective
	# Makefiles for more details regarding Python-version specific
	# dependencies.
	if ($module =~ /_plpython$/)
	{
	die "Python not enabled in configuration"
	if !defined($config->{python});

	@opts = grep { $_ !~ /plpythonu/ } @opts;

	if (-d "$topdir/$Config/plpython2")
	{
	push @opts, "--load-extension=plpythonu";
	push @opts, '--load-extension=' . $module . 'u';
	}
	else
	{
	# must be python 3
	@tests = mangle_plpython3(\@tests);
	}
	}

	print "============================================================\n";
	print "Checking $module\n";
	my @args = (
	"$topdir/$Config/pg_regress/pg_regress",
	"--bindir=${topdir}/${Config}/psql",
	"--dbname=contrib_regression", @opts, @tests);
	print join(' ', @args), "\n";
	system(@args);
	chdir "..";
	return;
	}

	sub contribcheck
	{
	chdir "../../../contrib";
	my $mstat = 0;
	foreach my $module (glob("*"))
	{
	# these configuration-based exclusions must match Install.pm
	next if ($module eq "uuid-ossp" && !defined($config->{uuid}));
	next if ($module eq "sslinfo" && !defined($config->{openssl}));
	next if ($module eq "xml2" && !defined($config->{xml}));
	next if ($module =~ /_plperl$/ && !defined($config->{perl}));
	next if ($module =~ /_plpython$/ && !defined($config->{python}));
	next if ($module eq "sepgsql");

	subdircheck($module);
	my $status = $? >> 8;
	$mstat \|\|= $status;
	}
	exit $mstat if $mstat;
	return;
	}

	sub modulescheck
	{
	chdir "../../../src/test/modules";
	my $mstat = 0;
	foreach my $module (glob("*"))
	{
	subdircheck($module);
	my $status = $? >> 8;
	$mstat \|\|= $status;
	}
	exit $mstat if $mstat;
	return;
	}

	sub recoverycheck
	{
	InstallTemp();

	my $mstat = 0;
	my $dir = "$topdir/src/test/recovery";
	my $status = tap_check($dir);
	exit $status if $status;
	return;
	}

	# Run "initdb", then reconfigure authentication.
	sub standard_initdb
	{
	return (
	system('initdb', '-N') == 0 and system(
	"$topdir/$Config/pg_regress/pg_regress", '--config-auth',
	$ENV{PGDATA}) == 0);
	}

	# Run "initdb", then reconfigure authentication.
	sub standard_initdb
	{
	return (
	system('initdb', '-N') == 0 and system(
	"$topdir/$Config/pg_regress/pg_regress", '--config-auth',
	$ENV{PGDATA}) == 0);
	}

	# This is similar to appendShellString(). Perl system(@args) bypasses
	# cmd.exe, so omit the caret escape layer.
	sub quote_system_arg
	{
	my $arg = shift;

	# Change N >= 0 backslashes before a double quote to 2N+1 backslashes.
	$arg =~ s/(\\*)"/${\($1 . $1)}\\"/gs;

	# Change N >= 1 backslashes at end of argument to 2N backslashes.
	$arg =~ s/(\\+)$/${\($1 . $1)}/gs;

	# Wrap the whole thing in unescaped double quotes.
	return "\"$arg\"";
	}

	# Generate a database with a name made of a range of ASCII characters, useful
	# for testing pg_upgrade.
	sub generate_db
	{
	my ($prefix, $from_char, $to_char, $suffix) = @_;

	my $dbname = $prefix;
	for my $i ($from_char .. $to_char)
	{
	next if $i == 7 \|\| $i == 10 \|\| $i == 13; # skip BEL, LF, and CR
	$dbname = $dbname . sprintf('%c', $i);
	}
	$dbname .= $suffix;

	system('createdb', quote_system_arg($dbname));
	my $status = $? >> 8;
	exit $status if $status;
	return;
	}

	sub upgradecheck
	{
	my $status;
	my $cwd = getcwd();

	# Much of this comes from the pg_upgrade test.sh script,
	# but it only covers the --install case, and not the case
	# where the old and new source or bin dirs are different.
	# i.e. only this version to this version check. That's
	# what pg_upgrade's "make check" does.

	$ENV{PGHOST} = 'localhost';
	$ENV{PGPORT} \|\|= 50432;
	my $tmp_root = "$topdir/src/bin/pg_upgrade/tmp_check";
	rmtree($tmp_root);
	mkdir $tmp_root \|\| die $!;
	my $upg_tmp_install = "$tmp_root/install"; # unshared temp install
	print "Setting up temp install\n\n";
	Install($upg_tmp_install, "all", $config);

	# Install does a chdir, so change back after that
	chdir $cwd;
	my ($bindir, $libdir, $oldsrc, $newsrc) =
	("$upg_tmp_install/bin", "$upg_tmp_install/lib", $topdir, $topdir);
	$ENV{PATH} = "$bindir;$ENV{PATH}";
	my $data = "$tmp_root/data";
	$ENV{PGDATA} = "$data.old";
	my $outputdir = "$tmp_root/regress";
	my @EXTRA_REGRESS_OPTS = ("--outputdir=$outputdir");
	mkdir "$outputdir" \|\| die $!;

	my $logdir = "$topdir/src/bin/pg_upgrade/log";
	rmtree($logdir);
	mkdir $logdir \|\| die $!;
	print "\nRunning initdb on old cluster\n\n";
	standard_initdb() or exit 1;
	print "\nStarting old cluster\n\n";
	my @args = ('pg_ctl', 'start', '-l', "$logdir/postmaster1.log");
	system(@args) == 0 or exit 1;

	print "\nCreating databases with names covering most ASCII bytes\n\n";
	generate_db("\\\"\\", 1, 45, "\\\\\"\\\\\\");
	generate_db('', 46, 90, '');
	generate_db('', 91, 127, '');

	print "\nSetting up data for upgrading\n\n";
	installcheck_internal('parallel', @EXTRA_REGRESS_OPTS);

	# now we can chdir into the source dir
	chdir "$topdir/src/bin/pg_upgrade";
	print "\nDumping old cluster\n\n";
	@args = ('pg_dumpall', '-f', "$tmp_root/dump1.sql");
	system(@args) == 0 or exit 1;
	print "\nStopping old cluster\n\n";
	system("pg_ctl stop") == 0 or exit 1;
	$ENV{PGDATA} = "$data";
	print "\nSetting up new cluster\n\n";
	standard_initdb() or exit 1;
	print "\nRunning pg_upgrade\n\n";
	@args = ('pg_upgrade', '-d', "$data.old", '-D', $data, '-b', $bindir);
	system(@args) == 0 or exit 1;
	print "\nStarting new cluster\n\n";
	@args = ('pg_ctl', '-l', "$logdir/postmaster2.log", 'start');
	system(@args) == 0 or exit 1;
	print "\nDumping new cluster\n\n";
	@args = ('pg_dumpall', '-f', "$tmp_root/dump2.sql");
	system(@args) == 0 or exit 1;
	print "\nStopping new cluster\n\n";
	system("pg_ctl stop") == 0 or exit 1;
	print "\nDeleting old cluster\n\n";
	system(".\\delete_old_cluster.bat") == 0 or exit 1;
	print "\nComparing old and new cluster dumps\n\n";

	@args = ('diff', '-q', "$tmp_root/dump1.sql", "$tmp_root/dump2.sql");
	system(@args);
	$status = $?;
	if (!$status)
	{
	print "PASSED\n";
	}
	else
	{
	print "dumps not identical!\n";
	exit(1);
	}
	return;
	}

	sub fetchRegressOpts
	{
	my $handle;
	open($handle, '<', "GNUmakefile")
	\|\| open($handle, '<', "Makefile")
	\|\| die "Could not open Makefile";
	local ($/) = undef;
	my $m = <$handle>;
	close($handle);
	my @opts;

	$m =~ s{\\\r?\n}{}g;
	if ($m =~ /^\sREGRESS_OPTS\s\+?=(.*)/m)
	{

	# Substitute known Makefile variables, then ignore options that retain
	# an unhandled variable reference. Ignore anything that isn't an
	# option starting with "--".
	@opts = grep { !/\$\(/ && /^--/ }
	map { (my $x = $_) =~ s/\Q$(top_builddir)\E/\"$topdir\"/; $x; }
	split(/\s+/, $1);
	}
	if ($m =~ /^\sENCODING\s=\s*(\S+)/m)
	{
	push @opts, "--encoding=$1";
	}
	if ($m =~ /^\sNO_LOCALE\s=\s*\S+/m)
	{
	push @opts, "--no-locale";
	}
	return @opts;
	}

	# Fetch the list of tests by parsing a module's Makefile. An empty
	# list is returned if the module does not need to run anything.
	sub fetchTests
	{

	my $handle;
	open($handle, '<', "GNUmakefile")
	\|\| open($handle, '<', "Makefile")
	\|\| die "Could not open Makefile";
	local ($/) = undef;
	my $m = <$handle>;
	close($handle);
	my $t = "";

	$m =~ s{\\\r?\n}{}g;

	# A module specifying NO_INSTALLCHECK does not support installcheck,
	# so bypass its run by returning an empty set of tests.
	if ($m =~ /^\sNO_INSTALLCHECK\s=\s*\S+/m)
	{
	return ();
	}

	if ($m =~ /^REGRESS\s=\s(.*)$/gm)
	{
	$t = $1;
	$t =~ s/\s+/ /g;

	if ($m =~ /contrib\/pgcrypto/)
	{

	# pgcrypto is special since the tests depend on the
	# configuration of the build

	my $cftests =
	$config->{openssl}
	? GetTests("OSSL_TESTS", $m)
	: GetTests("INT_TESTS", $m);
	my $pgptests =
	$config->{zlib}
	? GetTests("ZLIB_TST", $m)
	: GetTests("ZLIB_OFF_TST", $m);
	$t =~ s/\$\(CF_TESTS\)/$cftests/;
	$t =~ s/\$\(CF_PGP_TESTS\)/$pgptests/;
	}
	}

	return split(/\s+/, $t);
	}

	sub GetTests
	{
	my $testname = shift;
	my $m = shift;
	if ($m =~ /^$testname\s=\s(.*)$/gm)
	{
	return $1;
	}
	return "";
	}

	sub InstallTemp
	{
	unless ($ENV{NO_TEMP_INSTALL})
	{
	print "Setting up temp install\n\n";
	Install("$tmp_installdir", "all", $config);
	}
	$ENV{PATH} = "$tmp_installdir/bin;$ENV{PATH}";
	return;
	}

	sub usage
	{
	print STDERR
	"Usage: vcregress.pl <mode> [ <arg>]\n\n",
	"Options for <mode>:\n",
	" bincheck run tests of utilities in src/bin/\n",
	" check deploy instance and run regression tests on it\n",
	" contribcheck run tests of modules in contrib/\n",
	" ecpgcheck run regression tests of ECPG\n",
	" installcheck run regression tests on existing instance\n",
	" isolationcheck run isolation tests\n",
	" modulescheck run tests of modules in src/test/modules/\n",
	" plcheck run tests of PL languages\n",
	" recoverycheck run recovery test suite\n",
	" taptest run an arbitrary TAP test set\n",
	" upgradecheck run tests of pg_upgrade\n",
	"\nOptions for <arg>: (used by check and installcheck)\n",
	" serial serial mode\n",
	" parallel parallel mode\n",
	"\nOption for <arg>: for taptest\n",
	" TEST_DIR (required) directory where tests reside\n";
	exit(1);
	}