1# -*-perl-*- hey - emacs - this is a perl file 2 3# src/tools/msvc/vcregress.pl 4 5use strict; 6 7our $config; 8 9use Cwd; 10use File::Basename; 11use File::Copy; 12use File::Find (); 13use File::Path qw(rmtree); 14use File::Spec; 15BEGIN { use lib File::Spec->rel2abs(dirname(__FILE__)); } 16 17use Install qw(Install); 18 19my $startdir = getcwd(); 20 21chdir "../../.." if (-d "../../../src/tools/msvc"); 22 23my $topdir = getcwd(); 24my $tmp_installdir = "$topdir/tmp_install"; 25 26do './src/tools/msvc/config_default.pl'; 27do './src/tools/msvc/config.pl' if (-f 'src/tools/msvc/config.pl'); 28 29# buildenv.pl is for specifying the build environment settings 30# it should contain lines like: 31# $ENV{PATH} = "c:/path/to/bison/bin;$ENV{PATH}"; 32 33if (-e "src/tools/msvc/buildenv.pl") 34{ 35 do "./src/tools/msvc/buildenv.pl"; 36} 37 38my $what = shift || ""; 39if ($what =~ 40/^(check|installcheck|plcheck|contribcheck|modulescheck|ecpgcheck|isolationcheck|upgradecheck|bincheck|recoverycheck|taptest)$/i 41 ) 42{ 43 $what = uc $what; 44} 45else 46{ 47 usage(); 48} 49 50# use a capital C here because config.pl has $config 51my $Config = -e "release/postgres/postgres.exe" ? "Release" : "Debug"; 52 53copy("$Config/refint/refint.dll", "src/test/regress"); 54copy("$Config/autoinc/autoinc.dll", "src/test/regress"); 55copy("$Config/regress/regress.dll", "src/test/regress"); 56copy("$Config/dummy_seclabel/dummy_seclabel.dll", "src/test/regress"); 57 58$ENV{PATH} = "$topdir/$Config/libpq;$ENV{PATH}"; 59 60if ($ENV{PERL5LIB}) 61{ 62 $ENV{PERL5LIB} = "$topdir/src/tools/msvc;$ENV{PERL5LIB}"; 63} 64else 65{ 66 $ENV{PERL5LIB} = "$topdir/src/tools/msvc"; 67} 68 69my $maxconn = ""; 70$maxconn = "--max_connections=$ENV{MAX_CONNECTIONS}" 71 if $ENV{MAX_CONNECTIONS}; 72 73my $temp_config = ""; 74$temp_config = "--temp-config=\"$ENV{TEMP_CONFIG}\"" 75 if $ENV{TEMP_CONFIG}; 76 77chdir "src/test/regress"; 78 79my %command = ( 80 CHECK => \&check, 81 PLCHECK => \&plcheck, 82 INSTALLCHECK => \&installcheck, 83 ECPGCHECK => \&ecpgcheck, 84 CONTRIBCHECK => \&contribcheck, 85 MODULESCHECK => \&modulescheck, 86 ISOLATIONCHECK => \&isolationcheck, 87 BINCHECK => \&bincheck, 88 RECOVERYCHECK => \&recoverycheck, 89 UPGRADECHECK => \&upgradecheck, 90 TAPTEST => \&taptest,); 91 92my $proc = $command{$what}; 93 94exit 3 unless $proc; 95 96&$proc(@ARGV); 97 98exit 0; 99 100######################################################################## 101 102sub installcheck_internal 103{ 104 my ($schedule, @EXTRA_REGRESS_OPTS) = @_; 105 my @args = ( 106 "../../../$Config/pg_regress/pg_regress", 107 "--dlpath=.", 108 "--bindir=../../../$Config/psql", 109 "--schedule=${schedule}_schedule", 110 "--encoding=SQL_ASCII", 111 "--no-locale"); 112 push(@args, $maxconn) if $maxconn; 113 push(@args, @EXTRA_REGRESS_OPTS); 114 system(@args); 115 my $status = $? >> 8; 116 exit $status if $status; 117} 118 119sub installcheck 120{ 121 my $schedule = shift || 'serial'; 122 installcheck_internal($schedule); 123 return; 124} 125 126sub check 127{ 128 my $schedule = shift || 'parallel'; 129 InstallTemp(); 130 chdir "${topdir}/src/test/regress"; 131 my @args = ( 132 "../../../$Config/pg_regress/pg_regress", 133 "--dlpath=.", 134 "--bindir=", 135 "--schedule=${schedule}_schedule", 136 "--encoding=SQL_ASCII", 137 "--no-locale", 138 "--temp-instance=./tmp_check"); 139 push(@args, $maxconn) if $maxconn; 140 push(@args, $temp_config) if $temp_config; 141 system(@args); 142 my $status = $? >> 8; 143 exit $status if $status; 144} 145 146sub ecpgcheck 147{ 148 chdir $startdir; 149 system("msbuild ecpg_regression.proj /p:config=$Config"); 150 my $status = $? >> 8; 151 exit $status if $status; 152 InstallTemp(); 153 chdir "$topdir/src/interfaces/ecpg/test"; 154 my $schedule = "ecpg"; 155 my @args = ( 156 "../../../../$Config/pg_regress_ecpg/pg_regress_ecpg", 157 "--bindir=", 158 "--dbname=ecpg1_regression,ecpg2_regression", 159 "--create-role=regress_ecpg_user1,regress_ecpg_user2", 160 "--schedule=${schedule}_schedule", 161 "--encoding=SQL_ASCII", 162 "--no-locale", 163 "--temp-instance=./tmp_chk"); 164 push(@args, $maxconn) if $maxconn; 165 system(@args); 166 $status = $? >> 8; 167 exit $status if $status; 168} 169 170sub isolationcheck 171{ 172 chdir "../isolation"; 173 copy("../../../$Config/isolationtester/isolationtester.exe", 174 "../../../$Config/pg_isolation_regress"); 175 my @args = ( 176 "../../../$Config/pg_isolation_regress/pg_isolation_regress", 177 "--bindir=../../../$Config/psql", 178 "--inputdir=.", 179 "--schedule=./isolation_schedule"); 180 push(@args, $maxconn) if $maxconn; 181 system(@args); 182 my $status = $? >> 8; 183 exit $status if $status; 184} 185 186sub tap_check 187{ 188 die "Tap tests not enabled in configuration" 189 unless $config->{tap_tests}; 190 191 my @flags; 192 foreach my $arg (0 .. scalar(@_) - 1) 193 { 194 next unless $_[$arg] =~ /^PROVE_FLAGS=(.*)/; 195 @flags = split(/\s+/, $1); 196 splice(@_,$arg,1); 197 last; 198 } 199 200 my $dir = shift; 201 chdir $dir; 202 203 my @args = ("prove", @flags, glob("t/*.pl")); 204 205 # adjust the environment for just this test 206 local %ENV = %ENV; 207 $ENV{PERL5LIB} = "$topdir/src/test/perl;$ENV{PERL5LIB}"; 208 $ENV{PG_REGRESS} = "$topdir/$Config/pg_regress/pg_regress"; 209 $ENV{REGRESS_SHLIB} = "$topdir/src/test/regress/regress.dll"; 210 211 $ENV{TESTDIR} = "$dir"; 212 213 system(@args); 214 my $status = $? >> 8; 215 return $status; 216} 217 218sub bincheck 219{ 220 InstallTemp(); 221 222 my $mstat = 0; 223 224 # Find out all the existing TAP tests by looking for t/ directories 225 # in the tree. 226 my @bin_dirs = glob("$topdir/src/bin/*"); 227 228 # Process each test 229 foreach my $dir (@bin_dirs) 230 { 231 next unless -d "$dir/t"; 232 my $status = tap_check($dir); 233 $mstat ||= $status; 234 } 235 exit $mstat if $mstat; 236} 237 238sub taptest 239{ 240 my $dir = shift; 241 my @args; 242 243 if ($dir =~ /^PROVE_FLAGS=/) 244 { 245 push(@args, $dir); 246 $dir = shift; 247 } 248 249 die "no tests found!" unless -d "$topdir/$dir/t"; 250 251 push(@args,"$topdir/$dir"); 252 253 InstallTemp(); 254 my $status = tap_check(@args); 255 exit $status if $status; 256} 257 258sub mangle_plpython3 259{ 260 my $tests = shift; 261 mkdir "results" unless -d "results"; 262 mkdir "sql/python3"; 263 mkdir "results/python3"; 264 mkdir "expected/python3"; 265 266 foreach my $test (@$tests) 267 { 268 local $/ = undef; 269 foreach my $dir ('sql','expected') 270 { 271 my $extension = ($dir eq 'sql' ? 'sql' : 'out'); 272 273 my @files = glob("$dir/$test.$extension $dir/${test}_[0-9].$extension"); 274 foreach my $file (@files) 275 { 276 open(my $handle, '<', $file) || die "test file $file not found"; 277 my $contents = <$handle>; 278 close($handle); 279 do 280 { 281 s/except ([[:alpha:]][[:alpha:].]*), *([[:alpha:]][[:alpha:]]*):/except $1 as $2:/g; 282 s/<type 'exceptions\.([[:alpha:]]*)'>/<class '$1'>/g; 283 s/<type 'long'>/<class 'int'>/g; 284 s/([0-9][0-9]*)L/$1/g; 285 s/([ [{])u"/$1"/g; 286 s/([ [{])u'/$1'/g; 287 s/def next/def __next__/g; 288 s/LANGUAGE plpython2?u/LANGUAGE plpython3u/g; 289 s/EXTENSION ([^ ]*_)*plpython2?u/EXTENSION $1plpython3u/g; 290 s/installing required extension "plpython2u"/installing required extension "plpython3u"/g; 291 } for ($contents); 292 my $base = basename $file; 293 open($handle, '>', "$dir/python3/$base") || 294 die "opening python 3 file for $file"; 295 print $handle $contents; 296 close($handle); 297 } 298 } 299 } 300 do { s!^!python3/!; } foreach(@$tests); 301 return @$tests; 302} 303 304sub plcheck 305{ 306 chdir "../../pl"; 307 308 foreach my $pl (glob("*")) 309 { 310 next unless -d "$pl/sql" && -d "$pl/expected"; 311 my $lang = $pl eq 'tcl' ? 'pltcl' : $pl; 312 if ($lang eq 'plpython') 313 { 314 next unless -d "$topdir/$Config/plpython2" || 315 -d "$topdir/$Config/plpython3"; 316 $lang = 'plpythonu'; 317 } 318 else 319 { 320 next unless -d "../../$Config/$lang"; 321 } 322 my @lang_args = ("--load-extension=$lang"); 323 chdir $pl; 324 my @tests = fetchTests(); 325 @tests = mangle_plpython3(\@tests) 326 if $lang eq 'plpythonu' && -d "$topdir/$Config/plpython3"; 327 if ($lang eq 'plperl') 328 { 329 330 # run both trusted and untrusted perl tests 331 push(@lang_args, "--load-extension=plperlu"); 332 333 # assume we're using this perl to built postgres 334 # test if we can run two interpreters in one backend, and if so 335 # run the trusted/untrusted interaction tests 336 use Config; 337 if ($Config{usemultiplicity} eq 'define') 338 { 339 push(@tests, 'plperl_plperlu'); 340 } 341 } 342 elsif ($lang eq 'plpythonu' && -d "$topdir/$Config/plpython3") 343 { 344 @lang_args = (); 345 } 346 print 347 "============================================================\n"; 348 print "Checking $lang\n"; 349 my @args = ( 350 "../../../$Config/pg_regress/pg_regress", 351 "--bindir=../../../$Config/psql", 352 "--dbname=pl_regression", @lang_args, @tests); 353 system(@args); 354 my $status = $? >> 8; 355 exit $status if $status; 356 chdir ".."; 357 } 358 359 chdir "../../.."; 360} 361 362sub subdircheck 363{ 364 my $module = shift; 365 366 if ( !-d "$module/sql" 367 || !-d "$module/expected" 368 || (!-f "$module/GNUmakefile" && !-f "$module/Makefile")) 369 { 370 return; 371 } 372 373 chdir $module; 374 my @tests = fetchTests(); 375 my @opts = fetchRegressOpts(); 376 377 # Special processing for python transform modules, see their respective 378 # Makefiles for more details regarding Python-version specific 379 # dependencies. 380 if ( $module =~ /_plpython$/ ) 381 { 382 die "Python not enabled in configuration" 383 if !defined($config->{python}); 384 385 @opts = grep { $_ !~ /plpythonu/ } @opts; 386 387 if (-d "$topdir/$Config/plpython2") 388 { 389 push @opts, "--load-extension=plpythonu"; 390 push @opts, '--load-extension=' . $module . 'u'; 391 } 392 else 393 { 394 # must be python 3 395 @tests = mangle_plpython3(\@tests); 396 } 397 } 398 399 print "============================================================\n"; 400 print "Checking $module\n"; 401 my @args = ( 402 "$topdir/$Config/pg_regress/pg_regress", 403 "--bindir=${topdir}/${Config}/psql", 404 "--dbname=contrib_regression", @opts, @tests); 405 print join(' ',@args),"\n"; 406 system(@args); 407 chdir ".."; 408} 409 410sub contribcheck 411{ 412 chdir "../../../contrib"; 413 my $mstat = 0; 414 foreach my $module (glob("*")) 415 { 416 # these configuration-based exclusions must match Install.pm 417 next if ($module eq "uuid-ossp" && !defined($config->{uuid})); 418 next if ($module eq "sslinfo" && !defined($config->{openssl})); 419 next if ($module eq "xml2" && !defined($config->{xml})); 420 next if ($module =~ /_plperl$/ && !defined($config->{perl})); 421 next if ($module =~ /_plpython$/ && !defined($config->{python})); 422 next if ($module eq "sepgsql"); 423 424 subdircheck($module); 425 my $status = $? >> 8; 426 $mstat ||= $status; 427 } 428 exit $mstat if $mstat; 429} 430 431sub modulescheck 432{ 433 chdir "../../../src/test/modules"; 434 my $mstat = 0; 435 foreach my $module (glob("*")) 436 { 437 subdircheck($module); 438 my $status = $? >> 8; 439 $mstat ||= $status; 440 } 441 exit $mstat if $mstat; 442} 443 444sub recoverycheck 445{ 446 InstallTemp(); 447 448 my $mstat = 0; 449 my $dir = "$topdir/src/test/recovery"; 450 my $status = tap_check($dir); 451 exit $status if $status; 452} 453 454# Run "initdb", then reconfigure authentication. 455sub standard_initdb 456{ 457 return ( 458 system('initdb', '-N') == 0 and system( 459 "$topdir/$Config/pg_regress/pg_regress", '--config-auth', 460 $ENV{PGDATA}) == 0); 461} 462 463# This is similar to appendShellString(). Perl system(@args) bypasses 464# cmd.exe, so omit the caret escape layer. 465sub quote_system_arg 466{ 467 my $arg = shift; 468 469 # Change N >= 0 backslashes before a double quote to 2N+1 backslashes. 470 $arg =~ s/(\\*)"/${\($1 . $1)}\\"/gs; 471 472 # Change N >= 1 backslashes at end of argument to 2N backslashes. 473 $arg =~ s/(\\+)$/${\($1 . $1)}/gs; 474 475 # Wrap the whole thing in unescaped double quotes. 476 return "\"$arg\""; 477} 478 479# Generate a database with a name made of a range of ASCII characters, useful 480# for testing pg_upgrade. 481sub generate_db 482{ 483 my ($prefix, $from_char, $to_char, $suffix) = @_; 484 485 my $dbname = $prefix; 486 for my $i ($from_char .. $to_char) 487 { 488 next if $i == 7 || $i == 10 || $i == 13; # skip BEL, LF, and CR 489 $dbname = $dbname . sprintf('%c', $i); 490 } 491 $dbname .= $suffix; 492 493 system('createdb', quote_system_arg($dbname)); 494 my $status = $? >> 8; 495 exit $status if $status; 496} 497 498sub upgradecheck 499{ 500 my $status; 501 my $cwd = getcwd(); 502 503 # Much of this comes from the pg_upgrade test.sh script, 504 # but it only covers the --install case, and not the case 505 # where the old and new source or bin dirs are different. 506 # i.e. only this version to this version check. That's 507 # what pg_upgrade's "make check" does. 508 509 $ENV{PGHOST} = 'localhost'; 510 $ENV{PGPORT} ||= 50432; 511 my $tmp_root = "$topdir/src/bin/pg_upgrade/tmp_check"; 512 rmtree($tmp_root); 513 mkdir $tmp_root || die $!; 514 my $upg_tmp_install = "$tmp_root/install"; # unshared temp install 515 print "Setting up temp install\n\n"; 516 Install($upg_tmp_install, "all", $config); 517 518 # Install does a chdir, so change back after that 519 chdir $cwd; 520 my ($bindir, $libdir, $oldsrc, $newsrc) = 521 ("$upg_tmp_install/bin", "$upg_tmp_install/lib", $topdir, $topdir); 522 $ENV{PATH} = "$bindir;$ENV{PATH}"; 523 my $data = "$tmp_root/data"; 524 $ENV{PGDATA} = "$data.old"; 525 my $outputdir = "$tmp_root/regress"; 526 my @EXTRA_REGRESS_OPTS = ("--outputdir=$outputdir"); 527 mkdir "$outputdir" || die $!; 528 mkdir "$outputdir/sql" || die $!; 529 mkdir "$outputdir/expected" || die $!; 530 mkdir "$outputdir/testtablespace" || die $!; 531 532 my $logdir = "$topdir/src/bin/pg_upgrade/log"; 533 rmtree($logdir); 534 mkdir $logdir || die $!; 535 print "\nRunning initdb on old cluster\n\n"; 536 standard_initdb() or exit 1; 537 print "\nStarting old cluster\n\n"; 538 my @args = ('pg_ctl', 'start', '-l', "$logdir/postmaster1.log", '-w'); 539 system(@args) == 0 or exit 1; 540 541 print "\nCreating databases with names covering most ASCII bytes\n\n"; 542 generate_db("\\\"\\", 1, 45, "\\\\\"\\\\\\"); 543 generate_db('', 46, 90, ''); 544 generate_db('', 91, 127, ''); 545 546 print "\nSetting up data for upgrading\n\n"; 547 installcheck_internal('serial', @EXTRA_REGRESS_OPTS); 548 549 # now we can chdir into the source dir 550 chdir "$topdir/src/bin/pg_upgrade"; 551 print "\nDumping old cluster\n\n"; 552 @args = ('pg_dumpall', '-f', "$tmp_root/dump1.sql"); 553 system(@args) == 0 or exit 1; 554 print "\nStopping old cluster\n\n"; 555 system("pg_ctl -m fast stop") == 0 or exit 1; 556 $ENV{PGDATA} = "$data"; 557 print "\nSetting up new cluster\n\n"; 558 standard_initdb() or exit 1; 559 print "\nRunning pg_upgrade\n\n"; 560 @args = ( 561 'pg_upgrade', '-d', "$data.old", '-D', $data, '-b', 562 $bindir, '-B', $bindir); 563 system(@args) == 0 or exit 1; 564 print "\nStarting new cluster\n\n"; 565 @args = ('pg_ctl', '-l', "$logdir/postmaster2.log", '-w', 'start'); 566 system(@args) == 0 or exit 1; 567 print "\nSetting up stats on new cluster\n\n"; 568 system(".\\analyze_new_cluster.bat") == 0 or exit 1; 569 print "\nDumping new cluster\n\n"; 570 @args = ('pg_dumpall', '-f', "$tmp_root/dump2.sql"); 571 system(@args) == 0 or exit 1; 572 print "\nStopping new cluster\n\n"; 573 system("pg_ctl -m fast stop") == 0 or exit 1; 574 print "\nDeleting old cluster\n\n"; 575 system(".\\delete_old_cluster.bat") == 0 or exit 1; 576 print "\nComparing old and new cluster dumps\n\n"; 577 578 @args = ('diff', '-q', "$tmp_root/dump1.sql", "$tmp_root/dump2.sql"); 579 system(@args); 580 $status = $?; 581 if (!$status) 582 { 583 print "PASSED\n"; 584 } 585 else 586 { 587 print "dumps not identical!\n"; 588 exit(1); 589 } 590} 591 592sub fetchRegressOpts 593{ 594 my $handle; 595 open($handle, "<GNUmakefile") 596 || open($handle, "<Makefile") 597 || die "Could not open Makefile"; 598 local ($/) = undef; 599 my $m = <$handle>; 600 close($handle); 601 my @opts; 602 603 $m =~ s{\\\r?\n}{}g; 604 if ($m =~ /^\s*REGRESS_OPTS\s*\+?=(.*)/m) 605 { 606 # Substitute known Makefile variables, then ignore options that retain 607 # an unhandled variable reference. Ignore anything that isn't an 608 # option starting with "--". 609 @opts = grep { 610 s/\Q$(top_builddir)\E/\"$topdir\"/; 611 $_ !~ /\$\(/ && $_ =~ /^--/ 612 } split(/\s+/, $1); 613 } 614 if ($m =~ /^\s*ENCODING\s*=\s*(\S+)/m) 615 { 616 push @opts, "--encoding=$1"; 617 } 618 if ($m =~ /^\s*NO_LOCALE\s*=\s*\S+/m) 619 { 620 push @opts, "--no-locale"; 621 } 622 return @opts; 623} 624 625sub fetchTests 626{ 627 628 my $handle; 629 open($handle, "<GNUmakefile") 630 || open($handle, "<Makefile") 631 || die "Could not open Makefile"; 632 local ($/) = undef; 633 my $m = <$handle>; 634 close($handle); 635 my $t = ""; 636 637 $m =~ s{\\\r?\n}{}g; 638 if ($m =~ /^REGRESS\s*=\s*(.*)$/gm) 639 { 640 $t = $1; 641 $t =~ s/\s+/ /g; 642 643 if ($m =~ /contrib\/pgcrypto/) 644 { 645 646 # pgcrypto is special since the tests depend on the 647 # configuration of the build 648 649 my $cftests = 650 $config->{openssl} 651 ? GetTests("OSSL_TESTS", $m) 652 : GetTests("INT_TESTS", $m); 653 my $pgptests = 654 $config->{zlib} 655 ? GetTests("ZLIB_TST", $m) 656 : GetTests("ZLIB_OFF_TST", $m); 657 $t =~ s/\$\(CF_TESTS\)/$cftests/; 658 $t =~ s/\$\(CF_PGP_TESTS\)/$pgptests/; 659 } 660 } 661 662 return split(/\s+/, $t); 663} 664 665sub GetTests 666{ 667 my $testname = shift; 668 my $m = shift; 669 if ($m =~ /^$testname\s*=\s*(.*)$/gm) 670 { 671 return $1; 672 } 673 return ""; 674} 675 676sub InstallTemp 677{ 678 unless ($ENV{NO_TEMP_INSTALL}) 679 { 680 print "Setting up temp install\n\n"; 681 Install("$tmp_installdir", "all", $config); 682 } 683 $ENV{PATH} = "$tmp_installdir/bin;$ENV{PATH}"; 684} 685 686sub usage 687{ 688 print STDERR 689 "Usage: vcregress.pl <mode> [ <arg>]\n\n", 690 "Options for <mode>:\n", 691 " bincheck run tests of utilities in src/bin/\n", 692 " check deploy instance and run regression tests on it\n", 693 " contribcheck run tests of modules in contrib/\n", 694 " ecpgcheck run regression tests of ECPG\n", 695 " installcheck run regression tests on existing instance\n", 696 " isolationcheck run isolation tests\n", 697 " modulescheck run tests of modules in src/test/modules/\n", 698 " plcheck run tests of PL languages\n", 699 " recoverycheck run recovery test suite\n", 700 " taptest run an arbitrary TAP test set\n", 701 " upgradecheck run tests of pg_upgrade\n", 702 "\nOptions for <arg>: (used by check and installcheck)\n", 703 " serial serial mode\n", 704 " parallel parallel mode\n", 705 "\nOption for <arg>: for taptest\n", 706 " TEST_DIR (required) directory where tests reside\n"; 707 exit(1); 708} 709