# -*-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///g; s///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); } # 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 [ ]\n\n", "Options for :\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 : (used by check and installcheck)\n", " serial serial mode\n", " parallel parallel mode\n", "\nOption for : for taptest\n", " TEST_DIR (required) directory where tests reside\n"; exit(1); }