granicus.if.org Git - postgresql/blob - src/tools/msvc/vcregress.pl

   1 # -*-perl-*- hey - emacs - this is a perl file
   2
   3 # src/tools/msvc/vcregress.pl
   4
   5 use strict;
   6
   7 our $config;
   8
   9 use Cwd;
  10 use File::Copy;
  11
  12 use Install qw(Install);
  13
  14 my $startdir = getcwd();
  15
  16 chdir "../../.." if (-d "../../../src/tools/msvc");
  17
  18 my $topdir = getcwd();
  19
  20 require 'src/tools/msvc/config_default.pl';
  21 require 'src/tools/msvc/config.pl' if (-f 'src/tools/msvc/config.pl');
  22
  23 # buildenv.pl is for specifying the build environment settings
  24 # it should contain lines like:
  25 # $ENV{PATH} = "c:/path/to/bison/bin;$ENV{PATH}";
  26
  27 if (-e "src/tools/msvc/buildenv.pl")
  28 {
  29         require "src/tools/msvc/buildenv.pl";
  30 }
  31
  32 my $what = shift || "";
  33 if ($what =~
  34 /^(check|installcheck|plcheck|contribcheck|ecpgcheck|isolationcheck|upgradecheck)$/i
  35   )
  36 {
  37         $what = uc $what;
  38 }
  39 else
  40 {
  41         usage();
  42 }
  43
  44 # use a capital C here because config.pl has $config
  45 my $Config = -e "release/postgres/postgres.exe" ? "Release" : "Debug";
  46
  47 copy("$Config/refint/refint.dll",                 "src/test/regress");
  48 copy("$Config/autoinc/autoinc.dll",               "src/test/regress");
  49 copy("$Config/regress/regress.dll",               "src/test/regress");
  50 copy("$Config/dummy_seclabel/dummy_seclabel.dll", "src/test/regress");
  51
  52 $ENV{PATH} = "../../../$Config/libpq;../../$Config/libpq;$ENV{PATH}";
  53
  54 my $schedule = shift;
  55 unless ($schedule)
  56 {
  57         $schedule = "serial";
  58         $schedule = "parallel" if ($what eq 'CHECK' || $what =~ /PARALLEL/);
  59 }
  60
  61 $ENV{PERL5LIB} = "$topdir/src/tools/msvc";
  62
  63 my $maxconn = "";
  64 $maxconn = "--max_connections=$ENV{MAX_CONNECTIONS}"
  65   if $ENV{MAX_CONNECTIONS};
  66
  67 my $temp_config = "";
  68 $temp_config = "--temp-config=\"$ENV{TEMP_CONFIG}\""
  69   if $ENV{TEMP_CONFIG};
  70
  71 chdir "src/test/regress";
  72
  73 my %command = (
  74         CHECK          => \&check,
  75         PLCHECK        => \&plcheck,
  76         INSTALLCHECK   => \&installcheck,
  77         ECPGCHECK      => \&ecpgcheck,
  78         CONTRIBCHECK   => \&contribcheck,
  79         ISOLATIONCHECK => \&isolationcheck,
  80         UPGRADECHECK   => \&upgradecheck,);
  81
  82 my $proc = $command{$what};
  83
  84 exit 3 unless $proc;
  85
  86 &$proc();
  87
  88 exit 0;
  89
  90 ########################################################################
  91
  92 sub installcheck
  93 {
  94         my @args = (
  95                 "../../../$Config/pg_regress/pg_regress",
  96                 "--dlpath=.",
  97                 "--psqldir=../../../$Config/psql",
  98                 "--schedule=${schedule}_schedule",
  99                 "--encoding=SQL_ASCII",
 100                 "--no-locale");
 101         push(@args, $maxconn) if $maxconn;
 102         system(@args);
 103         my $status = $? >> 8;
 104         exit $status if $status;
 105 }
 106
 107 sub check
 108 {
 109         my @args = (
 110                 "../../../$Config/pg_regress/pg_regress",
 111                 "--dlpath=.",
 112                 "--psqldir=../../../$Config/psql",
 113                 "--schedule=${schedule}_schedule",
 114                 "--encoding=SQL_ASCII",
 115                 "--no-locale",
 116                 "--temp-install=./tmp_check",
 117                 "--top-builddir=\"$topdir\"");
 118         push(@args, $maxconn)     if $maxconn;
 119         push(@args, $temp_config) if $temp_config;
 120         system(@args);
 121         my $status = $? >> 8;
 122         exit $status if $status;
 123 }
 124
 125 sub ecpgcheck
 126 {
 127         chdir $startdir;
 128         system("msbuild ecpg_regression.proj /p:config=$Config");
 129         my $status = $? >> 8;
 130         exit $status if $status;
 131         chdir "$topdir/src/interfaces/ecpg/test";
 132         $schedule = "ecpg";
 133         my @args = (
 134                 "../../../../$Config/pg_regress_ecpg/pg_regress_ecpg",
 135                 "--psqldir=../../../$Config/psql",
 136                 "--dbname=regress1,connectdb",
 137                 "--create-role=connectuser,connectdb",
 138                 "--schedule=${schedule}_schedule",
 139                 "--encoding=SQL_ASCII",
 140                 "--no-locale",
 141                 "--temp-install=./tmp_chk",
 142                 "--top-builddir=\"$topdir\"");
 143         push(@args, $maxconn) if $maxconn;
 144         system(@args);
 145         $status = $? >> 8;
 146         exit $status if $status;
 147 }
 148
 149 sub isolationcheck
 150 {
 151         chdir "../isolation";
 152         copy("../../../$Config/isolationtester/isolationtester.exe",
 153                 "../../../$Config/pg_isolation_regress");
 154         my @args = (
 155                 "../../../$Config/pg_isolation_regress/pg_isolation_regress",
 156                 "--psqldir=../../../$Config/psql",
 157                 "--inputdir=.",
 158                 "--schedule=./isolation_schedule");
 159         push(@args, $maxconn) if $maxconn;
 160         system(@args);
 161         my $status = $? >> 8;
 162         exit $status if $status;
 163 }
 164
 165 sub plcheck
 166 {
 167         chdir "../../pl";
 168
 169         foreach my $pl (glob("*"))
 170         {
 171                 next unless -d "$pl/sql" && -d "$pl/expected";
 172                 my $lang = $pl eq 'tcl' ? 'pltcl' : $pl;
 173                 if ($lang eq 'plpython')
 174                 {
 175                         next unless -d "../../$Config/plpython2";
 176                         $lang = 'plpythonu';
 177                 }
 178                 else
 179                 {
 180                         next unless -d "../../$Config/$lang";
 181                 }
 182                 my @lang_args = ("--load-extension=$lang");
 183                 chdir $pl;
 184                 my @tests = fetchTests();
 185                 if ($lang eq 'plperl')
 186                 {
 187
 188                         # run both trusted and untrusted perl tests
 189                         push(@lang_args, "--load-extension=plperlu");
 190
 191                         # assume we're using this perl to built postgres
 192                         # test if we can run two interpreters in one backend, and if so
 193                         # run the trusted/untrusted interaction tests
 194                         use Config;
 195                         if ($Config{usemultiplicity} eq 'define')
 196                         {
 197                                 push(@tests, 'plperl_plperlu');
 198                         }
 199                 }
 200                 print
 201                   "============================================================\n";
 202                 print "Checking $lang\n";
 203                 my @args = (
 204                         "../../../$Config/pg_regress/pg_regress",
 205                         "--psqldir=../../../$Config/psql",
 206                         "--dbname=pl_regression", @lang_args, @tests);
 207                 system(@args);
 208                 my $status = $? >> 8;
 209                 exit $status if $status;
 210                 chdir "..";
 211         }
 212
 213         chdir "../../..";
 214 }
 215
 216 sub contribcheck
 217 {
 218         chdir "../../../contrib";
 219         my $mstat = 0;
 220         foreach my $module (glob("*"))
 221         {
 222                 # these configuration-based exclusions must match Install.pm
 223                 next if ($module eq "uuid-ossp" && !defined($config->{uuid}));
 224                 next if ($module eq "sslinfo"   && !defined($config->{openssl}));
 225                 next if ($module eq "xml2"      && !defined($config->{xml}));
 226                 next if ($module eq "sepgsql");
 227
 228                 next
 229                   unless -d "$module/sql"
 230                           && -d "$module/expected"
 231                           && (-f "$module/GNUmakefile" || -f "$module/Makefile");
 232                 chdir $module;
 233                 print
 234                   "============================================================\n";
 235                 print "Checking $module\n";
 236                 my @tests = fetchTests();
 237                 my @opts  = fetchRegressOpts();
 238                 my @args  = (
 239                         "../../$Config/pg_regress/pg_regress",
 240                         "--psqldir=../../$Config/psql",
 241                         "--dbname=contrib_regression", @opts, @tests);
 242                 system(@args);
 243                 my $status = $? >> 8;
 244                 $mstat ||= $status;
 245                 chdir "..";
 246         }
 247         exit $mstat if $mstat;
 248 }
 249
 250 # Run "initdb", then reconfigure authentication.
 251 sub standard_initdb
 252 {
 253         return (
 254                 system('initdb', '-N') == 0 and system(
 255                         "$topdir/$Config/pg_regress/pg_regress", '--config-auth',
 256                         $ENV{PGDATA}) == 0);
 257 }
 258
 259 sub upgradecheck
 260 {
 261         my $status;
 262         my $cwd = getcwd();
 263
 264         # Much of this comes from the pg_upgrade test.sh script,
 265         # but it only covers the --install case, and not the case
 266         # where the old and new source or bin dirs are different.
 267         # i.e. only this version to this version check. That's
 268         # what pg_upgrade's "make check" does.
 269
 270         $ENV{PGHOST} = 'localhost';
 271         $ENV{PGPORT} ||= 50432;
 272         my $tmp_root = "$topdir/src/bin/pg_upgrade/tmp_check";
 273         (mkdir $tmp_root || die $!) unless -d $tmp_root;
 274         my $tmp_install = "$tmp_root/install";
 275         print "Setting up temp install\n\n";
 276         Install($tmp_install, "all", $config);
 277
 278         # Install does a chdir, so change back after that
 279         chdir $cwd;
 280         my ($bindir, $libdir, $oldsrc, $newsrc) =
 281           ("$tmp_install/bin", "$tmp_install/lib", $topdir, $topdir);
 282         $ENV{PATH} = "$bindir;$ENV{PATH}";
 283         my $data = "$tmp_root/data";
 284         $ENV{PGDATA} = "$data.old";
 285         my $logdir = "$topdir/src/bin/pg_upgrade/log";
 286         (mkdir $logdir || die $!) unless -d $logdir;
 287         print "\nRunning initdb on old cluster\n\n";
 288         standard_initdb() or exit 1;
 289         print "\nStarting old cluster\n\n";
 290         system("pg_ctl start -l $logdir/postmaster1.log -w") == 0 or exit 1;
 291         print "\nSetting up data for upgrading\n\n";
 292         installcheck();
 293
 294         # now we can chdir into the source dir
 295         chdir "$topdir/src/bin/pg_upgrade";
 296         print "\nDumping old cluster\n\n";
 297         system("pg_dumpall -f $tmp_root/dump1.sql") == 0 or exit 1;
 298         print "\nStopping old cluster\n\n";
 299         system("pg_ctl -m fast stop") == 0 or exit 1;
 300         $ENV{PGDATA} = "$data";
 301         print "\nSetting up new cluster\n\n";
 302         standard_initdb() or exit 1;
 303         print "\nRunning pg_upgrade\n\n";
 304         system("pg_upgrade -d $data.old -D $data -b $bindir -B $bindir") == 0
 305           or exit 1;
 306         print "\nStarting new cluster\n\n";
 307         system("pg_ctl -l $logdir/postmaster2.log -w start") == 0 or exit 1;
 308         print "\nSetting up stats on new cluster\n\n";
 309         system(".\\analyze_new_cluster.bat") == 0 or exit 1;
 310         print "\nDumping new cluster\n\n";
 311         system("pg_dumpall -f $tmp_root/dump2.sql") == 0 or exit 1;
 312         print "\nStopping new cluster\n\n";
 313         system("pg_ctl -m fast stop") == 0 or exit 1;
 314         print "\nDeleting old cluster\n\n";
 315         system(".\\delete_old_cluster.bat") == 0 or exit 1;
 316         print "\nComparing old and new cluster dumps\n\n";
 317
 318         system("diff -q $tmp_root/dump1.sql $tmp_root/dump2.sql");
 319         $status = $?;
 320         if (!$status)
 321         {
 322                 print "PASSED\n";
 323         }
 324         else
 325         {
 326                 print "dumps not identical!\n";
 327                 exit(1);
 328         }
 329 }
 330
 331 sub fetchRegressOpts
 332 {
 333         my $handle;
 334         open($handle, "<GNUmakefile")
 335           || open($handle, "<Makefile")
 336           || die "Could not open Makefile";
 337         local ($/) = undef;
 338         my $m = <$handle>;
 339         close($handle);
 340         my @opts;
 341
 342         $m =~ s{\\\r?\n}{}g;
 343         if ($m =~ /^\s*REGRESS_OPTS\s*=(.*)/m)
 344         {
 345
 346                 # Substitute known Makefile variables, then ignore options that retain
 347                 # an unhandled variable reference.  Ignore anything that isn't an
 348                 # option starting with "--".
 349                 @opts = grep {
 350                         s/\Q$(top_builddir)\E/\"$topdir\"/;
 351                         $_ !~ /\$\(/ && $_ =~ /^--/
 352                 } split(/\s+/, $1);
 353         }
 354         if ($m =~ /^\s*ENCODING\s*=\s*(\S+)/m)
 355         {
 356                 push @opts, "--encoding=$1";
 357         }
 358         if ($m =~ /^\s*NO_LOCALE\s*=\s*\S+/m)
 359         {
 360                 push @opts, "--no-locale";
 361         }
 362         return @opts;
 363 }
 364
 365 sub fetchTests
 366 {
 367
 368         my $handle;
 369         open($handle, "<GNUmakefile")
 370           || open($handle, "<Makefile")
 371           || die "Could not open Makefile";
 372         local ($/) = undef;
 373         my $m = <$handle>;
 374         close($handle);
 375         my $t = "";
 376
 377         $m =~ s{\\\r?\n}{}g;
 378         if ($m =~ /^REGRESS\s*=\s*(.*)$/gm)
 379         {
 380                 $t = $1;
 381                 $t =~ s/\s+/ /g;
 382
 383                 if ($m =~ /contrib\/pgcrypto/)
 384                 {
 385
 386                         # pgcrypto is special since the tests depend on the
 387                         # configuration of the build
 388
 389                         my $cftests =
 390                           $config->{openssl}
 391                           ? GetTests("OSSL_TESTS", $m)
 392                           : GetTests("INT_TESTS",  $m);
 393                         my $pgptests =
 394                           $config->{zlib}
 395                           ? GetTests("ZLIB_TST",     $m)
 396                           : GetTests("ZLIB_OFF_TST", $m);
 397                         $t =~ s/\$\(CF_TESTS\)/$cftests/;
 398                         $t =~ s/\$\(CF_PGP_TESTS\)/$pgptests/;
 399                 }
 400         }
 401
 402         return split(/\s+/, $t);
 403 }
 404
 405 sub GetTests
 406 {
 407         my $testname = shift;
 408         my $m        = shift;
 409         if ($m =~ /^$testname\s*=\s*(.*)$/gm)
 410         {
 411                 return $1;
 412         }
 413         return "";
 414 }
 415
 416 sub usage
 417 {
 418         print STDERR
 419           "Usage: vcregress.pl ",
 420           "<check|installcheck|plcheck|contribcheck|isolationcheck|ecpgcheck|upgradecheck> [schedule]\n";
 421         exit(1);
 422 }