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