1#!/usr/bin/perl -w 2use strict; 3 4use Getopt::Long qw(:config bundling no_auto_abbrev); 5use Pod::Usage; 6use Config; 7use File::Temp qw(tempdir); 8use File::Spec; 9 10my @targets 11 = qw(none config.sh config.h miniperl lib/Config.pm Fcntl perl test_prep); 12 13my %options = 14 ( 15 'expect-pass' => 1, 16 clean => 1, # mostly for debugging this 17 ); 18 19# We accept #!./miniperl and #!./perl 20# We don't accept #!miniperl and #!perl as their intent is ambiguous 21my $run_with_our_perl = qr{\A#!(\./(?:mini)?perl)\b}; 22 23my $linux64 = `uname -sm` eq "Linux x86_64\n" ? '64' : ''; 24 25my @paths; 26 27if ($^O eq 'linux') { 28 # This is the search logic for a multi-arch library layout 29 # added to linux.sh in commits 40f026236b9959b7 and dcffd848632af2c7. 30 my $gcc = -x '/usr/bin/gcc' ? '/usr/bin/gcc' : 'gcc'; 31 32 foreach (`$gcc -print-search-dirs`) { 33 next unless /^libraries: =(.*)/; 34 foreach (split ':', $1) { 35 next if m/gcc/; 36 next unless -d $_; 37 s!/$!!; 38 push @paths, $_; 39 } 40 } 41 push @paths, map {$_ . $linux64} qw(/usr/local/lib /lib /usr/lib) 42 if $linux64; 43} 44 45my %defines = 46 ( 47 usedevel => '', 48 optimize => '-g', 49 ld => 'cc', 50 (@paths ? (libpth => \@paths) : ()), 51 ); 52 53# Needed for the 'ignore_versioned_solibs' emulation below. 54push @paths, qw(/usr/local/lib /lib /usr/lib) 55 unless $linux64; 56 57my $rv = GetOptions( 58 \%options, 59 'target=s', 'make=s', 'jobs|j=i', 'crash', 'expect-pass=i', 60 'expect-fail' => sub { $options{'expect-pass'} = 0; }, 61 'clean!', 'one-liner|e=s@', 'c', 'l', 'w', 'match=s', 62 'no-match=s' => sub { 63 $options{match} = $_[1]; 64 $options{'expect-pass'} = 0; 65 }, 66 'force-manifest', 'force-regen', 'setpgrp!', 'timeout=i', 67 'test-build', 'validate', 68 'all-fixups', 'early-fixup=s@', 'late-fixup=s@', 'valgrind', 69 'check-args', 'check-shebang!', 'usage|help|?', 'gold=s', 70 'module=s', 'with-module=s', 'cpan-config-dir=s', 71 'test-module=s', 'no-module-tests', 72 'A=s@', 73 'D=s@' => sub { 74 my (undef, $val) = @_; 75 if ($val =~ /\A([^=]+)=(.*)/s) { 76 $defines{$1} = length $2 ? $2 : "\0"; 77 } else { 78 $defines{$val} = ''; 79 } 80 }, 81 'U=s@' => sub { 82 $defines{$_[1]} = undef; 83 }, 84); 85exit 255 unless $rv; 86 87my ($target, $match) = @options{qw(target match)}; 88 89# El Capitan (OS X 10.11) (and later) strip DYLD_LIBRARY_PATH 90# from the environment of /bin/sh 91# https://developer.apple.com/library/archive/documentation/Security/Conceptual/System_Integrity_Protection_Guide/RuntimeProtections/RuntimeProtections.html 92# 93# (They *could* have chosen instead to ignore it and pass it through. It would 94# have the same direct effect, but maybe needing more coding. I suspect the 95# choice to strip it was deliberate, as it will also eliminate a bunch more 96# attack vectors, because it prevents you sneaking an override "into" something 97# else you convince the user to run.) 98 99my $aggressive_apple_security = ""; 100if ($^O eq 'darwin') { 101 require Cwd; 102 my $cwd = quotemeta Cwd::getcwd(); 103 $aggressive_apple_security = "DYLD_LIBRARY_PATH=$cwd "; 104} 105 106@ARGV = ('sh', '-c', "cd t && $aggressive_apple_security./perl TEST base/*.t") 107 if $options{validate} && !@ARGV; 108 109pod2usage(exitval => 0, verbose => 2) if $options{usage}; 110 111# This needs to be done before the next arguments check, as it's populating 112# @ARGV 113if (defined $target && $target =~ /\.t\z/) { 114 # t/TEST don't have a reliable way to run the test script under valgrind 115 # The $ENV{VALGRIND} code was only added after v5.8.0, and is more 116 # geared to logging than to exiting on failure if errors are found. 117 # I guess one could fudge things by replacing the symlink t/perl with a 118 # wrapper script which invokes valgrind, but leave doing that until 119 # someone needs it. (If that's you, then patches welcome.) 120 foreach (qw(valgrind match validate test-build one-liner)) { 121 die_255("$0: Test-case targets can't be run with --$_") 122 if $options{$_}; 123 } 124 die_255("$0: Test-case targets can't be combined with an explicit test") 125 if @ARGV; 126 127 # Needing this unless is a smell suggesting that this implementation of 128 # test-case targets is not really in the right place. 129 unless ($options{'check-args'}) { 130 # The top level sanity tests refuse to start or end a test run at a 131 # revision which skips, hence this test ensures reasonable sanity at 132 # automatically picking a suitable start point for both normal operation 133 # and --expect-fail 134 skip("Test case $target is not a readable file") 135 unless -f $target && -r _; 136 } 137 138 # t/TEST runs from and takes pathnames relative to t/, so need to strip 139 # out a leading t, or add ../ otherwise 140 unless ($target =~ s!\At/!!) { 141 $target = "../$target"; 142 } 143 @ARGV = ('sh', '-c', "cd t && $aggressive_apple_security./perl TEST " . quotemeta $target); 144 $target = 'test_prep'; 145} 146 147pod2usage(exitval => 255, verbose => 1) 148 unless @ARGV || $match || $options{'test-build'} 149 || defined $options{'one-liner'} || defined $options{module} 150 || defined $options{'test-module'}; 151pod2usage(exitval => 255, verbose => 1) 152 if !$options{'one-liner'} && ($options{l} || $options{w}); 153if ($options{'no-module-tests'} && $options{module}) { 154 print STDERR "--module and --no-module-tests are exclusive.\n\n"; 155 pod2usage(exitval => 255, verbose => 1) 156} 157if ($options{'no-module-tests'} && $options{'test-module'}) { 158 print STDERR "--test-module and --no-module-tests are exclusive.\n\n"; 159 pod2usage(exitval => 255, verbose => 1) 160} 161if ($options{module} && $options{'test-module'}) { 162 print STDERR "--module and --test-module are exclusive.\n\n"; 163 pod2usage(exitval => 255, verbose => 1) 164} 165 166check_shebang($ARGV[0]) 167 if $options{'check-shebang'} && @ARGV && !$options{match}; 168 169exit 0 if $options{'check-args'}; 170 171=head1 NAME 172 173bisect.pl - use git bisect to pinpoint changes 174 175=head1 SYNOPSIS 176 177 # When did this become an error? 178 .../Porting/bisect.pl -e 'my $a := 2;' 179 # When did this stop being an error? 180 .../Porting/bisect.pl --expect-fail -e '1 // 2' 181 # When did this test start failing? 182 .../Porting/bisect.pl --target t/op/sort.t 183 # When were all lines matching this pattern removed from all files? 184 .../Porting/bisect.pl --match '\b(?:PL_)hash_seed_set\b' 185 # When was some line matching this pattern added to some file? 186 .../Porting/bisect.pl --expect-fail --match '\buseithreads\b' 187 # When did this test program stop exiting 0? 188 .../Porting/bisect.pl -- ./perl -Ilib ../test_prog.pl 189 # When did this test program start crashing (any signal or coredump)? 190 .../Porting/bisect.pl --crash -- ./perl -Ilib ../test_prog.pl 191 # When did this first become valid syntax? 192 .../Porting/bisect.pl --target=miniperl --end=v5.10.0 \ 193 --expect-fail -e 'my $a := 2;' 194 # What was the last revision to build with these options? 195 .../Porting/bisect.pl --test-build -Dd_dosuid 196 # When did this test program start generating errors from valgrind? 197 .../Porting/bisect.pl --valgrind ../test_prog.pl 198 # When did these cpan modules start failing to compile/pass tests? 199 .../Porting/bisect.pl --module=autobox,Moose 200 # When did this code stop working in blead with these modules? 201 .../Porting/bisect.pl --with-module=Moose,Moo -e 'use Moose; 1;' 202 # Like the above 2 but with custom CPAN::MyConfig 203 .../Porting/bisect.pl --module=Moo --cpan-config-dir=/home/blah/custom/ 204 205=head1 DESCRIPTION 206 207Together F<bisect.pl> and F<bisect-runner.pl> attempt to automate the use 208of C<git bisect> as much as possible. With one command (and no other files) 209it's easy to find out 210 211=over 4 212 213=item * 214 215Which commit caused this example code to break? 216 217=item * 218 219Which commit caused this example code to start working? 220 221=item * 222 223Which commit added the first file to match this regex? 224 225=item * 226 227Which commit removed the last file to match this regex? 228 229=back 230 231usually without needing to know which versions of perl to use as start and 232end revisions. 233 234By default F<bisect.pl> will process all options, then use the rest of the 235command line as arguments to list C<system> to run a test case. By default, 236the test case should pass (exit with 0) on earlier perls, and fail (exit 237non-zero) on I<blead>. F<bisect.pl> will use F<bisect-runner.pl> to find the 238earliest stable perl version on which the test case passes, check that it 239fails on blead, and then use F<bisect-runner.pl> with C<git bisect run> to 240find the commit which caused the failure. 241 242Many of perl's own test scripts exit 0 even if their TAP reports test 243failures, and some need particular setup (such as running from the right 244directory, or adding C<-T> to the command line). Hence if you want to bisect 245a test script, you can specify it with the I<--target> option, and it will 246be invoked using F<t/TEST> which performs all the setup, and exits non-zero 247if the TAP reports failures. This works for any file ending C<.t>, so you can 248use it with a file outside of the working checkout, for example to test a 249particular version of a test script, as a path inside the repository will 250(of course) be testing the version of the script checked out for the current 251revision, which may be too early to have the test you are interested in. 252 253Because the test case is the complete argument to C<system>, it is easy to 254run something other than the F<perl> built, if necessary. If you need to run 255the perl built, you'll probably need to invoke it as C<./perl -Ilib ...>. 256As a special case, if the first argument of the test case is a readable file 257(whether executable or not), matching C<qr{\A#!./(?:mini)?perl\b}> then it 258will have C<./perl> <-Ilib> (or C<./miniperl>) prepended to it. 259 260You need a clean checkout to run a bisect. You can use the checkout 261containing F<Porting/bisect.pl> if you wish - in this case 262F<Porting/bisect.pl> will copy F<Porting/bisect-runner.pl> to a temporary 263file generated by C<File::Temp::tempfile()>. If doing this, beware that when 264the bisect ends (or you abort it) then your checkout is no longer at 265C<blead>, so you will need to C<git checkout blead> before restarting, to 266get the current version of F<Porting/bisect.pl> again. It's often easier 267either to copy F<Porting/bisect.pl> and F<Porting/bisect-runner.pl> to 268another directory (I<e.g.> F<~/bin>, if you have one), or to create a second 269git repository for running bisect. To create a second local repository, if 270your working checkout is called F<perl>, a simple solution is to make a 271local clone, and run from that. I<i.e.>: 272 273 cd .. 274 git clone perl perl2 275 cd perl2 276 ../perl/Porting/bisect.pl ... 277 278By default, F<bisect-runner.pl> will automatically disable the build of 279L<DB_File> for commits earlier than ccb44e3bf3be2c30, as it's not practical 280to patch DB_File 1.70 and earlier to build with current Berkeley DB headers. 281(ccb44e3bf3be2c30 was in September 1999, between 5.005_62 and 5.005_63.) 282If your F<db.h> is old enough you can override this with C<-Unoextensions>. 283 284=head1 OPTIONS 285 286=over 4 287 288=item * 289 290--start I<commit-ish> 291 292Earliest revision to test, as a I<commit-ish> (a tag, commit or anything 293else C<git> understands as a revision). If not specified, F<bisect.pl> will 294search stable .0 perl releases until it finds one where the test case 295passes. The default is to search from 5.002 to the most recent tagged stable 296release (v5.18.0 at the time of writing). If F<bisect.pl> detects that the 297checkout is on a case insensitive file system, it will search from 5.005 to 298the most recent tagged stable release. Only .0 stable releases are used 299because these are the only stable releases that are parents of blead, and 300hence suitable for a bisect run. 301 302=item * 303 304--end I<commit-ish> 305 306Most recent revision to test, as a I<commit-ish>. If not specified, defaults 307to I<blead>. 308 309=item * 310 311--target I<target> 312 313F<Makefile> target (or equivalent) needed, to run the test case. If specified, 314this should be one of 315 316=over 4 317 318=item * 319 320I<none> 321 322Don't build anything - just run the user test case against a clean checkout. 323Using this gives a couple of features that a plain C<git bisect run> can't 324offer - automatic start revision detection, and test case C<--timeout>. 325 326=item * 327 328I<config.sh> 329 330Just run F<./Configure> 331 332=item * 333 334I<config.h> 335 336Run the various F<*.SH> files to generate F<Makefile>, F<config.h>, I<etc>. 337 338=item * 339 340I<miniperl> 341 342Build F<miniperl>. 343 344=item * 345 346I<lib/Config.pm> 347 348Use F<miniperl> to build F<lib/Config.pm> 349 350=item * 351 352I<Fcntl> 353 354Build F<lib/auto/Fcntl/Fnctl.so> (strictly, C<.$Config{so}>). As L<Fcntl> 355is simple XS module present since 5.000, this provides a fast test of 356whether XS modules can be built. Note, XS modules are built by F<miniperl>, 357hence this target will not build F<perl>. 358 359=item * 360 361I<perl> 362 363Build F<perl>. This also builds pure-Perl modules in F<cpan>, F<dist> and 364F<ext>. XS modules (such as L<Fcntl>) are not built. 365 366=item * 367 368I<test_prep> 369 370Build everything needed to run the tests. This is the default if we're 371running test code, but is time consuming, as it means building all 372XS modules. For older F<Makefile>s, the previous name of C<test-prep> 373is automatically substituted. For very old F<Makefile>s, C<make test> is 374run, as there is no target provided to just get things ready, and for 5.004 375and earlier the tests run very quickly. 376 377=item * 378 379A file ending C<.t> 380 381Build everything needed to run the tests, and then run this test script using 382F<t/TEST>. This is actually implemented internally by using the target 383I<test_prep>, and setting the test case to "sh", "-c", "cd t && ./TEST ..." 384 385=back 386 387=item * 388 389--one-liner 'code to run' 390 391=item * 392 393-e 'code to run' 394 395Example code to run, just like you'd use with C<perl -e>. 396 397This prepends C<./perl -Ilib -e 'code to run'> to the test case given, 398or F<./miniperl> if I<target> is C<miniperl>. 399 400(Usually you'll use C<-e> instead of providing a test case in the 401non-option arguments to F<bisect.pl>. You can repeat C<-e> on the command 402line, just like you can with C<perl>) 403 404C<-E> intentionally isn't supported, as it's an error in 5.8.0 and earlier, 405which interferes with detecting errors in the example code itself. 406 407=item * 408 409-c 410 411Add C<-c> to the command line, to cause perl to exit after syntax checking. 412 413=item * 414 415-l 416 417Add C<-l> to the command line with C<-e> 418 419This will automatically append a newline to every output line of your testcase. 420Note that you can't specify an argument to F<perl>'s C<-l> with this, as it's 421not feasible to emulate F<perl>'s somewhat quirky switch parsing with 422L<Getopt::Long>. If you need the full flexibility of C<-l>, you need to write 423a full test case, instead of using C<bisect.pl>'s C<-e> shortcut. 424 425=item * 426 427-w 428 429Add C<-w> to the command line with C<-e> 430 431It's not valid to pass C<-c>, C<-l> or C<-w> to C<bisect.pl> unless you are 432also using C<-e> 433 434=item * 435 436--expect-fail 437 438The test case should fail for the I<start> revision, and pass for the I<end> 439revision. The bisect run will find the first commit where it passes. 440 441=item * 442 443--crash 444 445Treat any non-crash as success, any crash as failure. (Crashing defined 446as exiting with a signal or a core dump.) 447 448=item * 449 450-D I<config_arg=value> 451 452=item * 453 454-U I<config_arg> 455 456=item * 457 458-A I<config_arg=value> 459 460Arguments (C<-A>, C<-D>, C<-U>) to pass to F<Configure>. The C<-D>, C<-A> and 461C<-U> switches should be spelled as if you were normally giving them to 462F<./Configure>. For example, 463 464 -Dnoextensions=Encode 465 -Uusedevel 466 -Accflags=-DNO_MATHOMS 467 468Repeated C<-A> arguments are passed 469through as is. C<-D> and C<-U> are processed in order, and override 470previous settings for the same parameter. F<bisect-runner.pl> emulates 471C<-Dnoextensions> when F<Configure> itself does not provide it, as it's 472often very useful to be able to disable some XS extensions. 473 474=item * 475 476--make I<make-prog> 477 478The C<make> command to use. If this not set, F<make> is used. If this is 479set, it also adds a C<-Dmake=...> else some recursive make invocations 480in extensions may fail. Typically one would use this as C<--make gmake> 481to use F<gmake> in place of the system F<make>. 482 483=item * 484 485--jobs I<jobs> 486 487=item * 488 489-j I<jobs> 490 491Number of C<make> jobs to run in parallel. A value of 0 suppresses 492parallelism. If F</proc/cpuinfo> exists and can be parsed, or F</sbin/sysctl> 493exists and reports C<hw.ncpu>, or F</usr/bin/getconf> exists and reports 494C<_NPROCESSORS_ONLN> defaults to 1 + I<number of CPUs>. On HP-UX with the 495system make defaults to 0, otherwise defaults to 2. 496 497=item * 498 499--match pattern 500 501=item * 502 503--no-match pattern 504 505Instead of running a test program to determine I<pass> or I<fail>, 506C<--match> will pass if the given regex matches, and hence search for the 507commit that removes the last matching file. C<--no-match> inverts the test, 508to search for the first commit that adds files that match. 509 510The remaining command line arguments are treated as glob patterns for files 511to match against. If none are specified, then they default as follows: 512 513=over 4 514 515=item * 516 517If no I<target> is specified, the match is against all files in the 518repository (which is fast). 519 520=item * 521 522If a I<target> is specified, that target is built, and the match is against 523only the built files. 524 525=back 526 527Treating the command line arguments as glob patterns should not cause 528problems, as the perl distribution has never shipped or built files with 529names that contain characters which are globbing metacharacters. 530 531Anything which is not a readable file is ignored, instead of generating an 532error. (If you want an error, run C<grep> or C<ack> as a test case). This 533permits one to easily search in a file that changed its name. For example: 534 535 .../Porting/bisect.pl --match 'Pod.*Functions' 'pod/buildtoc*' 536 537C<--no-match ...> is implemented as C<--expect-fail --match ...> 538 539=item * 540 541--valgrind 542 543Run the test program under C<valgrind>. If you need to test for memory 544errors when parsing invalid programs, the default parser fail exit code of 545255 will always override C<valgrind>, so try putting the test case invalid 546code inside a I<string> C<eval>, so that the perl interpreter will exit with 0. 547(Be sure to check the output of $@, to avoid missing mistakes such as 548unintended C<eval> failures due to incorrect C<@INC>) 549 550Specifically, this option prepends C<valgrind> C<--error-exitcode=124> to 551the command line that runs the testcase, to cause valgrind to exit non-zero 552if it detects errors, with the assumption that the test program itself 553always exits with zero. If you require more flexibility than this, either 554specify your C<valgrind> invocation explicitly as part of the test case, or 555use a wrapper script to control the command line or massage the exit codes. 556 557In order for the test program to be seen as a perl script to valgrind 558(rather than a shell script), the first line must be one of the following 559 560 #!./perl 561 #!./miniperl 562 563=item * 564 565--test-build 566 567Test that the build completes, without running any test case. 568 569By default, if the build for the desired I<target> fails to complete, 570F<bisect-runner.pl> reports a I<skip> back to C<git bisect>, the assumption 571being that one wants to find a commit which changed state "builds && passes" 572to "builds && fails". If instead one is interested in which commit broke the 573build (possibly for particular F<Configure> options), use I<--test-build> 574to treat a build failure as a failure, not a "skip". 575 576Often this option isn't as useful as it first seems, because I<any> build 577failure will be reported to C<git bisect> as a failure, not just the failure 578that you're interested in. Generally, to debug a particular problem, it's 579more useful to use a I<target> that builds properly at the point of interest, 580and then a test case that runs C<make>. For example: 581 582 .../Porting/bisect.pl --start=perl-5.000 --end=perl-5.002 \ 583 --expect-fail --force-manifest --target=miniperl make perl 584 585will find the first revision capable of building L<DynaLoader> and then 586F<perl>, without becoming confused by revisions where F<miniperl> won't 587even link. 588 589=item * 590 591--module module1,module2,... 592 593Install this (or these) module(s), die when it (the last of those) 594cannot be updated to the current version. 595 596Misnomer. the argument can be any argument that can be passed to CPAN 597shell's install command. B<But>: since we only have the uptodate 598command to verify that an install has taken place, we are unable to 599determine success for arguments like 600MSCHWERN/Test-Simple-1.005000_005.tar.gz. 601 602In so far, it is not such a misnomer. 603 604Note that this and I<--with-module> will both require a C<CPAN::MyConfig>. 605If F<$ENV{HOME}/.cpan/CPAN/MyConfig.pm> does not exist, a CPAN shell will 606be started up for you so you can configure one. Feel free to let 607CPAN pick defaults for you. Enter 'quit' when you are done, and 608then everything should be all set. Alternatively, you may 609specify a custom C<CPAN::MyConfig> by using I<--cpan-config-dir>. 610 611Also, if you want to bisect a module that needs a display (like 612TK) and you don't want random screens appearing and disappearing 613on your computer while you're working, you can do something like 614this: 615 616In a terminal: 617 618 $ while true; do date ; if ! ps auxww | grep -v grep \ 619 | grep -q Xvfb; then Xvfb :121 & fi; echo -n 'sleeping 60 '; \ 620 sleep 60; done 621 622And then: 623 624 DISPLAY=":121" .../Porting/bisect.pl --module=TK 625 626(Some display alternatives are vncserver and Xnest.) 627 628=item * 629 630--with-module module1,module2,... 631 632Like I<--module> above, except this simply installs the requested 633modules and they can then be used in other tests. 634 635For example: 636 637 .../Porting/bisect.pl --with-module=Moose -e 'use Moose; ...' 638 639=item * 640 641--no-module-tests 642 643Use in conjunction with I<--with-module> to install the modules without 644running their tests. This can be a big time saver. 645 646For example: 647 648 .../Porting/bisect.pl --with-module=Moose --no-module-tests \ 649 -e 'use Moose; ...' 650 651=item * 652 653--test-module 654 655This is like I<--module>, but just runs the module's tests, instead of 656installing it. 657 658WARNING: This is a somewhat experimental option, known to work on recent 659CPAN shell versions. If you use this option and strange things happen, 660please report them. 661 662Usually, you can just use I<--module>, but if you are getting inconsistent 663installation failures and you just want to see when the tests started 664failing, you might find this option useful. 665 666=item * 667 668--cpan-config-dir /home/blah/custom 669 670If defined, this will cause L<CPAN> to look for F<CPAN/MyConfig.pm> inside of 671the specified directory, instead of using the default config of 672F<$ENV{HOME}/.cpan/>. 673 674If no default config exists, a L<CPAN> shell will be fired up for you to 675configure things. Letting L<CPAN> automatically configure things for you 676should work well enough. You probably want to choose I<manual> instead of 677I<local::lib> if it asks. When you're finished with configuration, just 678type I<q> and hit I<ENTER> and the bisect should continue. 679 680=item * 681 682--force-manifest 683 684By default, a build will "skip" if any files listed in F<MANIFEST> are not 685present. Usually this is useful, as it avoids false-failures. However, there 686are some long ranges of commits where listed files are missing, which can 687cause a bisect to abort because all that remain are skipped revisions. 688 689In these cases, particularly if the test case uses F<miniperl> and no modules, 690it may be more useful to force the build to continue, even if files 691F<MANIFEST> are missing. 692 693=item * 694 695--force-regen 696 697Run C<make regen_headers> before building F<miniperl>. This may fix a build 698that otherwise would skip because the generated headers at that revision 699are stale. It's not the default because it conceals this error in the true 700state of such revisions. 701 702=item * 703 704--expect-pass [0|1] 705 706C<--expect-pass=0> is equivalent to C<--expect-fail>. I<1> is the default. 707 708=item * 709 710--timeout I<seconds> 711 712Run the testcase with the given timeout. If this is exceeded, kill it (and 713by default all its children), and treat it as a failure. 714 715=item * 716 717--setpgrp 718 719Run the testcase in its own process group. Specifically, call C<setpgrp 0, 0> 720just before C<exec>-ing the user testcase. The default is not to set the 721process group, unless a timeout is used. 722 723=item * 724 725--all-fixups 726 727F<bisect-runner.pl> will minimally patch various files on a platform and 728version dependent basis to get the build to complete. Normally it defers 729doing this as long as possible - C<.SH> files aren't patched until after 730F<Configure> is run, and C<C> and C<XS> code isn't patched until after 731F<miniperl> is built. If C<--all-fixups> is specified, all the fixups are 732done before running C<Configure>. In rare cases adding this may cause a 733bisect to abort, because an inapplicable patch or other fixup is attempted 734for a revision which would usually have already I<skip>ped. If this happens, 735please report it as a bug, giving the OS and problem revision. 736 737=item * 738 739--early-fixup file 740 741=item * 742 743--late-fixup file 744 745Specify a file containing a patch or other fixup for the source code. The 746action to take depends on the first line of the fixup file 747 748=over 4 749 750=item * 751 752C<#!perl> 753 754If the first line starts C<#!perl> then the file is run using C<$^X> 755 756=item * 757 758C<#!/absolute/path> 759 760If a shebang line is present the file is executed using C<system> 761 762=item * 763 764C<I<filename> =~ /I<pattern>/> 765 766=item * 767 768C<I<filename> !~ /I<pattern>/> 769 770If I<filename> does not exist then the fixup file's contents are ignored. 771Otherwise, for C<=~>, if it contains a line matching I<pattern>, then the 772file is fed to C<patch -p1> on standard input. For C<=~>, the patch is 773applied if no lines match the pattern. 774 775As the empty pattern in Perl is a special case (it matches the most recent 776successful match) which is not useful here, the treatment of an empty pattern 777is special-cased. C<I<filename> =~ //> applies the patch if filename is 778present. C<I<filename> !~ //> applies the patch if filename missing. This 779makes it easy to unconditionally apply patches to files, and to use a patch 780as a way of creating a new file. 781 782=item * 783 784Otherwise, the file is assumed to be a patch, and always applied. 785 786=back 787 788I<early-fixup>s are applied before F<./Configure> is run. I<late-fixup>s are 789applied just after F<./Configure> is run. 790 791These options can be specified more than once. I<file> is actually expanded 792as a glob pattern. Globs that do not match are errors, as are missing files. 793 794=item * 795 796--no-clean 797 798Tell F<bisect-runner.pl> not to clean up after the build. This allows one 799to use F<bisect-runner.pl> to build the current particular perl revision for 800interactive testing, or for debugging F<bisect-runner.pl>. 801 802Passing this to F<bisect.pl> will likely cause the bisect to fail badly. 803 804=item * 805 806--validate 807 808Test that all stable (.0) revisions can be built. By default, attempts to 809build I<blead>, then tagged stable releases in reverse order down to 810I<perl-5.002> (or I<perl5.005> on a case insensitive file system). Stops at 811the first failure, without cleaning the checkout. Use I<--start> to specify 812the earliest revision to test, I<--end> to specify the most recent. Useful 813for validating a new OS/CPU/compiler combination. For example 814 815 ../perl/Porting/bisect.pl --validate -le 'print "Hello from $]"' 816 817If no testcase is specified, the default is to use F<t/TEST> to run 818F<t/base/*.t> 819 820=item * 821 822--check-args 823 824Validate the options and arguments, and exit silently if they are valid. 825 826=item * 827 828--check-shebang 829 830Validate that the test case isn't an executable file with a 831C<#!/usr/bin/perl> line (or similar). As F<bisect-runner.pl> does B<not> 832automatically prepend C<./perl> to the test case, a I<#!> line specifying an 833external F<perl> binary will cause the test case to always run with I<that> 834F<perl>, not the F<perl> built by the bisect runner. Likely this is not what 835you wanted. If your test case is actually a wrapper script to run other 836commands, you should run it with an explicit interpreter, to be clear. For 837example, instead of C<../perl/Porting/bisect.pl ~/test/testcase.pl> you'd 838run C<../perl/Porting/bisect.pl /usr/bin/perl ~/test/testcase.pl> 839 840=item * 841 842--gold 843 844Revision to use when checking out known-good recent versions of files, 845such as F<hints/freebsd.sh>. F<bisect-runner.pl> defaults this to I<blead>, 846but F<bisect.pl> will default it to the most recent stable release. 847 848=item * 849 850--usage 851 852=item * 853 854--help 855 856=item * 857 858-? 859 860Display the usage information and exit. 861 862=back 863 864=head1 ABOUT BISECTION 865 866The process is all about identifying the commit that caused some change 867in behaviour - maybe good, maybe bad. But it is built around C<git bisect>, 868which is much more specifically aimed at finding "what broke the build". 869C<git> terminology embeds that assumption - commits earlier than the 870target commit are "good" commits, those at or later than the target commit 871are "bad" commits. 872 873The default behaviour of F<bisect.pl> mimics this - you supply some code 874that I<fails> with a perl built B<at or after> the target commit and 875I<succeeds> with a perl built B<before> the target commit, and F<bisect.pl> 876will find the target commit. 877 878The F<bisect.pl> option C<--expect-fail> reverses those expectations 879(and changes nothing else). So with C<--expect-fail>, you should supply 880code that I<fails> only with a perl built B<before> the target commit, 881and I<succeeds> with a perl built B<at or after> the target commit. 882 883By default, I<failure> is a piece of perl code that terminates with 884a non-zero exit code, e.g. by calling C<die()>. Options that change what 885is interpreted as failure include C<--crash>, C<--test-build> and C<--match>. 886 887=head1 EXAMPLES 888 889=head2 Code has started to crash under C<miniperl> 890 891=over 4 892 893=item * Problem 894 895Under C<make minitest> (but not under C<make test_harness>), F<t/re/pat.t> was 896failing to compile. What was the first commit at which that compilation 897failure could be observed? 898 899=item * Solution 900 901Extract code from the test file at the point where C<./miniperl -Ilib -c> was 902showing a compilation failure. Use that in bisection with the C<miniperl> 903target. 904 905 .../Porting/bisect.pl --target=miniperl --start=2ec4590e \ 906 -e 'q|ace| =~ /c(?=.$)/; $#{^CAPTURE} == -1); exit 0;' 907 908=item * Reference 909 910L<GH issue 17293|https://github.com/Perl/perl5/issues/17293> 911 912=back 913 914=head2 Blead breaks CPAN on threaded builds only 915 916=over 4 917 918=item * Problem 919 920Tests in CPAN module XML::Parser's test suite had begun to fail when tested 921against blead in threaded builds only. 922 923=item * Solution 924 925Provide F<Configure>-style switch to bisection program. Straightforward use 926of the C<--module> switch. 927 928 .../Porting/bisect.pl -Duseithreads \ 929 --start=6256cf2c \ 930 --end=f6f85064 \ 931 --module=XML::Parser 932 933=item * Reference 934 935L<GH issue 16918|https://github.com/Perl/perl5/issues/16918> 936 937=back 938 939=head2 Point in time where code started to segfault is unknown 940 941=over 4 942 943=item * Problem 944 945User submitted code sample which when run caused F<perl> to segfault, but did 946not claim that this was a recent change. 947 948=item * Solution 949 950Used locally installed production releases of perl (previously created by 951F<perlbrew>) to identify the first production release at which the code would 952not compile. Used that information to shorten bisection time. 953 954 .../perl Porting/bisect.pl \ 955 --start=v5.14.4 \ 956 --end=v5.16.3 \ 957 --crash -- ./perl -Ilib /tmp/gh-17333-map.pl 958 959 $ cat gh-17333-map.pl 960 961 @N = 1..5; 962 map { pop @N } @N; 963 964=item * Reference 965 966L<GH issue 17333|https://github.com/Perl/perl5/issues/17333> 967 968=back 969 970=head2 Interaction of debug flags caused crash on C<-DDEBUGGING> builds 971 972=over 4 973 974=item * Problem 975 976In C<-DDEBUGGING> builds, the debug flags C<Xvt> would crash a program when 977F<strict.pm> was loaded via C<require> or C<use>. 978 979=item * Solution 980 981Two-stage solution. In each stage, to shorten debugging time investigator 982made use of existing set of production releases of F<perl> built with 983C<-DDEBUGGING>. 984 985=over 4 986 987=item * Stage 1 988 989Investigator used existing C<-DDEBUGGING> builds to determine the production 990cycle in which crash first appeared. Then: 991 992 .../perl/Porting/bisect.pl \ 993 --start v5.20.0 \ 994 --end v5.22.1 \ 995 -DDEBUGGING \ 996 --target miniperl \ 997 --crash \ 998 -- ./miniperl -Ilib -DXvt -Mstrict -e 1 999 1000First bad commit was identified as 1001L<ed958fa315|https://github.com/Perl/perl5/commit/ed958fa315>. 1002 1003=item * Stage 2 1004 1005A second investigator was able to create a reduction of the code needed to 1006trigger a crash, then used this reduced case and the commit reported at the 1007end of Stage 1 to further bisect. 1008 1009 .../perl/Porting/bisect.pl \ 1010 --start v5.18.4 \ 1011 --end ed958fa315 \ 1012 -DDEBUGGING \ 1013 --target miniperl \ 1014 --crash \ 1015 -- ./miniperl -Ilib -DXv -e '{ my $n=1; *foo= sub () { $n }; }' 1016 1017=back 1018 1019The first bisect determined the point at which code was introduced to 1020F<strict.pm> that triggered the problem. With an understanding of the trigger, 1021the second bisect then determined the point at which such a trigger started 1022causing a crash. 1023 1024* Reference 1025 1026L<GH issue 193463|https://github.com/Perl/perl5/issues/19463> 1027 1028=back 1029 1030=head2 When did perl start failing to build on a certain platform using C<g++> as the C-compiler? 1031 1032=over 4 1033 1034=item * Problem 1035 1036On NetBSD-8.0, C<perl> had never been smoke-tested using C<g++> as the 1037C-compiler. Once this was done, it became evident that changes in that 1038version of the operating system's code were incompatible with some C<perl> 1039source written long before that OS version was ever released! 1040 1041=item * Solution 1042 1043Bisection range was first narrowed using existing builds at release tags. 1044Then, bisection specified the C-compiler via C<Configure>-style switch and 1045used C<--test-build> to identify the commit which "broke" the build. 1046 1047 .../perl Porting/bisect.pl \ 1048 -Dcc=g++ \ 1049 --test-build \ 1050 --start=v5.21.6 \ 1051 --end=v5.21.7 1052 1053Then, problem was discussed with knowledgeable NetBSD user. 1054 1055=item * Reference 1056 1057L<GH issue 17381|https://github.com/Perl/perl5/issues/17381> 1058 1059=back 1060 1061=head2 When did a test file start to emit warnings? 1062 1063=over 4 1064 1065=item * Problem 1066 1067When F<dist/Tie-File/t/43_synopsis> was run as part of C<make test>, we 1068observed warnings not previously seen. At what commit were those warnings 1069first emitted? 1070 1071=item * Solution 1072 1073We know that when this test file was first committed to blead, no warnings 1074were observed and there was no output to C<STDERR>. So that commit becomes 1075the value for C<--start>. 1076 1077Since the test file in question is for a CPAN distribution maintained by core, 1078we must prepare to run that test by including C<--target=test_prep> in the 1079bisection invocation. We then run the test file in a way that captures 1080C<STDERR> in a file. If that file has non-zero size, then we have presumably 1081captured the newly seen warnings. 1082 1083 export ERR="/tmp/err" 1084 1085 .../perl Porting/bisect.pl \ 1086 --start=507614678018ae1abd55a22e9941778c65741ba3 \ 1087 --end=d34b46d077dcfc479c36f65b196086abd7941c76 \ 1088 --target=test_prep \ 1089 -e 'chdir("t"); 1090 system( 1091 "./perl harness ../dist/Tie-File/t/43_synopsis.t 1092 2>$ENV{ERR}" 1093 ); 1094 -s $ENV{ERR} and die "See $ENV{ERR} for warnings thrown";' 1095 1096Bisection pointed to a commit where strictures and warnings were first turned 1097on throughout the F<dist/Tie-File/> directory. 1098 1099=item * Reference 1100 1101L<Commit 125e1a3|https://github.com/Perl/perl5/commit/125e1a36a939> 1102 1103=back 1104 1105=head2 When did a one-liner start to emit warnings? 1106 1107=over 4 1108 1109=item * Problem 1110 1111In L<GH issue 21555|https://github.com/Perl/perl5/issues/21555>, it was 1112reported that the following one-liner was not emitting warnings in perl-5.16 1113but was in perl-5.26 and later releases. 1114 1115 perl -we '"ab" =~ /.{-1,4}/;' 1116 1117The reporter's concern was the negative repeat in this (generated) regular 1118expression. The warning being emitted was: 1119 1120 Unescaped left brace in regex is passed through in regex; 1121 marked by <-- HERE in m/.{ <-- HERE -1,4}/ at -e line 1. 1122 1123At what commit was that warning first emitted? 1124 1125=item * Solution 1126 1127We used F<perlbrew> to narrow down the range needing testing to the 5.25 1128development cycle. We then bisected with the C<--one-liner> switch and the 1129following invocation: 1130 1131 export ERR=/tmp/err; rm $ERR 1132 1133 perl Porting/bisect.pl \ 1134 --start=v5.24.0 \ 1135 --end=v5.26.0 \ 1136 --one-liner 'system(qq|./perl -we "q{ab} =~ /.{-1,4}/" 2>$ENV{ERR}|); 1137 die "See $ENV{ERR} for warnings thrown" if -s $ENV{ERR};' 1138 1139Bisection pointed to a commit where a modification had been made to a warning. 1140 1141=item * Reference 1142 1143L<Commit 8e84dec|https://github.com/Perl/perl5/commit/8e84dec289> 1144 1145=back 1146 1147=head2 When did perl stop segfaulting on certain code? 1148 1149=over 4 1150 1151=item * Problem 1152 1153It was reported that perl was segfaulting on this code in perl-5.36.0: 1154 1155 @a = sort{eval"("}1,2 1156 1157Bisection subsequently identified the commit at which the segfaulting first 1158appeared. But when we ran that code against what was then the HEAD of blead 1159(L<Commit 70d911|https://github.com/Perl/perl5/commit/70d911984f>), we got no 1160segfault. So the next question we faced was: At what commit did the 1161segfaulting cease? 1162 1163=item * Solution 1164 1165Because the code in question loaded no libraries, it was amenable to bisection 1166with C<miniperl>, thereby shortening bisection time considerably. 1167 1168 perl Porting/bisect.pl \ 1169 --start=v5.36.0 \ 1170 --target=miniperl \ 1171 --expect-fail -e '@a = sort{eval"("}1,2' 1172 1173=item * Reference 1174 1175L<GH issue 20261|https://github.com/Perl/perl5/issues/20261> 1176 1177=back 1178 1179=head2 When did perl stop emitting warnings when running on certain code? 1180 1181=over 4 1182 1183=item * Background 1184 1185Most of the time, we bisect in order to identify the first "bad" commit: the 1186first time code failed to compile; the first time the code emitted warnings; 1187and so forth. 1188 1189Some times, however, we want to identify the first "good" commit: the point 1190where the code began to compile; the point where the code no longer emitted 1191warnings; etc. 1192 1193We can use this program for that purpose, but we have to reverse our sense of 1194"good" and "bad" commits. We use the C<--expect-fail> option to do that 1195reversal. 1196 1197=item * Problem 1198 1199It was reported that in an older version of Perl, a warning was being emitted 1200when a program was using the F<bigrat> module and 1201C<Scalar::Util::looks_like_number()> was called passing a non-integral number 1202(I<i.e.,> a rational). 1203 1204 $ perl -wE 'use Scalar::Util; use bigrat; 1205 say "mercy" if Scalar::Util::looks_like_number(1/9);' 1206 1207In perl-5.32, this emitted: 1208 1209 $ Argument "1/9" isn't numeric in addition (+) at 1210 /usr/local/lib/perl5/5.32/Math/BigRat.pm line 1955. 1211 mercy 1212 1213But it was observed that there was no warning in perl-5.36. 1214 1215=item * Solution 1216 1217 $ perl Porting/bisect.pl \ 1218 --start=5624cfff8f \ 1219 --end=b80b9f7fc6 \ 1220 --expect-fail \ 1221 -we 'use Scalar::Util; use bigrat; my @w; 1222 local $SIG{__WARN__} = sub { die }; 1223 print "mercy\n" if Scalar::Util::looks_like_number(1/9)' 1224 1225=item * Reference 1226 1227L<GH issue 20685|https://github.com/Perl/perl5/issues/20685> 1228 1229=item * Problem 1230 1231An issue was identified during use of the Perl debugger, but soon a change in 1232C-level code became suspected. Identifying the breaking commit entailed 1233writing a Perl program which used a dummy C<Devel::*> module. 1234 1235=item * Solution 1236 1237=over 4 1238 1239=item * 1240 1241Create this file: 1242 1243 $ cat /tmp/21564.pl 1244 #!/usr/bin/perl 1245 1246 use strict; no strict 'refs'; 1247 use warnings; 1248 use B qw(svref_2object SVf_IOK); 1249 1250 use v5.10; 1251 1252 my $b = svref_2object(\(${"_</tmp/21564b.pl"}[4])); 1253 unless ($b->FLAGS & SVf_IOK) { 1254 die "Fail!"; 1255 } 1256 say "Ok"; 1257 1258=item * 1259 1260Bisect with an invocation which calls a `perl` debugger program. 1261 1262 $ PERL5DB='sub DB::DB {}' perl Porting/bisect.pl \ 1263 --start=v5.35.5 \ 1264 --end=v5.35.6 \ 1265 -- ./perl -Ilib -d /tmp/21564b.pl 1266 1267=back 1268 1269=item * Reference 1270 1271L<GH issue 21564|https://github.com/Perl/perl5/issues/21564> 1272 1273=back 1274 1275=cut 1276 1277# Ensure we always exit with 255, to cause git bisect to abort. 1278sub croak_255 { 1279 my $message = join '', @_; 1280 if ($message =~ /\n\z/) { 1281 print STDERR $message; 1282 } else { 1283 my (undef, $file, $line) = caller 1; 1284 print STDERR "@_ at $file line $line\n"; 1285 } 1286 exit 255; 1287} 1288 1289sub die_255 { 1290 croak_255(@_); 1291} 1292 1293die_255("$0: Can't build $target") 1294 if defined $target && !grep {@targets} $target; 1295 1296foreach my $phase (qw(early late)) { 1297 next unless $options{"$phase-fixup"}; 1298 my $bail_out; 1299 require File::Glob; 1300 my @expanded; 1301 foreach my $glob (@{$options{"$phase-fixup"}}) { 1302 my @got = File::Glob::bsd_glob($glob); 1303 push @expanded, @got ? @got : $glob; 1304 } 1305 @expanded = sort @expanded; 1306 $options{"$phase-fixup"} = \@expanded; 1307 foreach (@expanded) { 1308 unless (-f $_) { 1309 print STDERR "$phase-fixup '$_' is not a readable file\n"; 1310 ++$bail_out; 1311 } 1312 } 1313 exit 255 if $bail_out; 1314} 1315 1316unless (exists $defines{cc}) { 1317 # If it fails, the heuristic of 63f9ec3008baf7d6 is noisy, and hence 1318 # confusing. 1319 # FIXME - really it should be replaced with a proper test of 1320 # "can we build something?" and a helpful diagnostic if we can't. 1321 # For now, simply move it here. 1322 $defines{cc} = (`ccache -V`, $?) ? 'cc' : 'ccache cc'; 1323} 1324 1325my $j = $options{jobs} ? "-j$options{jobs}" : ''; 1326 1327if (exists $options{make}) { 1328 if (!exists $defines{make}) { 1329 $defines{make} = $options{make}; 1330 } 1331} else { 1332 $options{make} = 'make'; 1333} 1334 1335# Sadly, however hard we try, I don't think that it will be possible to build 1336# modules in ext/ on x86_64 Linux before commit e1666bf5602ae794 on 1999/12/29, 1337# which updated to MakeMaker 3.7, which changed from using a hard coded ld 1338# in the Makefile to $(LD). On x86_64 Linux the "linker" is gcc. 1339 1340sub open_or_die { 1341 my $file = shift; 1342 my $mode = @_ ? shift : '<'; 1343 open my $fh, $mode, $file or croak_255("Can't open $file: $!"); 1344 ${*$fh{SCALAR}} = $file; 1345 return $fh; 1346} 1347 1348sub close_or_die { 1349 my $fh = shift; 1350 return if close $fh; 1351 croak_255("Can't close: $!") unless ref $fh eq 'GLOB'; 1352 croak_255("Can't close ${*$fh{SCALAR}}: $!"); 1353} 1354 1355sub system_or_die { 1356 my $command = '</dev/null ' . shift; 1357 system($command) and croak_255("'$command' failed, \$!=$!, \$?=$?"); 1358} 1359 1360sub run_with_options { 1361 my $options = shift; 1362 my $name = $options->{name}; 1363 $name = "@_" unless defined $name; 1364 1365 my $setgrp = $options->{setpgrp}; 1366 if ($options->{timeout}) { 1367 # Unless you explicitly disabled it on the commandline, set it: 1368 $setgrp = 1 unless defined $setgrp; 1369 } 1370 my $pid = fork; 1371 die_255("Can't fork: $!") unless defined $pid; 1372 if (!$pid) { 1373 if (exists $options->{stdin}) { 1374 open STDIN, '<', $options->{stdin} 1375 or die "Can't open STDIN from $options->{stdin}: $!"; 1376 } 1377 if ($setgrp) { 1378 setpgrp 0, 0 1379 or die "Can't setpgrp 0, 0: $!"; 1380 } 1381 { exec @_ }; 1382 die_255("Failed to start $name: $!"); 1383 } 1384 my $start; 1385 if ($options->{timeout}) { 1386 require Errno; 1387 require POSIX; 1388 die_255("No POSIX::WNOHANG") 1389 unless &POSIX::WNOHANG; 1390 $start = time; 1391 $SIG{ALRM} = sub { 1392 my $victim = $setgrp ? -$pid : $pid; 1393 my $delay = 1; 1394 kill 'TERM', $victim; 1395 waitpid(-1, &POSIX::WNOHANG); 1396 while (kill 0, $victim) { 1397 sleep $delay; 1398 waitpid(-1, &POSIX::WNOHANG); 1399 $delay *= 2; 1400 if ($delay > 8) { 1401 if (kill 'KILL', $victim) { 1402 print STDERR "$0: Had to kill 'KILL', $victim\n" 1403 } elsif (! $!{ESRCH}) { 1404 print STDERR "$0: kill 'KILL', $victim failed: $!\n"; 1405 } 1406 last; 1407 } 1408 } 1409 report_and_exit(0, 'No timeout', 'Timeout', "when running $name"); 1410 }; 1411 alarm $options->{timeout}; 1412 } 1413 waitpid $pid, 0 1414 or die_255("wait for $name, pid $pid failed: $!"); 1415 alarm 0; 1416 if ($options->{timeout}) { 1417 my $elapsed = time - $start; 1418 if ($elapsed / $options->{timeout} > 0.8) { 1419 print STDERR "$0: Beware, took $elapsed seconds of $options->{timeout} permitted to run $name\n"; 1420 } 1421 } 1422 return $?; 1423} 1424 1425sub extract_from_file { 1426 my ($file, $rx, $default) = @_; 1427 my $fh = open_or_die($file); 1428 while (<$fh>) { 1429 my @got = $_ =~ $rx; 1430 return wantarray ? @got : $got[0] 1431 if @got; 1432 } 1433 return $default if defined $default; 1434 return; 1435} 1436 1437sub edit_file { 1438 my ($file, $munger) = @_; 1439 my $fh = open_or_die($file); 1440 my $orig = do { 1441 local $/; 1442 <$fh>; 1443 }; 1444 die_255("Can't read $file: $!") unless defined $orig && close $fh; 1445 my $new = $munger->($orig); 1446 return if $new eq $orig; 1447 $fh = open_or_die($file, '>'); 1448 print $fh $new or die_255("Can't print to $file: $!"); 1449 close_or_die($fh); 1450} 1451 1452# AIX supplies a pre-historic patch program, which certainly predates Linux 1453# and is probably older than NT. It can't cope with unified diffs. Meanwhile, 1454# it's hard enough to get git diff to output context diffs, let alone git show, 1455# and nearly all the patches embedded here are unified. So it seems that the 1456# path of least resistance is to convert unified diffs to context diffs: 1457 1458sub process_hunk { 1459 my ($from_out, $to_out, $has_from, $has_to, $delete, $add) = @_; 1460 ++$$has_from if $delete; 1461 ++$$has_to if $add; 1462 1463 if ($delete && $add) { 1464 $$from_out .= "! $_\n" foreach @$delete; 1465 $$to_out .= "! $_\n" foreach @$add; 1466 } elsif ($delete) { 1467 $$from_out .= "- $_\n" foreach @$delete; 1468 } elsif ($add) { 1469 $$to_out .= "+ $_\n" foreach @$add; 1470 } 1471} 1472 1473# This isn't quite general purpose, as it can't cope with 1474# '\ No newline at end of file' 1475sub ud2cd { 1476 my $diff_in = shift; 1477 my $diff_out = ''; 1478 1479 # Stuff before the diff 1480 while ($diff_in =~ s/\A(?!\*\*\* )(?!--- )([^\n]*\n?)//ms && length $1) { 1481 $diff_out .= $1; 1482 } 1483 1484 if (!length $diff_in) { 1485 die_255("That didn't seem to be a diff"); 1486 } 1487 1488 if ($diff_in =~ /\A\*\*\* /ms) { 1489 warn "Seems to be a context diff already\n"; 1490 return $diff_out . $diff_in; 1491 } 1492 1493 # Loop for files 1494 FILE: while (1) { 1495 if ($diff_in =~ s/\A((?:diff |index )[^\n]+\n)//ms) { 1496 $diff_out .= $1; 1497 next; 1498 } 1499 if ($diff_in !~ /\A--- /ms) { 1500 # Stuff after the diff; 1501 return $diff_out . $diff_in; 1502 } 1503 $diff_in =~ s/\A([^\n]+\n?)//ms; 1504 my $line = $1; 1505 die_255("Can't parse '$line'") unless $line =~ s/\A--- /*** /ms; 1506 $diff_out .= $line; 1507 $diff_in =~ s/\A([^\n]+\n?)//ms; 1508 $line = $1; 1509 die_255("Can't parse '$line'") unless $line =~ s/\A\+\+\+ /--- /ms; 1510 $diff_out .= $line; 1511 1512 # Loop for hunks 1513 while (1) { 1514 next FILE 1515 unless $diff_in =~ s/\A\@\@ (-([0-9]+),([0-9]+) \+([0-9]+),([0-9]+)) \@\@[^\n]*\n?//; 1516 my ($hunk, $from_start, $from_count, $to_start, $to_count) 1517 = ($1, $2, $3, $4, $5); 1518 my $from_end = $from_start + $from_count - 1; 1519 my $to_end = $to_start + $to_count - 1; 1520 my ($from_out, $to_out, $has_from, $has_to, $add, $delete); 1521 while (length $diff_in && ($from_count || $to_count)) { 1522 die_255("Confused in $hunk") 1523 unless $diff_in =~ s/\A([^\n]*)\n//ms; 1524 my $line = $1; 1525 $line = ' ' unless length $line; 1526 if ($line =~ /^ .*/) { 1527 process_hunk(\$from_out, \$to_out, \$has_from, \$has_to, 1528 $delete, $add); 1529 undef $delete; 1530 undef $add; 1531 $from_out .= " $line\n"; 1532 $to_out .= " $line\n"; 1533 --$from_count; 1534 --$to_count; 1535 } elsif ($line =~ /^-(.*)/) { 1536 push @$delete, $1; 1537 --$from_count; 1538 } elsif ($line =~ /^\+(.*)/) { 1539 push @$add, $1; 1540 --$to_count; 1541 } else { 1542 die_255("Can't parse '$line' as part of hunk $hunk"); 1543 } 1544 } 1545 process_hunk(\$from_out, \$to_out, \$has_from, \$has_to, 1546 $delete, $add); 1547 die_255("No lines in hunk $hunk") 1548 unless length $from_out || length $to_out; 1549 die_255("No changes in hunk $hunk") 1550 unless $has_from || $has_to; 1551 $diff_out .= "***************\n"; 1552 $diff_out .= "*** $from_start,$from_end ****\n"; 1553 $diff_out .= $from_out if $has_from; 1554 $diff_out .= "--- $to_start,$to_end ----\n"; 1555 $diff_out .= $to_out if $has_to; 1556 } 1557 } 1558} 1559 1560{ 1561 my $use_context; 1562 1563 sub placate_patch_prog { 1564 my $patch = shift; 1565 1566 if (!defined $use_context) { 1567 my $version = `patch -v 2>&1`; 1568 die_255("Can't run `patch -v`, \$?=$?, bailing out") 1569 unless defined $version; 1570 if ($version =~ /Free Software Foundation/) { 1571 $use_context = 0; 1572 } elsif ($version =~ /Header: patch\.c,v.*\blwall\b/) { 1573 # The system patch is older than Linux, and probably older than 1574 # Windows NT. 1575 $use_context = 1; 1576 } elsif ($version =~ /Header: patch\.c,v.*\babhinav\b/) { 1577 # Thank you HP. No, we have no idea *which* version this is: 1578 # $Header: patch.c,v 76.1.1.2.1.3 2001/12/03 12:24:52 abhinav Exp $ 1579 $use_context = 1; 1580 } else { 1581 # Don't know. 1582 $use_context = 0; 1583 } 1584 } 1585 1586 return $use_context ? ud2cd($patch) : $patch; 1587 } 1588} 1589 1590sub apply_patch { 1591 my ($patch, $what, $files) = @_; 1592 $what = 'patch' unless defined $what; 1593 unless (defined $files) { 1594 # Handle context diffs (*** ---) and unified diffs (+++ ---) 1595 # and ignore trailing "garbage" after the filenames 1596 $patch =~ m!^[-*]{3} [ab]/(\S+)[^\n]*\n[-+]{3} [ba]/\1!sm; 1597 $files = " $1"; 1598 } 1599 my $patch_to_use = placate_patch_prog($patch); 1600 open my $fh, '|-', 'patch', '-p1' or die_255("Can't run patch: $!"); 1601 print $fh $patch_to_use; 1602 return if close $fh; 1603 print STDERR "Patch is <<'EOPATCH'\n${patch}EOPATCH\n"; 1604 print STDERR "\nConverted to a context diff <<'EOCONTEXT'\n${patch_to_use}EOCONTEXT\n" 1605 if $patch_to_use ne $patch; 1606 die_255("Can't $what$files: $?, $!"); 1607} 1608 1609sub patch_from_commit { 1610 my ($revert, $commit, @files) = @_; 1611 my $flags = $revert ? '-R ' : ''; 1612 my $patch = `git show --src-prefix=a/ --dst-prefix=b/ $flags$commit @files`; 1613 if (!defined $patch) { 1614 my $thing = $revert ? 'revert commit' : 'commit'; 1615 die_255("Can't get $thing $commit for @files: $?") if @files; 1616 die_255("Can't get $thing $commit: $?"); 1617 } 1618 return $patch; 1619} 1620 1621sub apply_commit { 1622 my ($commit, @files) = @_; 1623 my $patch = patch_from_commit(undef, $commit, @files); 1624 apply_patch($patch, "patch $commit", @files ? " for @files" : ''); 1625} 1626 1627sub revert_commit { 1628 my ($commit, @files) = @_; 1629 my $patch = patch_from_commit('revert', $commit, @files); 1630 apply_patch($patch, "revert $commit", @files ? " for @files" : ''); 1631} 1632 1633sub checkout_file { 1634 my ($file, $commit) = @_; 1635 $commit ||= $options{gold} || 'blead'; 1636 system "git show $commit:$file > $file </dev/null" 1637 and die_255("Could not extract $file at revision $commit"); 1638} 1639 1640sub check_shebang { 1641 my $file = shift; 1642 return unless -e $file; 1643 my $fh = open_or_die($file); 1644 my $line = <$fh>; 1645 return if $line =~ $run_with_our_perl; 1646 if (!-x $file) { 1647 die_255("$file is not executable. 1648system($file, ...) is always going to fail. 1649 1650Bailing out"); 1651 } 1652 return unless $line =~ m{\A#!(/\S+/perl\S*)\s}; 1653 die_255("$file will always be run by $1 1654It won't be tested by the ./perl we build. 1655If you intended to run it with that perl binary, please change your 1656test case to 1657 1658 $1 @ARGV 1659 1660If you intended to test it with the ./perl we build, please change your 1661test case to 1662 1663 ./perl -Ilib @ARGV 1664 1665[You may also need to add -- before ./perl to prevent that -Ilib as being 1666parsed as an argument to bisect.pl] 1667 1668Bailing out"); 1669} 1670 1671sub clean { 1672 if ($options{clean}) { 1673 # Needed, because files that are build products in this checked out 1674 # version might be in git in the next desired version. 1675 system 'git clean -qdxf </dev/null'; 1676 # Needed, because at some revisions the build alters checked out files. 1677 # (eg pod/perlapi.pod). Also undoes any changes to makedepend.SH 1678 system 'git reset --hard HEAD </dev/null'; 1679 } 1680} 1681 1682sub skip { 1683 my $reason = shift; 1684 clean(); 1685 warn "skipping - $reason"; 1686 exit 125; 1687} 1688 1689sub report_and_exit { 1690 my ($good, $pass, $fail, $desc) = @_; 1691 1692 clean(); 1693 1694 my $got = ($options{'expect-pass'} ? $good : !$good) ? 'good' : 'bad'; 1695 if ($good) { 1696 print "$got - $pass $desc\n"; 1697 } else { 1698 print "$got - $fail $desc\n"; 1699 } 1700 1701 exit($got eq 'bad'); 1702} 1703 1704sub run_report_and_exit { 1705 my $ret = run_with_options({setprgp => $options{setpgrp}, 1706 timeout => $options{timeout}, 1707 }, @_); 1708 $ret &= 0xff if $options{crash}; 1709 report_and_exit(!$ret, 'zero exit from', 'non-zero exit from', "@_"); 1710} 1711 1712sub match_and_exit { 1713 my ($target, @globs) = @_; 1714 my $matches = 0; 1715 my $re = qr/$match/; 1716 my @files; 1717 1718 if (@globs) { 1719 require File::Glob; 1720 foreach (sort map { File::Glob::bsd_glob($_)} @globs) { 1721 if (!-f $_ || !-r _) { 1722 warn "Skipping matching '$_' as it is not a readable file\n"; 1723 } else { 1724 push @files, $_; 1725 } 1726 } 1727 } else { 1728 local $/ = "\0"; 1729 @files = defined $target ? `git ls-files -o -z`: `git ls-files -z`; 1730 chomp @files; 1731 } 1732 1733 foreach my $file (@files) { 1734 my $fh = open_or_die($file); 1735 while (<$fh>) { 1736 if ($_ =~ $re) { 1737 ++$matches; 1738 if (/[^[:^cntrl:]\h\v]/) { # Matches non-spacing non-C1 controls 1739 print "Binary file $file matches\n"; 1740 } else { 1741 $_ .= "\n" unless /\n\z/; 1742 print "$file: $_"; 1743 } 1744 } 1745 } 1746 close_or_die($fh); 1747 } 1748 report_and_exit($matches, 1749 $matches == 1 ? '1 match for' : "$matches matches for", 1750 'no matches for', $match); 1751} 1752 1753# Not going to assume that system perl is yet new enough to have autodie 1754system_or_die('git clean -dxf'); 1755 1756if (!defined $target) { 1757 match_and_exit(undef, @ARGV) if $match; 1758 $target = 'test_prep'; 1759} elsif ($target eq 'none') { 1760 match_and_exit(undef, @ARGV) if $match; 1761 run_report_and_exit(@ARGV); 1762} 1763 1764skip('no Configure - is this the //depot/perlext/Compiler branch?') 1765 unless -f 'Configure'; 1766 1767my $case_insensitive; 1768{ 1769 my ($dev_C, $ino_C) = stat 'Configure'; 1770 die_255("Could not stat Configure: $!") unless defined $dev_C; 1771 my ($dev_c, $ino_c) = stat 'configure'; 1772 ++$case_insensitive 1773 if defined $dev_c && $dev_C == $dev_c && $ino_C == $ino_c; 1774} 1775 1776# This changes to PERL_VERSION in 4d8076ea25903dcb in 1999 1777my $major 1778 = extract_from_file('patchlevel.h', 1779 qr/^#define\s+(?:PERL_VERSION|PATCHLEVEL)\s+(\d+)\s/, 1780 0); 1781 1782my $unfixable_db_file; 1783 1784if ($major < 10 1785 && !extract_from_file('ext/DB_File/DB_File.xs', 1786 qr!^#else /\* Berkeley DB Version > 2 \*/$!)) { 1787 # This DB_File.xs is really too old to patch up. 1788 # Skip DB_File, unless we're invoked with an explicit -Unoextensions 1789 if (!exists $defines{noextensions}) { 1790 $defines{noextensions} = 'DB_File'; 1791 } elsif (defined $defines{noextensions}) { 1792 $defines{noextensions} .= ' DB_File'; 1793 } 1794 ++$unfixable_db_file; 1795} 1796 1797patch_Configure(); 1798patch_hints(); 1799if ($options{'all-fixups'}) { 1800 patch_SH(); 1801 patch_C(); 1802 patch_ext(); 1803 patch_t(); 1804} 1805apply_fixups($options{'early-fixup'}); 1806 1807# if Encode is not needed for the test, you can speed up the bisect by 1808# excluding it from the runs with -Dnoextensions=Encode 1809# ccache is an easy win. Remove it if it causes problems. 1810# Commit 1cfa4ec74d4933da adds ignore_versioned_solibs to Configure, and sets it 1811# to true in hints/linux.sh 1812# On dromedary, from that point on, Configure (by default) fails to find any 1813# libraries, because it scans /usr/local/lib /lib /usr/lib, which only contain 1814# versioned libraries. Without -lm, the build fails. 1815# Telling /usr/local/lib64 /lib64 /usr/lib64 works from that commit onwards, 1816# until commit faae14e6e968e1c0 adds it to the hints. 1817# However, prior to 1cfa4ec74d4933da telling Configure the truth doesn't work, 1818# because it will spot versioned libraries, pass them to the compiler, and then 1819# bail out pretty early on. Configure won't let us override libswanted, but it 1820# will let us override the entire libs list. 1821 1822foreach (@{$options{A}}) { 1823 push @paths, $1 if /^libpth=(.*)/s; 1824} 1825 1826unless (extract_from_file('Configure', 'ignore_versioned_solibs')) { 1827 # Before 1cfa4ec74d4933da, so force the libs list. 1828 1829 my @libs; 1830 # This is the current libswanted list from Configure, less the libs removed 1831 # by current hints/linux.sh 1832 foreach my $lib (qw(sfio socket inet nsl nm ndbm gdbm dbm db malloc dl 1833 ld sun m crypt sec util c cposix posix ucb BSD)) { 1834 foreach my $dir (@paths) { 1835 # Note the wonderful consistency of dot-or-not in the config vars: 1836 next unless -f "$dir/lib$lib.$Config{dlext}" 1837 || -f "$dir/lib$lib$Config{lib_ext}"; 1838 push @libs, "-l$lib"; 1839 last; 1840 } 1841 } 1842 $defines{libs} = \@libs unless exists $defines{libs}; 1843} 1844 1845# a4f3eea9be6bcf3c added a test for GNU libc to Configure 1846# Prior to that we really don't get much choice but to force usenm off 1847# everywhere (and modern systems are fast enough that this doesn't matter) 1848$defines{usenm} = undef 1849 if $major < 4 && !exists $defines{usenm}; 1850 1851my ($missing, $created_dirs); 1852($missing, $created_dirs) = force_manifest() 1853 if $options{'force-manifest'}; 1854 1855my @ARGS = '-dEs'; 1856foreach my $key (sort keys %defines) { 1857 my $val = $defines{$key}; 1858 if (ref $val) { 1859 push @ARGS, "-D$key=@$val"; 1860 } elsif (!defined $val) { 1861 push @ARGS, "-U$key"; 1862 } elsif (!length $val) { 1863 push @ARGS, "-D$key"; 1864 } else { 1865 $val = "" if $val eq "\0"; 1866 push @ARGS, "-D$key=$val"; 1867 } 1868} 1869push @ARGS, map {"-A$_"} @{$options{A}}; 1870 1871my $prefix; 1872 1873# Testing a module? We need to install perl/cpan modules to a temp dir 1874if ($options{module} || $options{'with-module'} || $options{'test-module'}) 1875{ 1876 $prefix = tempdir(CLEANUP => 1); 1877 1878 push @ARGS, "-Dprefix=$prefix"; 1879 push @ARGS, "-Uversiononly", "-Dinstallusrbinperl=n"; 1880} 1881 1882# If a file in MANIFEST is missing, Configure asks if you want to 1883# continue (the default being 'n'). With stdin closed or /dev/null, 1884# it exits immediately and the check for config.sh below will skip. 1885# Without redirecting stdin, the commands called will attempt to read from 1886# stdin (and thus effectively hang) 1887run_with_options({stdin => '/dev/null', name => 'Configure'}, 1888 './Configure', @ARGS); 1889 1890patch_SH() unless $options{'all-fixups'}; 1891apply_fixups($options{'late-fixup'}); 1892 1893if (-f 'config.sh') { 1894 # Emulate noextensions if Configure doesn't support it. 1895 fake_noextensions() 1896 if $major < 10 && $defines{noextensions}; 1897 if (system './Configure -S') { 1898 # See commit v5.23.5-89-g7a4fcb3. Configure may try to run 1899 # ./optdef.sh instead of UU/optdef.sh. Copying the file is 1900 # easier than patching Configure (which mentions optdef.sh multi- 1901 # ple times). 1902 require File::Copy; 1903 File::Copy::copy("UU/optdef.sh", "./optdef.sh"); 1904 system_or_die('./Configure -S'); 1905 } 1906} 1907 1908if ($target =~ /config\.s?h/) { 1909 match_and_exit($target, @ARGV) if $match && -f $target; 1910 report_and_exit(-f $target, 'could build', 'could not build', $target) 1911 if $options{'test-build'}; 1912 1913 skip("could not build $target") unless -f $target; 1914 1915 run_report_and_exit(@ARGV); 1916} elsif (!-f 'config.sh') { 1917 report_and_exit(undef, 'PLEASE REPORT BUG', 'could not build', 'config.sh') 1918 if $options{'test-build'}; 1919 1920 # Skip if something went wrong with Configure 1921 skip('could not build config.sh'); 1922} 1923 1924force_manifest_cleanup($missing, $created_dirs) 1925 if $missing; 1926 1927if($options{'force-regen'} 1928 && extract_from_file('Makefile', qr/\bregen_headers\b/)) { 1929 # regen_headers was added in e50aee73b3d4c555, patch.1m for perl5.001 1930 # It's not worth faking it for earlier revisions. 1931 system_or_die('make regen_headers'); 1932} 1933 1934unless ($options{'all-fixups'}) { 1935 patch_C(); 1936 patch_ext(); 1937 patch_t(); 1938} 1939 1940# Parallel build for miniperl is safe 1941system "$options{make} $j miniperl </dev/null"; 1942 1943# This is the file we expect make to create 1944my $expected_file = $target =~ /^test/ ? 't/perl' 1945 : $target eq 'Fcntl' ? "lib/auto/Fcntl/Fcntl.$Config{so}" 1946 : $target; 1947# This is the target we tell make to build in order to get $expected_file 1948my $real_target = $target eq 'Fcntl' ? $expected_file : $target; 1949 1950if ($target ne 'miniperl') { 1951 # Nearly all parallel build issues fixed by 5.10.0. Untrustworthy before that. 1952 $j = '' if $major < 10; 1953 1954 if ($real_target eq 'test_prep') { 1955 if ($major < 8) { 1956 # test-prep was added in 5.004_01, 3e3baf6d63945cb6. 1957 # renamed to test_prep in 2001 in 5fe84fd29acaf55c. 1958 # earlier than that, just make test. It will be fast enough. 1959 $real_target = extract_from_file('Makefile.SH', 1960 qr/^(test[-_]prep):/, 1961 'test'); 1962 } 1963 } 1964 1965 system "$options{make} $j $real_target </dev/null"; 1966} 1967 1968my $expected_file_found = $expected_file =~ /perl$/ 1969 ? -x $expected_file : -r $expected_file; 1970 1971if ($expected_file_found && $expected_file eq 't/perl') { 1972 # Check that it isn't actually pointing to ../miniperl, which will happen 1973 # if the sanity check ./miniperl -Ilib -MExporter -e '<?>' fails, and 1974 # Makefile tries to run minitest. 1975 1976 # Of course, helpfully sometimes it's called ../perl, other times .././perl 1977 # and who knows if that list is exhaustive... 1978 my ($dev0, $ino0) = stat 't/perl'; 1979 my ($dev1, $ino1) = stat 'perl'; 1980 unless (defined $dev0 && defined $dev1 && $dev0 == $dev1 && $ino0 == $ino1) { 1981 undef $expected_file_found; 1982 my $link = readlink $expected_file; 1983 warn "'t/perl' => '$link', not 'perl'"; 1984 die_255("Could not realink t/perl: $!") unless defined $link; 1985 } 1986} 1987 1988my $just_testing = 0; 1989 1990if ($options{'test-build'}) { 1991 report_and_exit($expected_file_found, 'could build', 'could not build', 1992 $real_target); 1993} elsif (!$expected_file_found) { 1994 skip("could not build $real_target"); 1995} elsif (my $mod_opt = $options{module} || $options{'with-module'} 1996 || ($just_testing++, $options{'test-module'})) { 1997 # Testing a cpan module? See if it will install 1998 # First we need to install this perl somewhere 1999 system_or_die('./installperl'); 2000 2001 my @m = split(',', $mod_opt); 2002 2003 my $bdir = File::Temp::tempdir( 2004 CLEANUP => 1, 2005 ) or die $!; 2006 2007 # Don't ever stop to ask the user for input 2008 $ENV{AUTOMATED_TESTING} = 1; 2009 $ENV{PERL_MM_USE_DEFAULT} = 1; 2010 2011 # Don't let these interfere with our cpan installs 2012 delete $ENV{PERL_MB_OPT}; 2013 delete $ENV{PERL_MM_OPT}; 2014 2015 # Make sure we load up our CPAN::MyConfig and then 2016 # override the build_dir so we have a fresh one 2017 # every build 2018 my $cdir = $options{'cpan-config-dir'} 2019 || File::Spec->catfile($ENV{HOME},".cpan"); 2020 2021 my @cpanshell = ( 2022 "$prefix/bin/perl", 2023 "-I", "$cdir", 2024 "-MCPAN::MyConfig", 2025 "-MCPAN", 2026 "-e","\$CPAN::Config->{build_dir}=q{$bdir};", 2027 "-e", 2028 ); 2029 2030 for (@m) { 2031 s/-/::/g if /-/ and !m|/|; 2032 } 2033 my $install = join ",", map { "'$_'" } @m; 2034 if ($just_testing) { 2035 $install = "test($install)"; 2036 } elsif ($options{'no-module-tests'}) { 2037 $install = "notest('install',$install)"; 2038 } else { 2039 $install = "install($install)"; 2040 } 2041 my $last = $m[-1]; 2042 my $status_method = $just_testing ? 'test' : 'uptodate'; 2043 my $shellcmd = "$install; die unless CPAN::Shell->expand(Module => '$last')->$status_method;"; 2044 2045 if ($options{module} || $options{'test-module'}) { 2046 run_report_and_exit(@cpanshell, $shellcmd); 2047 } else { 2048 my $ret = run_with_options({setprgp => $options{setpgrp}, 2049 timeout => $options{timeout}, 2050 }, @cpanshell, $shellcmd); 2051 $ret &= 0xff if $options{crash}; 2052 2053 # Failed? Give up 2054 if ($ret) { 2055 report_and_exit(!$ret, 'zero exit from', 'non-zero exit from', "@_"); 2056 } 2057 } 2058} 2059 2060match_and_exit($real_target, @ARGV) if $match; 2061 2062if (defined $options{'one-liner'}) { 2063 my $exe = $target =~ /^(?:perl$|test)/ ? 'perl' : 'miniperl'; 2064 unshift @ARGV, map {('-e', $_)} @{$options{'one-liner'}}; 2065 foreach (qw(c l w)) { 2066 unshift @ARGV, "-$_" if $options{$_}; 2067 } 2068 unshift @ARGV, "./$exe", '-Ilib'; 2069} 2070 2071if (-f $ARGV[0]) { 2072 my $fh = open_or_die($ARGV[0]); 2073 my $line = <$fh>; 2074 unshift @ARGV, $1, '-Ilib' 2075 if $line =~ $run_with_our_perl; 2076} 2077 2078if ($options{valgrind}) { 2079 # Turns out to be too confusing to use an optional argument with the path 2080 # of the valgrind binary, as if --valgrind takes an optional argument, 2081 # then specifying it as the last option eats the first part of the testcase. 2082 # ie this: .../bisect.pl --valgrind testcase 2083 # is treated as --valgrind=testcase and as there is no test case given, 2084 # it's an invalid commandline, bailing out with the usage message. 2085 2086 # Currently, the test script can't signal a skip with 125, so anything 2087 # non-zero would do. But to keep that option open in future, use 124 2088 unshift @ARGV, 'valgrind', '--error-exitcode=124'; 2089} 2090 2091# This is what we came here to run: 2092 2093if (exists $Config{ldlibpthname}) { 2094 require Cwd; 2095 my $varname = $Config{ldlibpthname}; 2096 my $cwd = Cwd::getcwd(); 2097 if (defined $ENV{$varname}) { 2098 $ENV{$varname} = $cwd . $Config{path_sep} . $ENV{$varname}; 2099 } else { 2100 $ENV{$varname} = $cwd; 2101 } 2102} 2103 2104run_report_and_exit(@ARGV); 2105 2106############################################################################ 2107# 2108# Patching, editing and faking routines only below here. 2109# 2110############################################################################ 2111 2112sub fake_noextensions { 2113 edit_file('config.sh', sub { 2114 my @lines = split /\n/, shift; 2115 my @ext = split /\s+/, $defines{noextensions}; 2116 foreach (@lines) { 2117 next unless /^extensions=/ || /^dynamic_ext/; 2118 foreach my $ext (@ext) { 2119 s/\b$ext( )?\b/$1/; 2120 } 2121 } 2122 return join "\n", @lines; 2123 }); 2124} 2125 2126sub force_manifest { 2127 my (@missing, @created_dirs); 2128 my $fh = open_or_die('MANIFEST'); 2129 while (<$fh>) { 2130 next unless /^(\S+)/; 2131 # -d is special case needed (at least) between 27332437a2ed1941 and 2132 # bf3d9ec563d25054^ inclusive, as manifest contains ext/Thread/Thread 2133 push @missing, $1 2134 unless -f $1 || -d $1; 2135 } 2136 close_or_die($fh); 2137 2138 foreach my $pathname (@missing) { 2139 my @parts = split '/', $pathname; 2140 my $leaf = pop @parts; 2141 my $path = '.'; 2142 while (@parts) { 2143 $path .= '/' . shift @parts; 2144 next if -d $path; 2145 mkdir $path, 0700 or die_255("Can't create $path: $!"); 2146 unshift @created_dirs, $path; 2147 } 2148 $fh = open_or_die($pathname, '>'); 2149 close_or_die($fh); 2150 chmod 0, $pathname or die_255("Can't chmod 0 $pathname: $!"); 2151 } 2152 return \@missing, \@created_dirs; 2153} 2154 2155sub force_manifest_cleanup { 2156 my ($missing, $created_dirs) = @_; 2157 # This is probably way too paranoid: 2158 my @errors; 2159 require Fcntl; 2160 foreach my $file (@$missing) { 2161 my (undef, undef, $mode, undef, undef, undef, undef, $size) 2162 = stat $file; 2163 if (!defined $mode) { 2164 push @errors, "Added file $file has been deleted by Configure"; 2165 next; 2166 } 2167 if (Fcntl::S_IMODE($mode) != 0) { 2168 push @errors, 2169 sprintf 'Added file %s had mode changed by Configure to %03o', 2170 $file, $mode; 2171 } 2172 if ($size != 0) { 2173 push @errors, 2174 "Added file $file had sized changed by Configure to $size"; 2175 } 2176 unlink $file or die_255("Can't unlink $file: $!"); 2177 } 2178 foreach my $dir (@$created_dirs) { 2179 rmdir $dir or die_255("Can't rmdir $dir: $!"); 2180 } 2181 skip("@errors") 2182 if @errors; 2183} 2184 2185sub patch_Configure { 2186 if ($major < 1) { 2187 if (extract_from_file('Configure', 2188 qr/^\t\t\*=\*\) echo "\$1" >> \$optdef;;$/)) { 2189 # This is " Spaces now allowed in -D command line options.", 2190 # part of commit ecfc54246c2a6f42 2191 apply_patch(<<'EOPATCH'); 2192diff --git a/Configure b/Configure 2193index 3d3b38d..78ffe16 100755 2194--- a/Configure 2195+++ b/Configure 2196@@ -652,7 +777,8 @@ while test $# -gt 0; do 2197 echo "$me: use '-U symbol=', not '-D symbol='." >&2 2198 echo "$me: ignoring -D $1" >&2 2199 ;; 2200- *=*) echo "$1" >> $optdef;; 2201+ *=*) echo "$1" | \ 2202+ sed -e "s/'/'\"'\"'/g" -e "s/=\(.*\)/='\1'/" >> $optdef;; 2203 *) echo "$1='define'" >> $optdef;; 2204 esac 2205 shift 2206EOPATCH 2207 } 2208 2209 if (extract_from_file('Configure', qr/^if \$contains 'd_namlen' \$xinc\b/)) { 2210 # Configure's original simple "grep" for d_namlen falls foul of the 2211 # approach taken by the glibc headers: 2212 # #ifdef _DIRENT_HAVE_D_NAMLEN 2213 # # define _D_EXACT_NAMLEN(d) ((d)->d_namlen) 2214 # 2215 # where _DIRENT_HAVE_D_NAMLEN is not defined on Linux. 2216 # This is also part of commit ecfc54246c2a6f42 2217 apply_patch(<<'EOPATCH'); 2218diff --git a/Configure b/Configure 2219index 3d3b38d..78ffe16 100755 2220--- a/Configure 2221+++ b/Configure 2222@@ -3935,7 +4045,8 @@ $rm -f try.c 2223 2224 : see if the directory entry stores field length 2225 echo " " 2226-if $contains 'd_namlen' $xinc >/dev/null 2>&1; then 2227+$cppstdin $cppflags $cppminus < "$xinc" > try.c 2228+if $contains 'd_namlen' try.c >/dev/null 2>&1; then 2229 echo "Good, your directory entry keeps length information in d_namlen." >&4 2230 val="$define" 2231 else 2232EOPATCH 2233 } 2234 } 2235 2236 if ($major < 2 2237 && !extract_from_file('Configure', 2238 qr/Try to guess additional flags to pick up local libraries/)) { 2239 my $mips = extract_from_file('Configure', 2240 qr!(''\) if (?:\./)?mips; then)!); 2241 # This is part of perl-5.001n. It's needed, to add -L/usr/local/lib to 2242 # the ld flags if libraries are found there. It shifts the code to set 2243 # up libpth earlier, and then adds the code to add libpth entries to 2244 # ldflags 2245 # mips was changed to ./mips in ecfc54246c2a6f42, perl5.000 patch.0g 2246 apply_patch(sprintf <<'EOPATCH', $mips); 2247diff --git a/Configure b/Configure 2248index 53649d5..0635a6e 100755 2249--- a/Configure 2250+++ b/Configure 2251@@ -2749,6 +2749,52 @@ EOM 2252 ;; 2253 esac 2254 2255+: Set private lib path 2256+case "$plibpth" in 2257+'') if ./mips; then 2258+ plibpth="$incpath/usr/lib /usr/local/lib /usr/ccs/lib" 2259+ fi;; 2260+esac 2261+case "$libpth" in 2262+' ') dlist='';; 2263+'') dlist="$plibpth $glibpth";; 2264+*) dlist="$libpth";; 2265+esac 2266+ 2267+: Now check and see which directories actually exist, avoiding duplicates 2268+libpth='' 2269+for xxx in $dlist 2270+do 2271+ if $test -d $xxx; then 2272+ case " $libpth " in 2273+ *" $xxx "*) ;; 2274+ *) libpth="$libpth $xxx";; 2275+ esac 2276+ fi 2277+done 2278+$cat <<'EOM' 2279+ 2280+Some systems have incompatible or broken versions of libraries. Among 2281+the directories listed in the question below, please remove any you 2282+know not to be holding relevant libraries, and add any that are needed. 2283+Say "none" for none. 2284+ 2285+EOM 2286+case "$libpth" in 2287+'') dflt='none';; 2288+*) 2289+ set X $libpth 2290+ shift 2291+ dflt=${1+"$@"} 2292+ ;; 2293+esac 2294+rp="Directories to use for library searches?" 2295+. ./myread 2296+case "$ans" in 2297+none) libpth=' ';; 2298+*) libpth="$ans";; 2299+esac 2300+ 2301 : flags used in final linking phase 2302 case "$ldflags" in 2303 '') if ./venix; then 2304@@ -2765,6 +2811,23 @@ case "$ldflags" in 2305 ;; 2306 *) dflt="$ldflags";; 2307 esac 2308+ 2309+: Possible local library directories to search. 2310+loclibpth="/usr/local/lib /opt/local/lib /usr/gnu/lib" 2311+loclibpth="$loclibpth /opt/gnu/lib /usr/GNU/lib /opt/GNU/lib" 2312+ 2313+: Try to guess additional flags to pick up local libraries. 2314+for thislibdir in $libpth; do 2315+ case " $loclibpth " in 2316+ *" $thislibdir "*) 2317+ case "$dflt " in 2318+ "-L$thislibdir ") ;; 2319+ *) dflt="$dflt -L$thislibdir" ;; 2320+ esac 2321+ ;; 2322+ esac 2323+done 2324+ 2325 echo " " 2326 rp="Any additional ld flags (NOT including libraries)?" 2327 . ./myread 2328@@ -2828,52 +2891,6 @@ n) echo "OK, that should do.";; 2329 esac 2330 $rm -f try try.* core 2331 2332-: Set private lib path 2333-case "$plibpth" in 2334-%s 2335- plibpth="$incpath/usr/lib /usr/local/lib /usr/ccs/lib" 2336- fi;; 2337-esac 2338-case "$libpth" in 2339-' ') dlist='';; 2340-'') dlist="$plibpth $glibpth";; 2341-*) dlist="$libpth";; 2342-esac 2343- 2344-: Now check and see which directories actually exist, avoiding duplicates 2345-libpth='' 2346-for xxx in $dlist 2347-do 2348- if $test -d $xxx; then 2349- case " $libpth " in 2350- *" $xxx "*) ;; 2351- *) libpth="$libpth $xxx";; 2352- esac 2353- fi 2354-done 2355-$cat <<'EOM' 2356- 2357-Some systems have incompatible or broken versions of libraries. Among 2358-the directories listed in the question below, please remove any you 2359-know not to be holding relevant libraries, and add any that are needed. 2360-Say "none" for none. 2361- 2362-EOM 2363-case "$libpth" in 2364-'') dflt='none';; 2365-*) 2366- set X $libpth 2367- shift 2368- dflt=${1+"$@"} 2369- ;; 2370-esac 2371-rp="Directories to use for library searches?" 2372-. ./myread 2373-case "$ans" in 2374-none) libpth=' ';; 2375-*) libpth="$ans";; 2376-esac 2377- 2378 : compute shared library extension 2379 case "$so" in 2380 '') 2381EOPATCH 2382 } 2383 2384 if ($major < 4 && extract_from_file('Configure', 2385 qr/: see which flavor of setpgrp is in use/)) { 2386 edit_file('Configure', sub { 2387 my $code = shift; 2388 my $new = <<'EOT'; 2389if $cc $ccflags $ldflags -o set set.c $libs >/dev/null 2>&1; then 2390EOT 2391 chomp $new; 2392 2393 # before commit ecfc54246c2a6f42: 2394 # before commit 8e07c86ebc651fe9: 2395 my @old = (<<'EOT', <<'EOT'); 2396if $cc $ccflags -o set $ldflags set.c $libs >/dev/null 2>&1; then 2397EOT 2398if $cc $ccflags -o set set.c $ldflags $libs >/dev/null 2>&1; then 2399EOT 2400 for my $was (@old) { 2401 # Yes, this modifies @old. No problem here: 2402 chomp $was; 2403 $was = quotemeta $was; 2404 $code =~ s/$was/$new/; 2405 } 2406 2407 # also commit ecfc54246c2a6f42: 2408 $code =~ s!\tif usg; then!\tif ./usg; then!; 2409 2410 return $code; 2411 }); 2412 2413 # We need the new probe from 2afac517c48c20de, which has prototypes 2414 # (but include the various C headers unconditionally) 2415 apply_patch(<<'EOPATCH'); 2416diff --git a/Configure b/Configure 2417index 18f2172435..5a75ebd767 100755 2418--- a/Configure 2419+++ b/Configure 2420@@ -4986,45 +5055,61 @@ eval $inlibc 2421 set setpgrp d_setpgrp 2422 eval $inlibc 2423 2424-: see which flavor of setpgrp is in use 2425+echo "Checking to see which flavor of setpgrp is in use . . . " 2426 case "$d_setpgrp" in 2427 "$define") 2428 echo " " 2429 $cat >set.c <<EOP 2430+#include <stdio.h> 2431+#include <sys/types.h> 2432+#include <unistd.h> 2433 main() 2434 { 2435 if (getuid() == 0) { 2436 printf("(I see you are running Configure as super-user...)\n"); 2437 setuid(1); 2438 } 2439+#ifdef TRY_BSD_PGRP 2440 if (-1 == setpgrp(1, 1)) 2441- exit(1); 2442- exit(0); 2443+ exit(0); 2444+#else 2445+ if (setpgrp() != -1) 2446+ exit(0); 2447+#endif 2448+ exit(1); 2449 } 2450 EOP 2451- if $cc $ccflags $ldflags -o set set.c $libs >/dev/null 2>&1; then 2452- ./set 2>/dev/null 2453- case $? in 2454- 0) echo "You have to use setpgrp() instead of setpgrp(pid, pgrp)." >&4 2455- val="$undef";; 2456- *) echo "You have to use setpgrp(pid, pgrp) instead of setpgrp()." >&4 2457- val="$define";; 2458- esac 2459+ if $cc -DTRY_BSD_PGRP $ccflags $ldflags -o set set.c $libs >/dev/null 2>&1 && ./set; then 2460+ echo 'You have to use setpgrp(pid,pgrp) instead of setpgrp().' >&4 2461+ val="$define" 2462+ elif $cc $ccflags $ldflags -o set set.c $libs >/dev/null 2>&1 && ./set; then 2463+ echo 'You have to use setpgrp() instead of setpgrp(pid,pgrp).' >&4 2464+ val="$undef" 2465 else 2466+ echo "I can't seem to compile and run the test program." 2467 if ./usg; then 2468- xxx="USG one, i.e. you use setpgrp()." 2469- val="$undef" 2470+ xxx="a USG one, i.e. you use setpgrp()." 2471 else 2472- xxx="BSD one, i.e. you use setpgrp(pid, pgrp)." 2473- val="$define" 2474+ # SVR4 systems can appear rather BSD-ish. 2475+ case "$i_unistd" in 2476+ $undef) 2477+ xxx="a BSD one, i.e. you use setpgrp(pid,pgrp)." 2478+ val="$define" 2479+ ;; 2480+ $define) 2481+ xxx="probably a USG one, i.e. you use setpgrp()." 2482+ val="$undef" 2483+ ;; 2484+ esac 2485 fi 2486- echo "Assuming your setpgrp is a $xxx" >&4 2487+ echo "Assuming your setpgrp is $xxx" >&4 2488 fi 2489 ;; 2490 *) val="$undef";; 2491 esac 2492-set d_bsdpgrp 2493+set d_bsdsetpgrp 2494 eval $setvar 2495+d_bsdpgrp=$d_bsdsetpgrp 2496 $rm -f set set.c 2497 2498 : see if bzero exists 2499EOPATCH 2500 } 2501 2502 if ($major == 4 && extract_from_file('Configure', qr/^d_gethbynam=/)) { 2503 # Fixes a bug introduced in 4599a1dedd47b916 2504 apply_commit('3cbc818d1d0ac470'); 2505 } 2506 2507 if ($major == 4 && extract_from_file('Configure', 2508 qr/gethbadd_addr_type=`echo \$gethbadd_addr_type/)) { 2509 # Fixes a bug introduced in 3fd537d4b944bc7a 2510 apply_commit('6ff9219da6cf8cfd'); 2511 } 2512 2513 if ($major == 4 && extract_from_file('Configure', 2514 qr/^pthreads_created_joinable=/)) { 2515 # Fix for bug introduced in 52e1cb5ebf5e5a8c 2516 # Part of commit ce637636a41b2fef 2517 edit_file('Configure', sub { 2518 my $code = shift; 2519 $code =~ s{^pthreads_created_joinable=''} 2520 {d_pthreads_created_joinable=''}ms 2521 or die_255("Substitution failed"); 2522 $code =~ s{^pthreads_created_joinable='\$pthreads_created_joinable'} 2523 {d_pthreads_created_joinable='\$d_pthreads_created_joinable'}ms 2524 or die_255("Substitution failed"); 2525 return $code; 2526 }); 2527 } 2528 2529 if ($major < 5 && extract_from_file('Configure', 2530 qr!if \$cc \$ccflags try\.c -o try >/dev/null 2>&1; then!)) { 2531 # Analogous to the more general fix of dfe9444ca7881e71 2532 # Without this flags such as -m64 may not be passed to this compile, 2533 # which results in a byteorder of '1234' instead of '12345678', which 2534 # can then cause crashes. 2535 2536 if (extract_from_file('Configure', qr/xxx_prompt=y/)) { 2537 # 8e07c86ebc651fe9 or later 2538 # ("This is my patch patch.1n for perl5.001.") 2539 apply_patch(<<'EOPATCH'); 2540diff --git a/Configure b/Configure 2541index 62249dd..c5c384e 100755 2542--- a/Configure 2543+++ b/Configure 2544@@ -8247,7 +8247,7 @@ main() 2545 } 2546 EOCP 2547 xxx_prompt=y 2548- if $cc $ccflags try.c -o try >/dev/null 2>&1 && ./try > /dev/null; then 2549+ if $cc $ccflags $ldflags try.c -o try >/dev/null 2>&1 && ./try > /dev/null; then 2550 dflt=`./try` 2551 case "$dflt" in 2552 [1-4][1-4][1-4][1-4]|12345678|87654321) 2553EOPATCH 2554 } else { 2555 apply_patch(<<'EOPATCH'); 2556diff --git a/Configure b/Configure 2557index 53649d5..f1cd64a 100755 2558--- a/Configure 2559+++ b/Configure 2560@@ -6362,7 +6362,7 @@ main() 2561 printf("\n"); 2562 } 2563 EOCP 2564- if $cc $ccflags try.c -o try >/dev/null 2>&1 ; then 2565+ if $cc $ccflags $ldflags try.c -o try >/dev/null 2>&1 ; then 2566 dflt=`./try` 2567 case "$dflt" in 2568 ????|????????) echo "(The test program ran ok.)";; 2569EOPATCH 2570 } 2571 } 2572 2573 if ($major < 5) { 2574 my $what = extract_from_file('Configure', qr!(\s+)return __libc_main!); 2575 if ($what) { 2576 # To add to the fun commit commit dfe9444ca7881e71 in Feb 1988 2577 # changed several things: 2578 if ($what !~ /\t/) { 2579 apply_patch(<<'EOPATCH'); 2580--- a/Configure 2581+++ b/Configure 2582@@ -3854,11 +3911,12 @@ n) echo "OK, that should do.";; 2583 int 2584 main() 2585 { 2586- return __libc_main(); 2587+ return __libc_main(); 2588 } 2589 EOM 2590-if $cc $ccflags $ldflags -o gnulibc gnulibc.c $libs >/dev/null 2>&1 && \ 2591- ./gnulibc | $contains '^GNU C Library' >/dev/null 2>&1; then 2592+set gnulibc 2593+if eval $compile && \ 2594+ ./gnulibc | $contains '^GNU C Library' >/dev/null 2>&1; then 2595 val="$define" 2596 echo "You are using the GNU C Library" 2597 else 2598EOPATCH 2599 } 2600 2601 # And commit dc45a647708b6c54 tweaks 1 line in April 1998 2602 edit_file('Configure', sub { 2603 my $code = shift; 2604 $code =~ s{contains '\^GNU C Library' >/dev/null 2>&1; then} 2605 {contains '^GNU C Library'; then}; 2606 return $code; 2607 }); 2608 2609 # This is part of aebf16e7cdbc86ec from June 1998 2610 # but with compiles_ok inlined 2611 apply_patch(<<'EOPATCH'); 2612diff --git a/Configure b/Configure 2613index 38072f0e5e..43735feacf 100755 2614--- a/Configure 2615+++ b/Configure 2616@@ -4024,15 +4024,19 @@ $cc $optimize $ccflags $ldflags -o ${mc_file} $* ${mc_file}.c $libs;' 2617 echo " " 2618 echo "Checking for GNU C Library..." >&4 2619 cat >gnulibc.c <<EOM 2620+#include <stdio.h> 2621 int 2622 main() 2623 { 2624- return __libc_main(); 2625+#ifdef __GLIBC__ 2626+ exit(0); 2627+#else 2628+ exit(1); 2629+#endif 2630 } 2631 EOM 2632 set gnulibc 2633-if eval $compile && \ 2634- ./gnulibc | $contains '^GNU C Library'; then 2635+if $cc $ccflags $ldflags -o gnulibc gnulibc.c $libs && ./gnulibc; then 2636 val="$define" 2637 echo "You are using the GNU C Library" 2638 else 2639EOPATCH 2640 } 2641 } 2642 2643 if ($major < 6 && !extract_from_file('Configure', 2644 qr!^\t-A\)$!)) { 2645 # This adds the -A option to Configure, which is incredibly useful 2646 # Effectively this is commits 02e93a22d20fc9a5, 5f83a3e9d818c3ad, 2647 # bde6b06b2c493fef, f7c3111703e46e0c and 2 lines of trailing whitespace 2648 # removed by 613d6c3e99b9decc, but applied at slightly different 2649 # locations to ensure a clean patch back to 5.000 2650 # Note, if considering patching to the intermediate revisions to fix 2651 # bugs in -A handling, f7c3111703e46e0c is from 2002, and hence 2652 # $major == 8 2653 2654 # To add to the fun, early patches add -K and -O options, and it's not 2655 # trivial to get patch to put the C<. ./posthint.sh> in the right place 2656 edit_file('Configure', sub { 2657 my $code = shift; 2658 $code =~ s/(optstr = ")([^"]+";\s*# getopt-style specification)/$1A:$2/ 2659 or die_255("Substitution failed"); 2660 $code =~ s!^(: who configured the system)! 2661touch posthint.sh 2662. ./posthint.sh 2663 2664$1!ms 2665 or die_255("Substitution failed"); 2666 return $code; 2667 }); 2668 apply_patch(<<'EOPATCH'); 2669diff --git a/Configure b/Configure 2670index 4b55fa6..60c3c64 100755 2671--- a/Configure 2672+++ b/Configure 2673@@ -1150,6 +1150,7 @@ set X `for arg in "$@"; do echo "X$arg"; done | 2674 eval "set $*" 2675 shift 2676 rm -f options.awk 2677+rm -f posthint.sh 2678 2679 : set up default values 2680 fastread='' 2681@@ -1172,6 +1173,56 @@ while test $# -gt 0; do 2682 case "$1" in 2683 -d) shift; fastread=yes;; 2684 -e) shift; alldone=cont;; 2685+ -A) 2686+ shift 2687+ xxx='' 2688+ yyy="$1" 2689+ zzz='' 2690+ uuu=undef 2691+ case "$yyy" in 2692+ *=*) zzz=`echo "$yyy"|sed 's!=.*!!'` 2693+ case "$zzz" in 2694+ *:*) zzz='' ;; 2695+ *) xxx=append 2696+ zzz=" "`echo "$yyy"|sed 's!^[^=]*=!!'` 2697+ yyy=`echo "$yyy"|sed 's!=.*!!'` ;; 2698+ esac 2699+ ;; 2700+ esac 2701+ case "$xxx" in 2702+ '') case "$yyy" in 2703+ *:*) xxx=`echo "$yyy"|sed 's!:.*!!'` 2704+ yyy=`echo "$yyy"|sed 's!^[^:]*:!!'` 2705+ zzz=`echo "$yyy"|sed 's!^[^=]*=!!'` 2706+ yyy=`echo "$yyy"|sed 's!=.*!!'` ;; 2707+ *) xxx=`echo "$yyy"|sed 's!:.*!!'` 2708+ yyy=`echo "$yyy"|sed 's!^[^:]*:!!'` ;; 2709+ esac 2710+ ;; 2711+ esac 2712+ case "$xxx" in 2713+ append) 2714+ echo "$yyy=\"\${$yyy}$zzz\"" >> posthint.sh ;; 2715+ clear) 2716+ echo "$yyy=''" >> posthint.sh ;; 2717+ define) 2718+ case "$zzz" in 2719+ '') zzz=define ;; 2720+ esac 2721+ echo "$yyy='$zzz'" >> posthint.sh ;; 2722+ eval) 2723+ echo "eval \"$yyy=$zzz\"" >> posthint.sh ;; 2724+ prepend) 2725+ echo "$yyy=\"$zzz\${$yyy}\"" >> posthint.sh ;; 2726+ undef) 2727+ case "$zzz" in 2728+ '') zzz="$uuu" ;; 2729+ esac 2730+ echo "$yyy=$zzz" >> posthint.sh ;; 2731+ *) echo "$me: unknown -A command '$xxx', ignoring -A $1" >&2 ;; 2732+ esac 2733+ shift 2734+ ;; 2735 -f) 2736 shift 2737 cd .. 2738EOPATCH 2739 } 2740 2741 if ($major < 6) { 2742 edit_file('Configure', sub { 2743 my $code = shift; 2744 # This will cause a build failure, but it will stop 2745 # Configure looping endlessly trying to get a different 2746 # answer: 2747 $code =~ s{(dflt=)n(\n\s+rp="Function \$ans does not exist)} 2748 {$1y$2}; 2749 return $code; 2750 }); 2751 } 2752 2753 if ($major < 8 && $^O eq 'aix') { 2754 edit_file('Configure', sub { 2755 my $code = shift; 2756 # Replicate commit a8c676c69574838b 2757 # Whitespace allowed at the ends of /lib/syscalls.exp lines 2758 # and half of commit c6912327ae30e6de 2759 # AIX syscalls.exp scan: the syscall might be marked 32, 3264, or 64 2760 $code =~ s{(\bsed\b.*\bsyscall)(?:\[0-9\]\*)?(\$.*/lib/syscalls\.exp)} 2761 {$1 . "[0-9]*[ \t]*" . $2}e; 2762 return $code; 2763 }); 2764 } 2765 2766 if ($major < 8 && !extract_from_file('Configure', 2767 qr/^\t\tif test ! -t 0; then$/)) { 2768 # Before dfe9444ca7881e71, Configure would refuse to run if stdin was 2769 # not a tty. With that commit, the tty requirement was dropped for -de 2770 # and -dE 2771 # Commit aaeb8e512e8e9e14 dropped the tty requirement for -S 2772 # For those older versions, it's probably easiest if we simply remove 2773 # the sanity test. 2774 edit_file('Configure', sub { 2775 my $code = shift; 2776 $code =~ s/test ! -t 0/test Perl = rules/; 2777 return $code; 2778 }); 2779 } 2780 2781 if ($major < 32) { 2782 edit_file('Configure', sub { 2783 my $code = shift; 2784 2785 # A lot of the probes used to be written assuming no need 2786 # for prototypes for exit(), printf() etc. 2787 # Curiously also the code was written to call exit() 2788 # rather than return from main - early portability? 2789 # 2790 # Commit 55954f198635e488 did most of the work in ensuring 2791 # that there was always a prototype for exit, by adding 2792 # #include <stdlib.h> in many probes. However the last 2793 # missing prototype was only addressed by f16c94bc75aefb81 2794 # (for futimes), and the last missing prototypes a few 2795 # commits later in f82f0f36c7188b6d 2796 # 2797 # As an aside, commit dc45a647708b6c54 fixes the signal 2798 # name probe (etc) - the commit tagged as perl-5.004_01 2799 # *seems* to fix the signal name probe, but actually it 2800 # fixes an error in the fallback awk code, not the C 2801 # probe's missing prototype. 2802 # 2803 # With current C compilers there is no correctness risk 2804 # from including a header more than once, so the easiest 2805 # approach to making this all work is to add includes 2806 # "to be sure to be sure" 2807 # 2808 # The trick is not to break *working* probes by 2809 # accidentally including a header *within* a construction. 2810 # So we need to have some confidence that it's the start 2811 # of a file (or somewhere safe) 2812 2813 my $headers = <<'EOFIX'; 2814#include <stdio.h> 2815#include <stdlib.h> 2816#include <string.h> 2817EOFIX 2818 2819 # This handles $cat and plain cat: 2820 $code =~ s{([\$\t\n ]cat > *[a-z0-9]+\.c <<[^\n]*\n)} 2821 {$1$headers}g; 2822 # Of course, there's always one that's backwards: 2823 $code =~ s{([\$\t\n ]cat <<[^\n]* > *[a-z0-9]+\.c\n)} 2824 {$1$headers}g; 2825 2826 # and >> used to *create* a file. 2827 # We have to be careful to distinguish those from >> used 2828 # to append to a file. All the first lines have #include 2829 # or #ifdef. Except the few that don't... 2830 $code =~ s{ 2831 ([\$\t\n ]cat\ >>\ *[a-z]+\.c\ <<[^\n]*\n) 2832 ( 2833 # #include/#ifdef ... 2834 \# 2835 | 2836 # The non-blocking IO probe 2837 (?:int\ )?main\(\) 2838 | 2839 # The alignment constraint probe 2840 struct\ foobar 2841 ) 2842 } 2843 {$1$headers$2}gx; 2844 2845 # This is part of commit c727eafaa06ca49a: 2846 $code =~ s{\(int\)exit\(0\);} 2847 {\(void\)exit\(0\);}; 2848 2849 return $code; 2850 }); 2851 } 2852 2853 if ($major < 10) { 2854 # Fix symbol detection to that of commit 373dfab3839ca168 if it's any 2855 # intermediate version 5129fff43c4fe08c or later, as the intermediate 2856 # versions don't work correctly on (at least) Sparc Linux. 2857 # 5129fff43c4fe08c adds the first mention of mistrustnm. 2858 # 373dfab3839ca168 removes the last mention of lc="" 2859 # 2860 # Fix symbol detection prior to 5129fff43c4fe08c to use the same 2861 # approach, where we don't call printf without a prototype 2862 # We can't include <stdio.h> to get its prototype, as the way this works 2863 # is to create a (wrong) prototype for the probed functions, and those 2864 # conflict if the function in question is in stdio.h. 2865 edit_file('Configure', sub { 2866 my $code = shift; 2867 return $code 2868 if $code !~ /\btc="";/; # 373dfab3839ca168 or later 2869 if ($code !~ /\bmistrustnm\b/) { 2870 # doing this as a '' heredoc seems to be the easiest 2871 # way to avoid confusing levels of backslashes: 2872 my $now = <<'EOT'; 2873void *(*(p()))$tdc { extern void *$1$tdc; return &$1; } int main() { if(p()) return(0); else return(1); } 2874EOT 2875 chomp $now; 2876 2877 # before 5129fff43c4fe08c 2878 # befure 16d20bd98cd29be7 2879 my @old = (<<'EOT', <<'EOT'); 2880main() { extern short $1$tdc; printf(\"%hd\", $1$tc); } 2881EOT 2882main() { extern int $1$tdc; printf(\"%d\", $1$tc); } 2883EOT 2884 for my $was (@old) { 2885 chomp $was; 2886 $was = quotemeta $was; 2887 2888 # Prior to commit d674cd6de52ff38b there was no 2889 # 'int ' for 'int main' 2890 $code =~ s/(?:int )?$was/$now/; 2891 } 2892 return $code; 2893 } 2894 2895 my $fixed = <<'EOC'; 2896 2897: is a C symbol defined? 2898csym='tlook=$1; 2899case "$3" in 2900-v) tf=libc.tmp; tdc="";; 2901-a) tf=libc.tmp; tdc="[]";; 2902*) tlook="^$1\$"; tf=libc.list; tdc="()";; 2903esac; 2904tx=yes; 2905case "$reuseval-$4" in 2906true-) ;; 2907true-*) tx=no; eval "tval=\$$4"; case "$tval" in "") tx=yes;; esac;; 2908esac; 2909case "$tx" in 2910yes) 2911 tval=false; 2912 if $test "$runnm" = true; then 2913 if $contains $tlook $tf >/dev/null 2>&1; then 2914 tval=true; 2915 elif $test "$mistrustnm" = compile -o "$mistrustnm" = run; then 2916 echo "void *(*(p()))$tdc { extern void *$1$tdc; return &$1; } int main() { if(p()) return(0); else return(1); }"> try.c; 2917 $cc -o try $optimize $ccflags $ldflags try.c >/dev/null 2>&1 $libs && tval=true; 2918 $test "$mistrustnm" = run -a -x try && { $run ./try$_exe >/dev/null 2>&1 || tval=false; }; 2919 $rm -f try$_exe try.c core core.* try.core; 2920 fi; 2921 else 2922 echo "void *(*(p()))$tdc { extern void *$1$tdc; return &$1; } int main() { if(p()) return(0); else return(1); }"> try.c; 2923 $cc -o try $optimize $ccflags $ldflags try.c $libs >/dev/null 2>&1 && tval=true; 2924 $rm -f try$_exe try.c; 2925 fi; 2926 ;; 2927*) 2928 case "$tval" in 2929 $define) tval=true;; 2930 *) tval=false;; 2931 esac; 2932 ;; 2933esac; 2934eval "$2=$tval"' 2935 2936EOC 2937 $code =~ s/\n: is a C symbol defined\?\n.*?\neval "\$2=\$tval"'\n\n/$fixed/sm 2938 or die_255("substitution failed"); 2939 return $code; 2940 }); 2941 } 2942 2943 if ($major < 10 2944 && extract_from_file('Configure', qr/^set malloc\.h i_malloc$/)) { 2945 # This is commit 01d07975f7ef0e7d, trimmed, with $compile inlined as 2946 # prior to bd9b35c97ad661cc Configure had the malloc.h test before the 2947 # definition of $compile. 2948 apply_patch(<<'EOPATCH'); 2949diff --git a/Configure b/Configure 2950index 3d2e8b9..6ce7766 100755 2951--- a/Configure 2952+++ b/Configure 2953@@ -6743,5 +6743,22 @@ set d_dosuid 2954 2955 : see if this is a malloc.h system 2956-set malloc.h i_malloc 2957-eval $inhdr 2958+: we want a real compile instead of Inhdr because some systems have a 2959+: malloc.h that just gives a compile error saying to use stdlib.h instead 2960+echo " " 2961+$cat >try.c <<EOCP 2962+#include <stdlib.h> 2963+#include <malloc.h> 2964+int main () { return 0; } 2965+EOCP 2966+set try 2967+if $cc $optimize $ccflags $ldflags -o try $* try.c $libs > /dev/null 2>&1; then 2968+ echo "<malloc.h> found." >&4 2969+ val="$define" 2970+else 2971+ echo "<malloc.h> NOT found." >&4 2972+ val="$undef" 2973+fi 2974+$rm -f try.c try 2975+set i_malloc 2976+eval $setvar 2977 2978EOPATCH 2979 } 2980 2981 if ($major < 38 && !extract_from_file('Configure', qr/Too many attempts asking the same question/)) { 2982 # Without this, myread can loop infinitely trying to get a valid answer, 2983 # and hence Configure gets stuck in a loop, outputting the same question 2984 # repeatedly. This isn't what we need. 2985 apply_commit('46bfb3c49f22629a'); 2986 } 2987} 2988 2989sub patch_hints { 2990 if ($^O eq 'freebsd') { 2991 # There are rather too many version-specific FreeBSD hints fixes to 2992 # patch individually. Also, more than once the FreeBSD hints file has 2993 # been written in what turned out to be a rather non-future-proof style, 2994 # with case statements treating the most recent version as the 2995 # exception, instead of treating previous versions' behaviour explicitly 2996 # and changing the default to cater for the current behaviour. (As 2997 # strangely, future versions inherit the current behaviour.) 2998 checkout_file('hints/freebsd.sh'); 2999 } elsif ($^O eq 'darwin') { 3000 if ($major < 8) { 3001 # We can't build on darwin without some of the data in the hints 3002 # file. Probably less surprising to use the earliest version of 3003 # hints/darwin.sh and then edit in place just below, than use 3004 # blead's version, as that would create a discontinuity at 3005 # f556e5b971932902 - before it, hints bugs would be "fixed", after 3006 # it they'd resurface. This way, we should give the illusion of 3007 # monotonic bug fixing. 3008 my $faking_it; 3009 if (!-f 'hints/darwin.sh') { 3010 checkout_file('hints/darwin.sh', 'f556e5b971932902'); 3011 ++$faking_it; 3012 } 3013 3014 edit_file('hints/darwin.sh', sub { 3015 my $code = shift; 3016 # Part of commit 8f4f83badb7d1ba9, which mostly undoes 3017 # commit 0511a818910f476c. 3018 $code =~ s/^cppflags='-traditional-cpp';$/cppflags="\${cppflags} -no-cpp-precomp"/m; 3019 # commit 14c11978e9b52e08/803bb6cc74d36a3f 3020 # Without this, code in libperl.bundle links against op.o 3021 # in preference to opmini.o on the linker command line, 3022 # and hence miniperl tries to use File::Glob instead of 3023 # csh 3024 $code =~ s/^(lddlflags=)/ldflags="\${ldflags} -flat_namespace"\n$1/m; 3025 # f556e5b971932902 also patches Makefile.SH with some 3026 # special case code to deal with useshrplib for darwin. 3027 # Given that post 5.8.0 the darwin hints default was 3028 # changed to false, and it would be very complex to splice 3029 # in that code in various versions of Makefile.SH back 3030 # to 5.002, lets just turn it off. 3031 $code =~ s/^useshrplib='true'/useshrplib='false'/m 3032 if $faking_it; 3033 3034 # Part of commit d235852b65d51c44 3035 # Don't do this on a case sensitive HFS+ partition, as it 3036 # breaks the build for 5.003 and earlier. 3037 if ($case_insensitive 3038 && $code !~ /^firstmakefile=GNUmakefile/) { 3039 $code .= "\nfirstmakefile=GNUmakefile;\n"; 3040 } 3041 3042 return $code; 3043 }); 3044 } 3045 3046 if ($major < 8 || 3047 ($major < 10 && !extract_from_file('ext/DynaLoader/Makefile.PL', 3048 qr/sub MY::static /))) { 3049 edit_file('hints/darwin.sh', sub { 3050 my $code = shift; 3051 # As above, the build fails if version of code in op.o 3052 # is linked to, instead of opmini.o 3053 # We don't need this after commit 908fcb8bef8cbab8, 3054 # which moves DynaLoader.o into the shared perl 3055 # library, as it *also* redoes the build so that 3056 # miniperl is linked against all the object files 3057 # (explicitly excluding op.o), instead of against the 3058 # shared library (and reyling on "flat namespaces" 3059 # - ie make Mach-O behave like ELF - to end up with 3060 # objects in the library linking against opmini.o) 3061 $code .= <<'EOHACK'; 3062 3063# Force a flat namespace everywhere: 3064echo $ldflags | grep flat_namespace || ldflags=`echo \$lddflags -flat_namespace` 3065echo $lddlflags | grep flat_namespace || lddlflags=`echo \$lddlflags -flat_namespace` 3066EOHACK 3067 return $code; 3068 }); 3069 } 3070 3071 if ($major < 16) { 3072 edit_file('hints/darwin.sh', sub { 3073 my $code = shift; 3074 # This is commit 60a655a1ee05c577 3075 $code =~ s/usenm='true'/usenm='false'/; 3076 3077 # With the Configure probes fixed (in patch_Configure) 3078 # the "d_stdstdio" logic now concludes "define". 3079 # Unfortunately that is not correct - attempting to 3080 # build 5.8.0 without this override results in SEGVs 3081 # or similar chaos. 3082 # 3083 # The problem is introduced by commit 5a3a8a022aa61cba 3084 # which enables perlio by default. 3085 # The problem is hidden after 15b61c98f82f3010, which 3086 # adds "d_faststdio" and defaults it to "undef" from 3087 # that commit onwards, but override that and the build 3088 # would break, up until "turning off perlio" was 3089 # disabled by commit dd35fa16610ef2fa 3090 $code .= "\nd_stdstdio='undef'\n"; 3091 3092 return $code; 3093 }); 3094 } 3095 3096 if ($major < 34) { 3097 edit_file('hints/darwin.sh', sub { 3098 my $code = shift; 3099 # This is commits aadc6422eaec39c2 and 54d41b60822734cf 3100 # rolled into one: 3101 $code =~ s/ 10\.\*(?: \| 11\.\*)?\)/ [1-9][0-9].*)/g; 3102 return $code; 3103 }); 3104 } 3105 } elsif ($^O eq 'netbsd') { 3106 if ($major < 6) { 3107 # These are part of commit 099685bc64c7dbce 3108 edit_file('hints/netbsd.sh', sub { 3109 my $code = shift; 3110 my $fixed = <<'EOC'; 3111case "$osvers" in 31120.9|0.8*) 3113 usedl="$undef" 3114 ;; 3115*) 3116 if [ -f /usr/libexec/ld.elf_so ]; then 3117 d_dlopen=$define 3118 d_dlerror=$define 3119 ccdlflags="-Wl,-E -Wl,-R${PREFIX}/lib $ccdlflags" 3120 cccdlflags="-DPIC -fPIC $cccdlflags" 3121 lddlflags="--whole-archive -shared $lddlflags" 3122 elif [ "`uname -m`" = "pmax" ]; then 3123# NetBSD 1.3 and 1.3.1 on pmax shipped an 'old' ld.so, which will not work. 3124 d_dlopen=$undef 3125 elif [ -f /usr/libexec/ld.so ]; then 3126 d_dlopen=$define 3127 d_dlerror=$define 3128 ccdlflags="-Wl,-R${PREFIX}/lib $ccdlflags" 3129# we use -fPIC here because -fpic is *NOT* enough for some of the 3130# extensions like Tk on some netbsd platforms (the sparc is one) 3131 cccdlflags="-DPIC -fPIC $cccdlflags" 3132 lddlflags="-Bforcearchive -Bshareable $lddlflags" 3133 else 3134 d_dlopen=$undef 3135 fi 3136 ;; 3137esac 3138EOC 3139 $code =~ s/^case "\$osvers" in\n0\.9\|0\.8.*?^esac\n/$fixed/ms; 3140 return $code; 3141 }); 3142 } 3143 } elsif ($^O eq 'openbsd') { 3144 if ($major < 8) { 3145 checkout_file('hints/openbsd.sh', '43051805d53a3e4c') 3146 unless -f 'hints/openbsd.sh'; 3147 my $which = extract_from_file('hints/openbsd.sh', 3148 qr/# from (2\.8|3\.1) onwards/, 3149 ''); 3150 if ($which eq '') { 3151 my $was = extract_from_file('hints/openbsd.sh', 3152 qr/(lddlflags="(?:-Bforcearchive )?-Bshareable)/); 3153 # This is commit 154d43cbcf57271c and parts of 5c75dbfa77b0949c 3154 # and 29b5585702e5e025 3155 apply_patch(sprintf <<'EOPATCH', $was); 3156diff --git a/hints/openbsd.sh b/hints/openbsd.sh 3157index a7d8bf2..5b79709 100644 3158--- a/hints/openbsd.sh 3159+++ b/hints/openbsd.sh 3160@@ -37,7 +37,25 @@ OpenBSD.alpha|OpenBSD.mips|OpenBSD.powerpc|OpenBSD.vax) 3161 # we use -fPIC here because -fpic is *NOT* enough for some of the 3162 # extensions like Tk on some OpenBSD platforms (ie: sparc) 3163 cccdlflags="-DPIC -fPIC $cccdlflags" 3164- %s $lddlflags" 3165+ case "$osvers" in 3166+ [01].*|2.[0-7]|2.[0-7].*) 3167+ lddlflags="-Bshareable $lddlflags" 3168+ ;; 3169+ 2.[8-9]|3.0) 3170+ ld=${cc:-cc} 3171+ lddlflags="-shared -fPIC $lddlflags" 3172+ ;; 3173+ *) # from 3.1 onwards 3174+ ld=${cc:-cc} 3175+ lddlflags="-shared -fPIC $lddlflags" 3176+ libswanted=`echo $libswanted | sed 's/ dl / /'` 3177+ ;; 3178+ esac 3179+ 3180+ # We need to force ld to export symbols on ELF platforms. 3181+ # Without this, dlopen() is crippled. 3182+ ELF=`${cc:-cc} -dM -E - </dev/null | grep __ELF__` 3183+ test -n "$ELF" && ldflags="-Wl,-E $ldflags" 3184 ;; 3185 esac 3186 3187EOPATCH 3188 } elsif ($which eq '2.8') { 3189 # This is parts of 5c75dbfa77b0949c and 29b5585702e5e025, and 3190 # possibly eb9cd59d45ad2908 3191 my $was = extract_from_file('hints/openbsd.sh', 3192 qr/lddlflags="(-shared(?: -fPIC)?) \$lddlflags"/); 3193 3194 apply_patch(sprintf <<'EOPATCH', $was); 3195--- a/hints/openbsd.sh 2011-10-21 17:25:20.000000000 +0200 3196+++ b/hints/openbsd.sh 2011-10-21 16:58:43.000000000 +0200 3197@@ -44,11 +44,21 @@ 3198 [01].*|2.[0-7]|2.[0-7].*) 3199 lddlflags="-Bshareable $lddlflags" 3200 ;; 3201- *) # from 2.8 onwards 3202+ 2.[8-9]|3.0) 3203 ld=${cc:-cc} 3204- lddlflags="%s $lddlflags" 3205+ lddlflags="-shared -fPIC $lddlflags" 3206+ ;; 3207+ *) # from 3.1 onwards 3208+ ld=${cc:-cc} 3209+ lddlflags="-shared -fPIC $lddlflags" 3210+ libswanted=`echo $libswanted | sed 's/ dl / /'` 3211 ;; 3212 esac 3213+ 3214+ # We need to force ld to export symbols on ELF platforms. 3215+ # Without this, dlopen() is crippled. 3216+ ELF=`${cc:-cc} -dM -E - </dev/null | grep __ELF__` 3217+ test -n "$ELF" && ldflags="-Wl,-E $ldflags" 3218 ;; 3219 esac 3220 3221EOPATCH 3222 } elsif ($which eq '3.1' 3223 && !extract_from_file('hints/openbsd.sh', 3224 qr/We need to force ld to export symbols on ELF platforms/)) { 3225 # This is part of 29b5585702e5e025 3226 apply_patch(<<'EOPATCH'); 3227diff --git a/hints/openbsd.sh b/hints/openbsd.sh 3228index c6b6bc9..4839d04 100644 3229--- a/hints/openbsd.sh 3230+++ b/hints/openbsd.sh 3231@@ -54,6 +54,11 @@ alpha-2.[0-8]|mips-*|vax-*|powerpc-2.[0-7]|m88k-*) 3232 libswanted=`echo $libswanted | sed 's/ dl / /'` 3233 ;; 3234 esac 3235+ 3236+ # We need to force ld to export symbols on ELF platforms. 3237+ # Without this, dlopen() is crippled. 3238+ ELF=`${cc:-cc} -dM -E - </dev/null | grep __ELF__` 3239+ test -n "$ELF" && ldflags="-Wl,-E $ldflags" 3240 ;; 3241 esac 3242 3243EOPATCH 3244 } 3245 } 3246 } elsif ($^O eq 'linux') { 3247 if ($major < 1) { 3248 # sparc linux seems to need the -Dbool=char -DHAS_BOOL part of 3249 # perl5.000 patch.0n: [address Configure and build issues] 3250 edit_file('hints/linux.sh', sub { 3251 my $code = shift; 3252 $code =~ s!-I/usr/include/bsd!-Dbool=char -DHAS_BOOL!g; 3253 return $code; 3254 }); 3255 } 3256 3257 if ($major <= 9) { 3258 if (`uname -sm` =~ qr/^Linux sparc/) { 3259 if (extract_from_file('hints/linux.sh', qr/sparc-linux/)) { 3260 # Be sure to use -fPIC not -fpic on Linux/SPARC 3261 apply_commit('f6527d0ef0c13ad4'); 3262 } elsif(!extract_from_file('hints/linux.sh', 3263 qr/^sparc-linux\)$/)) { 3264 my $fh = open_or_die('hints/linux.sh', '>>'); 3265 print $fh <<'EOT' or die_255($!); 3266 3267case "`uname -m`" in 3268sparc*) 3269 case "$cccdlflags" in 3270 *-fpic*) cccdlflags="`echo $cccdlflags|sed 's/-fpic/-fPIC/'`" ;; 3271 *) cccdlflags="$cccdlflags -fPIC" ;; 3272 esac 3273 ;; 3274esac 3275EOT 3276 close_or_die($fh); 3277 } 3278 } 3279 } 3280 } elsif ($^O eq 'solaris') { 3281 if (($major == 13 || $major == 14) 3282 && extract_from_file('hints/solaris_2.sh', qr/getconfldllflags/)) { 3283 apply_commit('c80bde4388070c45'); 3284 } 3285 } 3286} 3287 3288sub patch_SH { 3289 # Cwd.xs added in commit 0d2079faa739aaa9. Cwd.pm moved to ext/ 8 years 3290 # later in commit 403f501d5b37ebf0 3291 if ($major > 0 && <*/Cwd/Cwd.xs>) { 3292 if ($major < 10 3293 && !extract_from_file('Makefile.SH', qr/^extra_dep=''$/)) { 3294 # The Makefile.PL for Unicode::Normalize needs 3295 # lib/unicore/CombiningClass.pl. Even without a parallel build, we 3296 # need a dependency to ensure that it builds. This is a variant of 3297 # commit 9f3ef600c170f61e. Putting this for earlier versions gives 3298 # us a spot on which to hang the edits below 3299 apply_patch(<<'EOPATCH'); 3300diff --git a/Makefile.SH b/Makefile.SH 3301index f61d0db..6097954 100644 3302--- a/Makefile.SH 3303+++ b/Makefile.SH 3304@@ -155,10 +155,20 @@ esac 3305 3306 : Prepare dependency lists for Makefile. 3307 dynamic_list=' ' 3308+extra_dep='' 3309 for f in $dynamic_ext; do 3310 : the dependency named here will never exist 3311 base=`echo "$f" | sed 's/.*\///'` 3312- dynamic_list="$dynamic_list lib/auto/$f/$base.$dlext" 3313+ this_target="lib/auto/$f/$base.$dlext" 3314+ dynamic_list="$dynamic_list $this_target" 3315+ 3316+ : Parallel makes reveal that we have some interdependencies 3317+ case $f in 3318+ Math/BigInt/FastCalc) extra_dep="$extra_dep 3319+$this_target: lib/auto/List/Util/Util.$dlext" ;; 3320+ Unicode/Normalize) extra_dep="$extra_dep 3321+$this_target: lib/unicore/CombiningClass.pl" ;; 3322+ esac 3323 done 3324 3325 static_list=' ' 3326@@ -987,2 +997,9 @@ n_dummy $(nonxs_ext): miniperl$(EXE_EXT) preplibrary $(DYNALOADER) FORCE 3327 @$(LDLIBPTH) sh ext/util/make_ext nonxs $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL) 3328+!NO!SUBS! 3329+ 3330+$spitshell >>Makefile <<EOF 3331+$extra_dep 3332+EOF 3333+ 3334+$spitshell >>Makefile <<'!NO!SUBS!' 3335 3336EOPATCH 3337 } 3338 3339 if ($major == 15 && $^O !~ /^(linux|darwin|.*bsd)$/ 3340 && extract_from_file('Makefile.SH', qr/^V.* \?= /)) { 3341 # Remove the GNU-make-ism (which the BSD makes also support, but 3342 # most other makes choke on) 3343 apply_patch(<<'EOPATCH'); 3344diff --git a/Makefile.SH b/Makefile.SH 3345index 94952bd..13e9001 100755 3346--- a/Makefile.SH 3347+++ b/Makefile.SH 3348@@ -338,8 +338,8 @@ linux*|darwin) 3349 $spitshell >>$Makefile <<!GROK!THIS! 3350 # If you're going to use valgrind and it can't be invoked as plain valgrind 3351 # then you'll need to change this, or override it on the make command line. 3352-VALGRIND ?= valgrind 3353-VG_TEST ?= ./perl -e 1 2>/dev/null 3354+VALGRIND = valgrind 3355+VG_TEST = ./perl -e 1 2>/dev/null 3356 3357 !GROK!THIS! 3358 ;; 3359EOPATCH 3360 } 3361 3362 if ($major == 11) { 3363 if (extract_from_file('patchlevel.h', 3364 qr/^#include "unpushed\.h"/)) { 3365 # I had thought it easier to detect when building one of the 52 3366 # commits with the original method of incorporating the git 3367 # revision and drop parallel make flags. Commits shown by 3368 # git log 46807d8e809cc127^..dcff826f70bf3f64^ ^d4fb0a1f15d1a1c4 3369 # However, it's not actually possible to make miniperl for that 3370 # configuration as-is, because the file .patchnum is only made 3371 # as a side effect of target 'all' 3372 # I also don't think that it's "safe" to simply run 3373 # make_patchnum.sh before the build. We need the proper 3374 # dependency rules in the Makefile to *stop* it being run again 3375 # at the wrong time. 3376 # This range is important because contains the commit that 3377 # merges Schwern's y2038 work. 3378 apply_patch(<<'EOPATCH'); 3379diff --git a/Makefile.SH b/Makefile.SH 3380index 9ad8b6f..106e721 100644 3381--- a/Makefile.SH 3382+++ b/Makefile.SH 3383@@ -540,9 +544,14 @@ sperl.i: perl.c $(h) 3384 3385 .PHONY: all translators utilities make_patchnum 3386 3387-make_patchnum: 3388+make_patchnum: lib/Config_git.pl 3389+ 3390+lib/Config_git.pl: make_patchnum.sh 3391 sh $(shellflags) make_patchnum.sh 3392 3393+# .patchnum, unpushed.h and lib/Config_git.pl are built by make_patchnum.sh 3394+unpushed.h .patchnum: lib/Config_git.pl 3395+ 3396 # make sure that we recompile perl.c if .patchnum changes 3397 perl$(OBJ_EXT): .patchnum unpushed.h 3398 3399EOPATCH 3400 } elsif (-f '.gitignore' 3401 && extract_from_file('.gitignore', qr/^\.patchnum$/)) { 3402 # 8565263ab8a47cda to 46807d8e809cc127^ inclusive. 3403 edit_file('Makefile.SH', sub { 3404 my $code = shift; 3405 $code =~ s/^make_patchnum:\n/make_patchnum: .patchnum 3406 3407.sha1: .patchnum 3408 3409.patchnum: make_patchnum.sh 3410/m; 3411 return $code; 3412 }); 3413 } elsif (-f 'lib/.gitignore' 3414 && extract_from_file('lib/.gitignore', 3415 qr!^/Config_git.pl!) 3416 && !extract_from_file('Makefile.SH', 3417 qr/^uudmap\.h.*:bitcount.h$/)) { 3418 # Between commits and dcff826f70bf3f64 and 0f13ebd5d71f8177^ 3419 edit_file('Makefile.SH', sub { 3420 my $code = shift; 3421 # Bug introduced by 344af494c35a9f0f 3422 # fixed in 0f13ebd5d71f8177 3423 $code =~ s{^(pod/perlapi\.pod) (pod/perlintern\.pod): } 3424 {$1: $2\n\n$2: }m; 3425 # Bug introduced by efa50c51e3301a2c 3426 # fixed in 0f13ebd5d71f8177 3427 $code =~ s{^(uudmap\.h) (bitcount\.h): } 3428 {$1: $2\n\n$2: }m; 3429 3430 # The rats nest of getting git_version.h correct 3431 3432 if ($code =~ s{git_version\.h: stock_git_version\.h 3433\tcp stock_git_version\.h git_version\.h} 3434 {}m) { 3435 # before 486cd780047ff224 3436 3437 # We probably can't build between 3438 # 953f6acfa20ec275^ and 8565263ab8a47cda 3439 # inclusive, but all commits in that range 3440 # relate to getting make_patchnum.sh working, 3441 # so it is extremely unlikely to be an 3442 # interesting bisect target. They will skip. 3443 3444 # No, don't spawn a submake if 3445 # make_patchnum.sh or make_patchnum.pl fails 3446 $code =~ s{\|\| \$\(MAKE\) miniperl.*} 3447 {}m; 3448 $code =~ s{^\t(sh.*make_patchnum\.sh.*)} 3449 {\t-$1}m; 3450 3451 # Use an external perl to run make_patchnum.pl 3452 # because miniperl still depends on 3453 # git_version.h 3454 $code =~ s{^\t.*make_patchnum\.pl} 3455 {\t-$^X make_patchnum.pl}m; 3456 3457 3458 # "Truth in advertising" - running 3459 # make_patchnum generates 2 files. 3460 $code =~ s{^make_patchnum:.*}{ 3461make_patchnum: lib/Config_git.pl 3462 3463git_version.h: lib/Config_git.pl 3464 3465perlmini\$(OBJ_EXT): git_version.h 3466 3467lib/Config_git.pl:}m; 3468 } 3469 # Right, now we've corrected Makefile.SH to 3470 # correctly describe how lib/Config_git.pl and 3471 # git_version.h are made, we need to fix the rest 3472 3473 # This emulates commit 2b63e250843b907e 3474 # This might duplicate the rule stating that 3475 # git_version.h depends on lib/Config_git.pl 3476 # This is harmless. 3477 $code =~ s{^(?:lib/Config_git\.pl )?git_version\.h: (.* make_patchnum\.pl.*)} 3478 {git_version.h: lib/Config_git.pl 3479 3480lib/Config_git.pl: $1}m; 3481 3482 # This emulates commits 0f13ebd5d71f8177 3483 # and a04d4598adc57886. It ensures that 3484 # lib/Config_git.pl is built before configpm, 3485 # and that configpm is run exactly once. 3486 $code =~ s{^(\$\(.*?\) )?(\$\(CONFIGPOD\))(: .*? configpm Porting/Glossary)( lib/Config_git\.pl)?}{ 3487 # If present, other files depend on $(CONFIGPOD) 3488 ($1 ? "$1: $2\n\n" : '') 3489 # Then the rule we found 3490 . $2 . $3 3491 # Add dependency if not there 3492 . ($4 ? $4 : ' lib/Config_git.pl') 3493 }me; 3494 3495 return $code; 3496 }); 3497 } 3498 } 3499 3500 if ($major < 14) { 3501 # Commits dc0655f797469c47 and d11a62fe01f2ecb2 3502 edit_file('Makefile.SH', sub { 3503 my $code = shift; 3504 foreach my $ext (qw(Encode SDBM_File)) { 3505 next if $code =~ /\b$ext\) extra_dep=/s; 3506 $code =~ s!(\) extra_dep="\$extra_dep 3507\$this_target: .*?" ;;) 3508( esac 3509)!$1 3510 $ext) extra_dep="\$extra_dep 3511\$this_target: lib/auto/Cwd/Cwd.\$dlext" ;; 3512$2!; 3513 } 3514 return $code; 3515 }); 3516 } 3517 } 3518 3519 if ($major == 3) { 3520 # This is part of commit f0efd8cf98c95b42: 3521 edit_file('Makefile.SH', sub { 3522 my $code = shift; 3523 $code =~ s/<<!NO!SUBS!/<<'!NO!SUBS!'/; 3524 return $code; 3525 }); 3526 } 3527 3528 if ($major == 7) { 3529 # Remove commits 9fec149bb652b6e9 and 5bab1179608f81d8, which add/amend 3530 # rules to automatically run regen scripts that rebuild C headers. These 3531 # cause problems because a git checkout doesn't preserve relative file 3532 # modification times, hence the regen scripts may fire. This will 3533 # obscure whether the repository had the correct generated headers 3534 # checked in. 3535 # Also, the dependency rules for running the scripts were not correct, 3536 # which could cause spurious re-builds on re-running make, and can cause 3537 # complete build failures for a parallel make. 3538 if (extract_from_file('Makefile.SH', 3539 qr/Writing it this way gives make a big hint to always run opcode\.pl before/)) { 3540 apply_commit('70c6e6715e8fec53'); 3541 } elsif (extract_from_file('Makefile.SH', 3542 qr/^opcode\.h opnames\.h pp_proto\.h pp\.sym: opcode\.pl$/)) { 3543 revert_commit('9fec149bb652b6e9'); 3544 } 3545 } 3546 3547 if ($^O eq 'darwin' && ($major < 8 3548 || ($major < 10 3549 && !extract_from_file('ext/DynaLoader/Makefile.PL', 3550 qr/sub MY::static /)))) { 3551 my $cwd = Cwd::getcwd(); 3552 my $wrapper = 'miniperl.sh'; 3553 my $fh = open_or_die($wrapper, '>'); 3554 print $fh <<"EOT"; 3555#!/bin/sh 3556${aggressive_apple_security}exec $cwd/miniperl "\$\@" 3557EOT 3558 close_or_die($fh); 3559 chmod 0755, $wrapper 3560 or die "Couldn't chmod 0755 $wrapper: $!"; 3561 3562 edit_file('ext/util/make_ext', sub { 3563 my $code = shift; 3564 # This is shell expansion syntax 3565 $code =~ s{ (\.\./\$depth/miniperl) } 3566 { $1.sh }; 3567 # This is actually the same line as edited above. 3568 # We need this because (yay), without this EU::MM will 3569 # default to searching for a working perl binary 3570 # (sensible plan) but due to macOS stripping 3571 # DYLD_LIBRARY_PATH during system(...), .../miniperl 3572 # (as found from $^X) *isn't* going to work. 3573 $code =~ s{ (Makefile\.PL INSTALLDIRS=perl) } 3574 { $1 PERL=\.\./\$depth/miniperl.sh }; 3575 return $code; 3576 }); 3577 } 3578 3579 if ($^O eq 'aix' && $major >= 8 && $major < 28 3580 && extract_from_file('Makefile.SH', qr!\Q./$(MINIPERLEXP) makedef.pl\E.*aix!)) { 3581 # This is a variant the AIX part of commit 72bbce3da5eeffde: 3582 # miniperl also needs -Ilib for perl.exp on AIX etc 3583 edit_file('Makefile.SH', sub { 3584 my $code = shift; 3585 $code =~ s{(\Q./$(MINIPERLEXP)\E) (makedef\.pl.*aix)} 3586 {$1 -Ilib $2}; 3587 return $code; 3588 }) 3589 } 3590 # This is the line before the line we've edited just above: 3591 if ($^O eq 'aix' && $major >= 11 && $major <= 15 3592 && extract_from_file('makedef.pl', qr/^use Config/)) { 3593 edit_file('Makefile.SH', sub { 3594 # The AIX part of commit e6807d8ab22b761c 3595 # It's safe to substitute lib/Config.pm for config.sh 3596 # as lib/Config.pm depends on config.sh 3597 # If the tree is post e6807d8ab22b761c, the substitution 3598 # won't match, which is harmless. 3599 my $code = shift; 3600 $code =~ s{^(perl\.exp:.* )config\.sh(\b.*)} 3601 {$1 . '$(CONFIGPM)' . $2}me; 3602 return $code; 3603 }); 3604 } 3605 3606 # There was a bug in makedepend.SH which was fixed in version 96a8704c. 3607 # Symptom was './makedepend: 1: Syntax error: Unterminated quoted string' 3608 # Remove this if you're actually bisecting a problem related to 3609 # makedepend.SH 3610 # If you do this, you may need to add in code to correct the output of older 3611 # makedepends, which don't correctly filter newer gcc output such as 3612 # <built-in> 3613 3614 # It's the same version in v5.26.0 to v5.34.0 3615 # Post v5.34.0, commit 8d469d0ecbd06a99 completely changes how makedepend.SH 3616 # interacts with Makefile.SH, meaning that it's not a drop-in upgrade. 3617 checkout_file('makedepend.SH', 'v5.34.0') 3618 if $major < 26; 3619 3620 if ($major < 4 && -f 'config.sh' 3621 && !extract_from_file('config.sh', qr/^trnl=/)) { 3622 # This seems to be necessary to avoid makedepend becoming confused, 3623 # and hanging on stdin. Seems that the code after 3624 # make shlist || ...here... is never run. 3625 edit_file('makedepend.SH', sub { 3626 my $code = shift; 3627 $code =~ s/^trnl='\$trnl'$/trnl='\\n'/m; 3628 return $code; 3629 }); 3630 } 3631} 3632 3633sub patch_C { 3634 # This is ordered by $major, as it's likely that different platforms may 3635 # well want to share code. 3636 3637 if ($major == 0) { 3638 apply_patch(<<'EOPATCH'); 3639diff --git a/proto.h b/proto.h 3640index 9ffc6bbabc..16da198342 100644 3641--- a/proto.h 3642+++ b/proto.h 3643@@ -8,6 +8,7 @@ 3644 #endif 3645 #ifdef OVERLOAD 3646 SV* amagic_call _((SV* left,SV* right,int method,int dir)); 3647+bool Gv_AMupdate _((HV* stash)); 3648 #endif /* OVERLOAD */ 3649 OP* append_elem _((I32 optype, OP* head, OP* tail)); 3650 OP* append_list _((I32 optype, LISTOP* first, LISTOP* last)); 3651EOPATCH 3652 } 3653 3654 if ($major == 2 && extract_from_file('perl.c', qr/^\tfclose\(e_fp\);$/)) { 3655 # need to patch perl.c to avoid calling fclose() twice on e_fp when 3656 # using -e 3657 # This diff is part of commit ab821d7fdc14a438. The second close was 3658 # introduced with perl-5.002, commit a5f75d667838e8e7 3659 # Might want a6c477ed8d4864e6 too, for the corresponding change to 3660 # pp_ctl.c (likely without this, eval will have "fun") 3661 apply_patch(<<'EOPATCH'); 3662diff --git a/perl.c b/perl.c 3663index 03c4d48..3c814a2 100644 3664--- a/perl.c 3665+++ b/perl.c 3666@@ -252,6 +252,7 @@ setuid perl scripts securely.\n"); 3667 #ifndef VMS /* VMS doesn't have environ array */ 3668 origenviron = environ; 3669 #endif 3670+ e_tmpname = Nullch; 3671 3672 if (do_undump) { 3673 3674@@ -405,6 +406,7 @@ setuid perl scripts securely.\n"); 3675 if (e_fp) { 3676 if (Fflush(e_fp) || ferror(e_fp) || fclose(e_fp)) 3677 croak("Can't write to temp file for -e: %s", Strerror(errno)); 3678+ e_fp = Nullfp; 3679 argc++,argv--; 3680 scriptname = e_tmpname; 3681 } 3682@@ -470,10 +472,10 @@ setuid perl scripts securely.\n"); 3683 curcop->cop_line = 0; 3684 curstash = defstash; 3685 preprocess = FALSE; 3686- if (e_fp) { 3687- fclose(e_fp); 3688- e_fp = Nullfp; 3689+ if (e_tmpname) { 3690 (void)UNLINK(e_tmpname); 3691+ Safefree(e_tmpname); 3692+ e_tmpname = Nullch; 3693 } 3694 3695 /* now that script is parsed, we can modify record separator */ 3696@@ -1369,7 +1371,7 @@ SV *sv; 3697 scriptname = xfound; 3698 } 3699 3700- origfilename = savepv(e_fp ? "-e" : scriptname); 3701+ origfilename = savepv(e_tmpname ? "-e" : scriptname); 3702 curcop->cop_filegv = gv_fetchfile(origfilename); 3703 if (strEQ(origfilename,"-")) 3704 scriptname = ""; 3705 3706EOPATCH 3707 } 3708 3709 if ($major < 3 && $^O eq 'openbsd' 3710 && !extract_from_file('pp_sys.c', qr/BSD_GETPGRP/)) { 3711 # Part of commit c3293030fd1b7489 3712 apply_patch(<<'EOPATCH'); 3713diff --git a/pp_sys.c b/pp_sys.c 3714index 4608a2a..f0c9d1d 100644 3715--- a/pp_sys.c 3716+++ b/pp_sys.c 3717@@ -2903,8 +2903,8 @@ PP(pp_getpgrp) 3718 pid = 0; 3719 else 3720 pid = SvIVx(POPs); 3721-#ifdef USE_BSDPGRP 3722- value = (I32)getpgrp(pid); 3723+#ifdef BSD_GETPGRP 3724+ value = (I32)BSD_GETPGRP(pid); 3725 #else 3726 if (pid != 0) 3727 DIE("POSIX getpgrp can't take an argument"); 3728@@ -2933,8 +2933,8 @@ PP(pp_setpgrp) 3729 } 3730 3731 TAINT_PROPER("setpgrp"); 3732-#ifdef USE_BSDPGRP 3733- SETi( setpgrp(pid, pgrp) >= 0 ); 3734+#ifdef BSD_SETPGRP 3735+ SETi( BSD_SETPGRP(pid, pgrp) >= 0 ); 3736 #else 3737 if ((pgrp != 0) || (pid != 0)) { 3738 DIE("POSIX setpgrp can't take an argument"); 3739EOPATCH 3740 } 3741 3742 # _(( was the macro wrapper for hiding ANSI prototypes from K&R C compilers: 3743 if ($major == 3 && !extract_from_file('proto.h', qr/\bsafemalloc\s+_\(\(/)) { 3744 # This is part of commit bbce6d69784bf43b: 3745 # [inseparable changes from patch from perl5.003_08 to perl5.003_09] 3746 # This only affects a few versions, but without this safemalloc etc get 3747 # an implicit return type (of int), and that is truncating addresses on 3748 # 64 bit systems. (And these days, seems that x86_64 linux has a memory 3749 # map which causes malloc to return addresses >= 2**32) 3750 apply_patch(<<'EOPATCH'); 3751diff --git a/proto.h b/proto.h 3752index 851567b340..e650c8b07d 100644 3753--- a/proto.h 3754+++ b/proto.h 3755@@ -479,6 +479,13 @@ Malloc_t realloc _((Malloc_t where, MEM_SIZE nbytes)); 3756 Free_t free _((Malloc_t where)); 3757 #endif 3758 3759+#ifndef MYMALLOC 3760+Malloc_t safemalloc _((MEM_SIZE nbytes)); 3761+Malloc_t safecalloc _((MEM_SIZE elements, MEM_SIZE size)); 3762+Malloc_t saferealloc _((Malloc_t where, MEM_SIZE nbytes)); 3763+Free_t safefree _((Malloc_t where)); 3764+#endif 3765+ 3766 #ifdef LEAKTEST 3767 Malloc_t safexmalloc _((I32 x, MEM_SIZE size)); 3768 Malloc_t safexcalloc _((I32 x, MEM_SIZE elements, MEM_SIZE size)); 3769EOPATCH 3770 } 3771 3772 if ($major < 4 && $^O eq 'openbsd') { 3773 my $bad; 3774 # Need changes from commit a6e633defa583ad5. 3775 # Commits c07a80fdfe3926b5 and f82b3d4130164d5f changed the same part 3776 # of perl.h 3777 3778 if (extract_from_file('perl.h', 3779 qr/^#ifdef HAS_GETPGRP2$/)) { 3780 $bad = <<'EOBAD'; 3781*************** 3782*** 57,71 **** 3783 #define TAINT_PROPER(s) if (tainting) taint_proper(no_security, s) 3784 #define TAINT_ENV() if (tainting) taint_env() 3785 3786! #ifdef HAS_GETPGRP2 3787! # ifndef HAS_GETPGRP 3788! # define HAS_GETPGRP 3789! # endif 3790! #endif 3791! 3792! #ifdef HAS_SETPGRP2 3793! # ifndef HAS_SETPGRP 3794! # define HAS_SETPGRP 3795! # endif 3796 #endif 3797 3798EOBAD 3799 } elsif (extract_from_file('perl.h', 3800 qr/Gack, you have one but not both of getpgrp2/)) { 3801 $bad = <<'EOBAD'; 3802*************** 3803*** 56,76 **** 3804 #define TAINT_PROPER(s) if (tainting) taint_proper(no_security, s) 3805 #define TAINT_ENV() if (tainting) taint_env() 3806 3807! #if defined(HAS_GETPGRP2) && defined(HAS_SETPGRP2) 3808! # define getpgrp getpgrp2 3809! # define setpgrp setpgrp2 3810! # ifndef HAS_GETPGRP 3811! # define HAS_GETPGRP 3812! # endif 3813! # ifndef HAS_SETPGRP 3814! # define HAS_SETPGRP 3815! # endif 3816! # ifndef USE_BSDPGRP 3817! # define USE_BSDPGRP 3818! # endif 3819! #else 3820! # if defined(HAS_GETPGRP2) || defined(HAS_SETPGRP2) 3821! #include "Gack, you have one but not both of getpgrp2() and setpgrp2()." 3822! # endif 3823 #endif 3824 3825EOBAD 3826 } elsif (extract_from_file('perl.h', 3827 qr/^#ifdef USE_BSDPGRP$/)) { 3828 $bad = <<'EOBAD' 3829*************** 3830*** 91,116 **** 3831 #define TAINT_PROPER(s) if (tainting) taint_proper(no_security, s) 3832 #define TAINT_ENV() if (tainting) taint_env() 3833 3834! #ifdef USE_BSDPGRP 3835! # ifdef HAS_GETPGRP 3836! # define BSD_GETPGRP(pid) getpgrp((pid)) 3837! # endif 3838! # ifdef HAS_SETPGRP 3839! # define BSD_SETPGRP(pid, pgrp) setpgrp((pid), (pgrp)) 3840! # endif 3841! #else 3842! # ifdef HAS_GETPGRP2 3843! # define BSD_GETPGRP(pid) getpgrp2((pid)) 3844! # ifndef HAS_GETPGRP 3845! # define HAS_GETPGRP 3846! # endif 3847! # endif 3848! # ifdef HAS_SETPGRP2 3849! # define BSD_SETPGRP(pid, pgrp) setpgrp2((pid), (pgrp)) 3850! # ifndef HAS_SETPGRP 3851! # define HAS_SETPGRP 3852! # endif 3853! # endif 3854 #endif 3855 3856 #ifndef _TYPES_ /* If types.h defines this it's easy. */ 3857EOBAD 3858 } 3859 if ($bad) { 3860 apply_patch(<<"EOPATCH"); 3861*** a/perl.h 2011-10-21 09:46:12.000000000 +0200 3862--- b/perl.h 2011-10-21 09:46:12.000000000 +0200 3863$bad--- 91,144 ---- 3864 #define TAINT_PROPER(s) if (tainting) taint_proper(no_security, s) 3865 #define TAINT_ENV() if (tainting) taint_env() 3866 3867! /* XXX All process group stuff is handled in pp_sys.c. Should these 3868! defines move there? If so, I could simplify this a lot. --AD 9/96. 3869! */ 3870! /* Process group stuff changed from traditional BSD to POSIX. 3871! perlfunc.pod documents the traditional BSD-style syntax, so we'll 3872! try to preserve that, if possible. 3873! */ 3874! #ifdef HAS_SETPGID 3875! # define BSD_SETPGRP(pid, pgrp) setpgid((pid), (pgrp)) 3876! #else 3877! # if defined(HAS_SETPGRP) && defined(USE_BSD_SETPGRP) 3878! # define BSD_SETPGRP(pid, pgrp) setpgrp((pid), (pgrp)) 3879! # else 3880! # ifdef HAS_SETPGRP2 /* DG/UX */ 3881! # define BSD_SETPGRP(pid, pgrp) setpgrp2((pid), (pgrp)) 3882! # endif 3883! # endif 3884! #endif 3885! #if defined(BSD_SETPGRP) && !defined(HAS_SETPGRP) 3886! # define HAS_SETPGRP /* Well, effectively it does . . . */ 3887! #endif 3888! 3889! /* getpgid isn't POSIX, but at least Solaris and Linux have it, and it makes 3890! our life easier :-) so we'll try it. 3891! */ 3892! #ifdef HAS_GETPGID 3893! # define BSD_GETPGRP(pid) getpgid((pid)) 3894! #else 3895! # if defined(HAS_GETPGRP) && defined(USE_BSD_GETPGRP) 3896! # define BSD_GETPGRP(pid) getpgrp((pid)) 3897! # else 3898! # ifdef HAS_GETPGRP2 /* DG/UX */ 3899! # define BSD_GETPGRP(pid) getpgrp2((pid)) 3900! # endif 3901! # endif 3902! #endif 3903! #if defined(BSD_GETPGRP) && !defined(HAS_GETPGRP) 3904! # define HAS_GETPGRP /* Well, effectively it does . . . */ 3905! #endif 3906! 3907! /* These are not exact synonyms, since setpgrp() and getpgrp() may 3908! have different behaviors, but perl.h used to define USE_BSDPGRP 3909! (prior to 5.003_05) so some extension might depend on it. 3910! */ 3911! #if defined(USE_BSD_SETPGRP) || defined(USE_BSD_GETPGRP) 3912! # ifndef USE_BSDPGRP 3913! # define USE_BSDPGRP 3914! # endif 3915 #endif 3916 3917 #ifndef _TYPES_ /* If types.h defines this it's easy. */ 3918EOPATCH 3919 } 3920 } 3921 3922 if ($major < 4 && $^O eq 'hpux' 3923 && extract_from_file('sv.c', qr/i = _filbuf\(/)) { 3924 apply_patch(<<'EOPATCH'); 3925diff --git a/sv.c b/sv.c 3926index a1f1d60..0a806f1 100644 3927--- a/sv.c 3928+++ b/sv.c 3929@@ -2641,7 +2641,7 @@ I32 append; 3930 3931 FILE_cnt(fp) = cnt; /* deregisterize cnt and ptr */ 3932 FILE_ptr(fp) = ptr; 3933- i = _filbuf(fp); /* get more characters */ 3934+ i = __filbuf(fp); /* get more characters */ 3935 cnt = FILE_cnt(fp); 3936 ptr = FILE_ptr(fp); /* reregisterize cnt and ptr */ 3937 3938 3939EOPATCH 3940 } 3941 3942 if ($major == 4 && extract_from_file('scope.c', qr/\(SV\*\)SSPOPINT/)) { 3943 # [PATCH] 5.004_04 +MAINT_TRIAL_1 broken when sizeof(int) != sizeof(void) 3944 # Fixes a bug introduced in 161b7d1635bc830b 3945 apply_commit('9002cb76ec83ef7f'); 3946 } 3947 3948 if ($major == 4 && extract_from_file('av.c', qr/AvARRAY\(av\) = 0;/)) { 3949 # Fixes a bug introduced in 1393e20655efb4bc 3950 apply_commit('e1c148c28bf3335b', 'av.c'); 3951 } 3952 3953 if ($major == 4) { 3954 my $rest = extract_from_file('perl.c', qr/delimcpy(.*)/); 3955 if (defined $rest and $rest !~ /,$/) { 3956 # delimcpy added in fc36a67e8855d031, perl.c refactored to use it. 3957 # bug introduced in 2a92aaa05aa1acbf, fixed in 8490252049bf42d3 3958 # code then moved to util.c in commit 491527d0220de34e 3959 apply_patch(<<'EOPATCH'); 3960diff --git a/perl.c b/perl.c 3961index 4eb69e3..54bbb00 100644 3962--- a/perl.c 3963+++ b/perl.c 3964@@ -1735,7 +1735,7 @@ SV *sv; 3965 if (len < sizeof tokenbuf) 3966 tokenbuf[len] = '\0'; 3967 #else /* ! (atarist || DOSISH) */ 3968- s = delimcpy(tokenbuf, tokenbuf + sizeof tokenbuf, s, bufend 3969+ s = delimcpy(tokenbuf, tokenbuf + sizeof tokenbuf, s, bufend, 3970 ':', 3971 &len); 3972 #endif /* ! (atarist || DOSISH) */ 3973EOPATCH 3974 } 3975 } 3976 3977 if ($major == 4 && $^O eq 'linux') { 3978 # Whilst this is fixed properly in f0784f6a4c3e45e1 which provides the 3979 # Configure probe, it's easier to back out the problematic changes made 3980 # in these previous commits. 3981 3982 # In maint-5.004, the simplest addition is to "correct" the file to 3983 # use the same pre-processor macros as blead had used. Whilst commit 3984 # 9b599b2a63d2324d (reverted below) is described as 3985 # [win32] merge change#887 from maintbranch 3986 # it uses __sun__ and __svr4__ instead of the __sun and __SVR4 of the 3987 # maint branch commit 6cdf74fe31f049dc 3988 3989 edit_file('doio.c', sub { 3990 my $code = shift; 3991 $code =~ s{defined\(__sun\) && defined\(__SVR4\)} 3992 {defined(__sun__) && defined(__svr4__)}g; 3993 return $code; 3994 }); 3995 3996 if (extract_from_file('doio.c', 3997 qr!^/\* XXX REALLY need metaconfig test \*/$!)) { 3998 revert_commit('4682965a1447ea44', 'doio.c'); 3999 } 4000 if (my $token = extract_from_file('doio.c', 4001 qr!^#if (defined\(__sun(?:__)?\)) && defined\(__svr4__\) /\* XXX Need metaconfig test \*/$!)) { 4002 my $patch = patch_from_commit('revert', '9b599b2a63d2324d', 'doio.c'); 4003 $patch =~ s/defined\(__sun__\)/$token/g; 4004 apply_patch($patch); 4005 } 4006 if (extract_from_file('doio.c', 4007 qr!^/\* linux \(and Solaris2\?\) uses :$!)) { 4008 revert_commit('8490252049bf42d3', 'doio.c'); 4009 } 4010 if (extract_from_file('doio.c', 4011 qr/^ unsemds.buf = &semds;$/)) { 4012 revert_commit('8e591e46b4c6543e'); 4013 } 4014 if (extract_from_file('doio.c', 4015 qr!^#ifdef __linux__ /\* XXX Need metaconfig test \*/$!)) { 4016 # Reverts part of commit 3e3baf6d63945cb6 4017 apply_patch(<<'EOPATCH'); 4018diff --git b/doio.c a/doio.c 4019index 62b7de9..0d57425 100644 4020--- b/doio.c 4021+++ a/doio.c 4022@@ -1333,9 +1331,6 @@ SV **sp; 4023 char *a; 4024 I32 id, n, cmd, infosize, getinfo; 4025 I32 ret = -1; 4026-#ifdef __linux__ /* XXX Need metaconfig test */ 4027- union semun unsemds; 4028-#endif 4029 4030 id = SvIVx(*++mark); 4031 n = (optype == OP_SEMCTL) ? SvIVx(*++mark) : 0; 4032@@ -1364,29 +1359,11 @@ SV **sp; 4033 infosize = sizeof(struct semid_ds); 4034 else if (cmd == GETALL || cmd == SETALL) 4035 { 4036-#ifdef __linux__ /* XXX Need metaconfig test */ 4037-/* linux uses : 4038- int semctl (int semid, int semnun, int cmd, union semun arg) 4039- 4040- union semun { 4041- int val; 4042- struct semid_ds *buf; 4043- ushort *array; 4044- }; 4045-*/ 4046- union semun semds; 4047- if (semctl(id, 0, IPC_STAT, semds) == -1) 4048-#else 4049 struct semid_ds semds; 4050 if (semctl(id, 0, IPC_STAT, &semds) == -1) 4051-#endif 4052 return -1; 4053 getinfo = (cmd == GETALL); 4054-#ifdef __linux__ /* XXX Need metaconfig test */ 4055- infosize = semds.buf->sem_nsems * sizeof(short); 4056-#else 4057 infosize = semds.sem_nsems * sizeof(short); 4058-#endif 4059 /* "short" is technically wrong but much more portable 4060 than guessing about u_?short(_t)? */ 4061 } 4062@@ -1429,12 +1406,7 @@ SV **sp; 4063 #endif 4064 #ifdef HAS_SEM 4065 case OP_SEMCTL: 4066-#ifdef __linux__ /* XXX Need metaconfig test */ 4067- unsemds.buf = (struct semid_ds *)a; 4068- ret = semctl(id, n, cmd, unsemds); 4069-#else 4070 ret = semctl(id, n, cmd, (struct semid_ds *)a); 4071-#endif 4072 break; 4073 #endif 4074 #ifdef HAS_SHM 4075EOPATCH 4076 } 4077 # Incorrect prototype added as part of 8ac853655d9b7447, fixed as part 4078 # of commit dc45a647708b6c54, with at least one intermediate 4079 # modification. Correct prototype for gethostbyaddr has socklen_t 4080 # second. Linux has uint32_t first for getnetbyaddr. 4081 # Easiest just to remove, instead of attempting more complex patching. 4082 # Something similar may be needed on other platforms. 4083 edit_file('pp_sys.c', sub { 4084 my $code = shift; 4085 $code =~ s/^ struct hostent \*(?:PerlSock_)?gethostbyaddr\([^)]+\);$//m; 4086 $code =~ s/^ struct netent \*getnetbyaddr\([^)]+\);$//m; 4087 return $code; 4088 }); 4089 } 4090 4091 if ($major < 5 && $^O eq 'aix' 4092 && !extract_from_file('pp_sys.c', 4093 qr/defined\(HOST_NOT_FOUND\) && !defined\(h_errno\)/)) { 4094 # part of commit dc45a647708b6c54 4095 # Andy Dougherty's configuration patches (Config_63-01 up to 04). 4096 apply_patch(<<'EOPATCH') 4097diff --git a/pp_sys.c b/pp_sys.c 4098index c2fcb6f..efa39fb 100644 4099--- a/pp_sys.c 4100+++ b/pp_sys.c 4101@@ -54,7 +54,7 @@ extern "C" int syscall(unsigned long,...); 4102 #endif 4103 #endif 4104 4105-#ifdef HOST_NOT_FOUND 4106+#if defined(HOST_NOT_FOUND) && !defined(h_errno) 4107 extern int h_errno; 4108 #endif 4109 4110EOPATCH 4111 } 4112 4113 if ($major == 5 4114 && `git rev-parse HEAD` eq "22c35a8c2392967a5ba6b5370695be464bd7012c\n") { 4115 # Commit 22c35a8c2392967a is significant, 4116 # "phase 1 of somewhat major rearrangement of PERL_OBJECT stuff" 4117 # but doesn't build due to 2 simple errors. blead in this broken state 4118 # was merged to the cfgperl branch, and then these were immediately 4119 # corrected there. cfgperl (with the fixes) was merged back to blead. 4120 # The resultant rather twisty maze of commits looks like this: 4121 4122=begin comment 4123 4124* | | commit 137225782c183172f360c827424b9b9f8adbef0e 4125|\ \ \ Merge: 22c35a8 2a8ee23 4126| |/ / Author: Gurusamy Sarathy <gsar@cpan.org> 4127| | | Date: Fri Oct 30 17:38:36 1998 +0000 4128| | | 4129| | | integrate cfgperl tweaks into mainline 4130| | | 4131| | | p4raw-id: //depot/perl@2144 4132| | | 4133| * | commit 2a8ee23279873759693fa83eca279355db2b665c 4134| | | Author: Jarkko Hietaniemi <jhi@iki.fi> 4135| | | Date: Fri Oct 30 13:27:39 1998 +0000 4136| | | 4137| | | There can be multiple yacc/bison errors. 4138| | | 4139| | | p4raw-id: //depot/cfgperl@2143 4140| | | 4141| * | commit 93fb2ac393172fc3e2c14edb20b718309198abbc 4142| | | Author: Jarkko Hietaniemi <jhi@iki.fi> 4143| | | Date: Fri Oct 30 13:18:43 1998 +0000 4144| | | 4145| | | README.posix-bc update. 4146| | | 4147| | | p4raw-id: //depot/cfgperl@2142 4148| | | 4149| * | commit 4ec43091e8e6657cb260b5e563df30aaa154effe 4150| | | Author: Jarkko Hietaniemi <jhi@iki.fi> 4151| | | Date: Fri Oct 30 09:12:59 1998 +0000 4152| | | 4153| | | #2133 fallout. 4154| | | 4155| | | p4raw-id: //depot/cfgperl@2141 4156| | | 4157| * | commit 134ca994cfefe0f613d43505a885e4fc2100b05c 4158| |\ \ Merge: 7093112 22c35a8 4159| |/ / Author: Jarkko Hietaniemi <jhi@iki.fi> 4160|/| | Date: Fri Oct 30 08:43:18 1998 +0000 4161| | | 4162| | | Integrate from mainperl. 4163| | | 4164| | | p4raw-id: //depot/cfgperl@2140 4165| | | 4166* | | commit 22c35a8c2392967a5ba6b5370695be464bd7012c 4167| | | Author: Gurusamy Sarathy <gsar@cpan.org> 4168| | | Date: Fri Oct 30 02:51:39 1998 +0000 4169| | | 4170| | | phase 1 of somewhat major rearrangement of PERL_OBJECT stuff 4171| | | (objpp.h is gone, embed.pl now does some of that); objXSUB.h 4172| | | should soon be automated also; the global variables that 4173| | | escaped the PL_foo conversion are now reined in; renamed 4174| | | MAGIC in regcomp.h to REG_MAGIC to avoid collision with the 4175| | | type of same name; duplicated lists of pp_things in various 4176| | | places is now gone; result has only been tested on win32 4177| | | 4178| | | p4raw-id: //depot/perl@2133 4179 4180=end comment 4181 4182=cut 4183 4184 # and completely confuses git bisect (and at least me), causing it to 4185 # the bisect run to confidently return the wrong answer, an unrelated 4186 # commit on the cfgperl branch. 4187 4188 apply_commit('4ec43091e8e6657c'); 4189 } 4190 4191 if ($major == 5 4192 && extract_from_file('pp_sys.c', qr/PERL_EFF_ACCESS_R_OK/) 4193 && !extract_from_file('pp_sys.c', qr/XXX Configure test needed for eaccess/)) { 4194 # Between 5ff3f7a4e03a6b10 and c955f1177b2e311d^ 4195 # This is the meat of commit c955f1177b2e311d (without the other 4196 # indenting changes that would cause a conflict). 4197 # Without this 538 revisions won't build on (at least) Linux 4198 apply_patch(<<'EOPATCH'); 4199diff --git a/pp_sys.c b/pp_sys.c 4200index d60c8dc..867dee4 100644 4201--- a/pp_sys.c 4202+++ b/pp_sys.c 4203@@ -198,9 +198,18 @@ static char zero_but_true[ZBTLEN + 1] = "0 but true"; 4204 # if defined(I_SYS_SECURITY) 4205 # include <sys/security.h> 4206 # endif 4207-# define PERL_EFF_ACCESS_R_OK(p) (eaccess((p), R_OK, ACC_SELF)) 4208-# define PERL_EFF_ACCESS_W_OK(p) (eaccess((p), W_OK, ACC_SELF)) 4209-# define PERL_EFF_ACCESS_X_OK(p) (eaccess((p), X_OK, ACC_SELF)) 4210+ /* XXX Configure test needed for eaccess */ 4211+# ifdef ACC_SELF 4212+ /* HP SecureWare */ 4213+# define PERL_EFF_ACCESS_R_OK(p) (eaccess((p), R_OK, ACC_SELF)) 4214+# define PERL_EFF_ACCESS_W_OK(p) (eaccess((p), W_OK, ACC_SELF)) 4215+# define PERL_EFF_ACCESS_X_OK(p) (eaccess((p), X_OK, ACC_SELF)) 4216+# else 4217+ /* SCO */ 4218+# define PERL_EFF_ACCESS_R_OK(p) (eaccess((p), R_OK)) 4219+# define PERL_EFF_ACCESS_W_OK(p) (eaccess((p), W_OK)) 4220+# define PERL_EFF_ACCESS_X_OK(p) (eaccess((p), X_OK)) 4221+# endif 4222 #endif 4223 4224 #if !defined(PERL_EFF_ACCESS_R_OK) && defined(HAS_ACCESSX) && defined(ACC_SELF) 4225EOPATCH 4226 } 4227 4228 if ($major == 5 4229 && extract_from_file('mg.c', qr/If we're still on top of the stack, pop us off/) 4230 && !extract_from_file('mg.c', qr/PL_savestack_ix -= popval/)) { 4231 # Fix up commit 455ece5e082708b1: 4232 # SSNEW() API for allocating memory on the savestack 4233 # Message-Id: <tqemtae338.fsf@puma.genscan.com> 4234 # Subject: [PATCH 5.005_51] (was: why SAVEDESTRUCTOR()...) 4235 apply_commit('3c8a44569607336e', 'mg.c'); 4236 } 4237 4238 if ($major == 5) { 4239 if (extract_from_file('doop.c', qr/croak\(no_modify\);/) 4240 && extract_from_file('doop.c', qr/croak\(PL_no_modify\);/)) { 4241 # Whilst the log suggests that this would only fix 5 commits, in 4242 # practice this area of history is a complete tarpit, and git bisect 4243 # gets very confused by the skips in the middle of the back and 4244 # forth merging between //depot/perl and //depot/cfgperl 4245 apply_commit('6393042b638dafd3'); 4246 } 4247 4248 # One error "fixed" with another: 4249 if (extract_from_file('pp_ctl.c', 4250 qr/\Qstatic void *docatch_body _((void *o));\E/)) { 4251 apply_commit('5b51e982882955fe'); 4252 } 4253 # Which is then fixed by this: 4254 if (extract_from_file('pp_ctl.c', 4255 qr/\Qstatic void *docatch_body _((valist\E/)) { 4256 apply_commit('47aa779ee4c1a50e'); 4257 } 4258 4259 if (extract_from_file('thrdvar.h', qr/PERLVARI\(Tprotect/) 4260 && !extract_from_file('embedvar.h', qr/PL_protect/)) { 4261 # Commit 312caa8e97f1c7ee didn't update embedvar.h 4262 apply_commit('e0284a306d2de082', 'embedvar.h'); 4263 } 4264 } 4265 4266 if ($major == 5 4267 && extract_from_file('sv.c', 4268 qr/PerlDir_close\(IoDIRP\((?:\(IO\*\))?sv\)\);/) 4269 && !(extract_from_file('toke.c', 4270 qr/\QIoDIRP(FILTER_DATA(AvFILLp(PL_rsfp_filters))) = NULL\E/) 4271 || extract_from_file('toke.c', 4272 qr/\QIoDIRP(datasv) = (DIR*)NULL;\E/))) { 4273 # Commit 93578b34124e8a3b, //depot/perl@3298 4274 # close directory handles properly when localized, 4275 # tweaked slightly by commit 1236053a2c722e2b, 4276 # add test case for change#3298 4277 # 4278 # The fix is the last part of: 4279 # 4280 # various fixes for clean build and test on win32; configpm broken, 4281 # needed to open myconfig.SH rather than myconfig; sundry adjustments 4282 # to bytecode stuff; tweaks to DYNAMIC_ENV_FETCH code to make it 4283 # work under win32; getenv_sv() changed to getenv_len() since SVs 4284 # aren't visible in the lower echelons; remove bogus exports from 4285 # config.sym; PERL_OBJECT-ness for C++ exception support; null out 4286 # IoDIRP in filter_del() or sv_free() will attempt to close it 4287 # 4288 # The changed code is modified subsequently by commit e0c198038146b7a4 4289 apply_commit('a6c403648ecd5cc7', 'toke.c'); 4290 } 4291 4292 if ($major < 6 && $^O eq 'netbsd' 4293 && !extract_from_file('unixish.h', 4294 qr/defined\(NSIG\).*defined\(__NetBSD__\)/)) { 4295 apply_patch(<<'EOPATCH') 4296diff --git a/unixish.h b/unixish.h 4297index 2a6cbcd..eab2de1 100644 4298--- a/unixish.h 4299+++ b/unixish.h 4300@@ -89,7 +89,7 @@ 4301 */ 4302 /* #define ALTERNATE_SHEBANG "#!" / **/ 4303 4304-#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) 4305+#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) || defined(__NetBSD__) 4306 # include <signal.h> 4307 #endif 4308 4309EOPATCH 4310 } 4311 4312 if ($major < 6 && extract_from_file('perl.h', qr/PL_uuemap\[\]/)) { 4313 # That [] needs to be [65]: 4314 apply_commit('7575fa06ca7baf15'); 4315 } 4316 4317 if ($major < 6 && $^O eq 'darwin' 4318 && !extract_from_file('perl.h', qr/ifdef I_FCNTL/)) { 4319 # This is part of commit 9a34ef1dede5fef4, but in a stable part of the 4320 # file: 4321 apply_patch(<<'EOPATCH') 4322diff --git a/perl.h b/perl.h 4323index 0d3f0b8333..19f6684894 100644 4324--- a/perl.h 4325+++ b/perl.h 4326@@ -310,6 +310,14 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); 4327 # define BYTEORDER 0x1234 4328 #endif 4329 4330+#ifdef I_FCNTL 4331+# include <fcntl.h> 4332+#endif 4333+ 4334+#ifdef I_SYS_FILE 4335+# include <sys/file.h> 4336+#endif 4337+ 4338 /* Overall memory policy? */ 4339 #ifndef CONSERVATIVE 4340 # define LIBERAL 1 4341EOPATCH 4342 } 4343 4344 if ($major == 7 && $^O eq 'aix' && -f 'ext/List/Util/Util.xs' 4345 && extract_from_file('ext/List/Util/Util.xs', qr/PUSHBLOCK/) 4346 && !extract_from_file('makedef.pl', qr/^Perl_cxinc/)) { 4347 # Need this to get List::Utils 1.03 and later to compile. 4348 # 1.03 also expects to call Perl_pp_rand. Commit d3632a54487acc5f 4349 # fixes this (for the unthreaded case), but it's not until 1.05, 4350 # two days later, that this is fixed properly. 4351 apply_commit('cbb96eed3f175499'); 4352 } 4353 4354 if (($major >= 7 || $major <= 9) && $^O eq 'openbsd' 4355 && `uname -m` eq "sparc64\n" 4356 # added in 2000 by commit cb434fcc98ac25f5: 4357 && extract_from_file('regexec.c', 4358 qr!/\* No need to save/restore up to this paren \*/!) 4359 # re-indented in 2006 by commit 95b2444054382532: 4360 && extract_from_file('regexec.c', qr/^\t\tCURCUR cc;$/)) { 4361 # Need to work around a bug in (at least) OpenBSD's 4.6's sparc64 # 4362 # compiler ["gcc (GCC) 3.3.5 (propolice)"]. Between commits 4363 # 3ec562b0bffb8b8b (2002) and 1a4fad37125bac3e^ (2005) the darling thing 4364 # fails to compile any code for the statement cc.oldcc = PL_regcc; 4365 # 4366 # If you refactor the code to "fix" that, or force the issue using set 4367 # in the debugger, the stack smashing detection code fires on return 4368 # from S_regmatch(). Turns out that the compiler doesn't allocate any 4369 # (or at least enough) space for cc. 4370 # 4371 # Restore the "uninitialised" value for cc before function exit, and the 4372 # stack smashing code is placated. "Fix" 3ec562b0bffb8b8b (which 4373 # changes the size of auto variables used elsewhere in S_regmatch), and 4374 # the crash is visible back to bc517b45fdfb539b (which also changes 4375 # buffer sizes). "Unfix" 1a4fad37125bac3e and the crash is visible until 4376 # 5b47454deb66294b. Problem goes away if you compile with -O, or hack 4377 # the code as below. 4378 # 4379 # Hence this turns out to be a bug in (old) gcc. Not a security bug we 4380 # still need to fix. 4381 apply_patch(<<'EOPATCH'); 4382diff --git a/regexec.c b/regexec.c 4383index 900b491..6251a0b 100644 4384--- a/regexec.c 4385+++ b/regexec.c 4386@@ -2958,7 +2958,11 @@ S_regmatch(pTHX_ regnode *prog) 4387 I,I 4388 *******************************************************************/ 4389 case CURLYX: { 4390- CURCUR cc; 4391+ union { 4392+ CURCUR hack_cc; 4393+ char hack_buff[sizeof(CURCUR) + 1]; 4394+ } hack; 4395+#define cc hack.hack_cc 4396 CHECKPOINT cp = PL_savestack_ix; 4397 /* No need to save/restore up to this paren */ 4398 I32 parenfloor = scan->flags; 4399@@ -2983,6 +2987,7 @@ S_regmatch(pTHX_ regnode *prog) 4400 n = regmatch(PREVOPER(next)); /* start on the WHILEM */ 4401 regcpblow(cp); 4402 PL_regcc = cc.oldcc; 4403+#undef cc 4404 saySAME(n); 4405 } 4406 /* NOT REACHED */ 4407EOPATCH 4408} 4409 4410 if ($major < 8 && !extract_from_file('perl.h', qr/\bshort htovs\b/)) { 4411 # This is part of commit c623ac675720b314 4412 apply_patch(<<'EOPATCH'); 4413diff --git a/perl.h b/perl.h 4414index 023b90b7ea..59a21faecd 100644 4415--- a/perl.h 4416+++ b/perl.h 4417@@ -2279,4 +2279,8 @@ struct ptr_tbl { 4418 # endif 4419 /* otherwise default to functions in util.c */ 4420+short htovs(short n); 4421+short vtohs(short n); 4422+long htovl(long n); 4423+long vtohl(long n); 4424 #endif 4425 4426EOPATCH 4427 } 4428 4429 if ($major < 8 && !extract_from_file('perl.h', qr/include <unistd\.h>/)) { 4430 # This is part of commit 3f270f98f9305540, applied at a slightly 4431 # different location in perl.h, where the context is stable back to 4432 # 5.000 4433 apply_patch(<<'EOPATCH'); 4434diff --git a/perl.h b/perl.h 4435index 9418b52..b8b1a7c 100644 4436--- a/perl.h 4437+++ b/perl.h 4438@@ -496,6 +496,10 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); 4439 # include <sys/param.h> 4440 #endif 4441 4442+/* If this causes problems, set i_unistd=undef in the hint file. */ 4443+#ifdef I_UNISTD 4444+# include <unistd.h> 4445+#endif 4446 4447 /* Use all the "standard" definitions? */ 4448 #if defined(STANDARD_C) && defined(I_STDLIB) 4449EOPATCH 4450 } 4451 4452 if ($major < 10) { 4453 # This is commit 731e259481f36b35, but adapted to remove all the 4454 # variations of guards around the inclusion of <signal.h> 4455 # Whilst we only hit this as a problem on arm64 macOS (so far), because 4456 # it insists on prototypes for everything, I'm assuming that doing this 4457 # everywhere and unconditionally might solve similar problems on other 4458 # platforms. Certainly, it *ought* to be safe to include a C89 header 4459 # these days. 4460 for my $file (qw(doop.c mg.c mpeix/mpeixish.h plan9/plan9ish.h unixish.h util.c)) { 4461 next 4462 unless -f $file; 4463 edit_file($file, sub { 4464 my $code = shift; 4465 $code =~ s{ 4466 \n 4467 \#if \s+ [^\n]+ 4468 \n 4469 \# \s* include \s+ <signal\.h> 4470 \n 4471 \#endif 4472 \n 4473 } 4474 {\n#include <signal.h>\n}x; 4475 return $code; 4476 }); 4477 } 4478 } 4479 4480 if ($major == 15) { 4481 # This affects a small range of commits around July 2011, but build 4482 # failures here get in the way of bisecting other problems: 4483 4484 my $line = extract_from_file('embed.fnc', qr/^X?pR\t\|I32\t\|was_lvalue_sub$/); 4485 if ($line) { 4486 # Need to export Perl_was_lvalue_sub: 4487 apply_commit('7b70e8177801df4e') 4488 unless $line =~ /X/; 4489 4490 # It needs to be 'ApR' not 'XpR', to be visible to List::Util 4491 # (arm64 macOS treats the missing prototypes as errors) 4492 apply_commit('c73b0699db4d0b8b'); 4493 } 4494 } 4495} 4496 4497sub patch_ext { 4498 if (-f 'ext/POSIX/Makefile.PL' 4499 && extract_from_file('ext/POSIX/Makefile.PL', 4500 qr/Explicitly avoid including/)) { 4501 # commit 6695a346c41138df, which effectively reverts 170888cff5e2ffb7 4502 4503 # PERL5LIB is populated by make_ext.pl with paths to the modules we need 4504 # to run, don't override this with "../../lib" since that may not have 4505 # been populated yet in a parallel build. 4506 apply_commit('6695a346c41138df'); 4507 } 4508 4509 if (-f 'ext/Hash/Util/Makefile.PL' 4510 && extract_from_file('ext/Hash/Util/Makefile.PL', 4511 qr/\bDIR\b.*'FieldHash'/)) { 4512 # ext/Hash/Util/Makefile.PL should not recurse to FieldHash's Makefile.PL 4513 # *nix, VMS and Win32 all know how to (and have to) call the latter directly. 4514 # As is, targets in ext/Hash/Util/FieldHash get called twice, which may result 4515 # in race conditions, and certainly messes up make clean; make distclean; 4516 apply_commit('550428fe486b1888'); 4517 } 4518 4519 if ($major < 8 && $^O eq 'darwin' && !-f 'ext/DynaLoader/dl_dyld.xs') { 4520 checkout_file('ext/DynaLoader/dl_dyld.xs', 'f556e5b971932902'); 4521 apply_patch(<<'EOPATCH'); 4522diff -u a/ext/DynaLoader/dl_dyld.xs~ a/ext/DynaLoader/dl_dyld.xs 4523--- a/ext/DynaLoader/dl_dyld.xs 2011-10-11 21:41:27.000000000 +0100 4524+++ b/ext/DynaLoader/dl_dyld.xs 2011-10-11 21:42:20.000000000 +0100 4525@@ -41,6 +41,35 @@ 4526 #include "perl.h" 4527 #include "XSUB.h" 4528 4529+#ifndef pTHX 4530+# define pTHX void 4531+# define pTHX_ 4532+#endif 4533+#ifndef aTHX 4534+# define aTHX 4535+# define aTHX_ 4536+#endif 4537+#ifndef dTHX 4538+# define dTHXa(a) extern int Perl___notused(void) 4539+# define dTHX extern int Perl___notused(void) 4540+#endif 4541+ 4542+#ifndef Perl_form_nocontext 4543+# define Perl_form_nocontext form 4544+#endif 4545+ 4546+#ifndef Perl_warn_nocontext 4547+# define Perl_warn_nocontext warn 4548+#endif 4549+ 4550+#ifndef PTR2IV 4551+# define PTR2IV(p) (IV)(p) 4552+#endif 4553+ 4554+#ifndef get_av 4555+# define get_av perl_get_av 4556+#endif 4557+ 4558 #define DL_LOADONCEONLY 4559 4560 #include "dlutils.c" /* SaveError() etc */ 4561@@ -104,7 +145,7 @@ 4562 dl_last_error = savepv(error); 4563 } 4564 4565-static char *dlopen(char *path, int mode /* mode is ignored */) 4566+static char *dlopen(char *path) 4567 { 4568 int dyld_result; 4569 NSObjectFileImage ofile; 4570@@ -161,13 +202,11 @@ 4571 dl_load_file(filename, flags=0) 4572 char * filename 4573 int flags 4574- PREINIT: 4575- int mode = 1; 4576 CODE: 4577 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags)); 4578 if (flags & 0x01) 4579- Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename); 4580- RETVAL = dlopen(filename, mode) ; 4581+ Perl_warn_nocontext("Can't make loaded symbols global on this platform while loading %s",filename); 4582+ RETVAL = dlopen(filename); 4583 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", RETVAL)); 4584 ST(0) = sv_newmortal() ; 4585 if (RETVAL == NULL) 4586EOPATCH 4587 if ($major < 4 && !extract_from_file('util.c', qr/^form/m)) { 4588 apply_patch(<<'EOPATCH'); 4589diff -u a/ext/DynaLoader/dl_dyld.xs~ a/ext/DynaLoader/dl_dyld.xs 4590--- a/ext/DynaLoader/dl_dyld.xs 2011-10-11 21:56:25.000000000 +0100 4591+++ b/ext/DynaLoader/dl_dyld.xs 2011-10-11 22:00:00.000000000 +0100 4592@@ -60,6 +60,18 @@ 4593 # define get_av perl_get_av 4594 #endif 4595 4596+static char * 4597+form(char *pat, ...) 4598+{ 4599+ char *retval; 4600+ va_list args; 4601+ va_start(args, pat); 4602+ vasprintf(&retval, pat, &args); 4603+ va_end(args); 4604+ SAVEFREEPV(retval); 4605+ return retval; 4606+} 4607+ 4608 #define DL_LOADONCEONLY 4609 4610 #include "dlutils.c" /* SaveError() etc */ 4611EOPATCH 4612 } 4613 } 4614 4615 if ($major < 10) { 4616 if ($unfixable_db_file) { 4617 # Nothing we can do. 4618 } else { 4619 if (!extract_from_file('ext/DB_File/DB_File.xs', 4620 qr/^#ifdef AT_LEAST_DB_4_1$/)) { 4621 # This line is changed by commit 3245f0580c13b3ab 4622 my $line = extract_from_file('ext/DB_File/DB_File.xs', 4623 qr/^( status = \(?RETVAL->dbp->open\)?\(RETVAL->dbp, name, NULL, RETVAL->type, $)/); 4624 apply_patch(<<"EOPATCH"); 4625diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs 4626index 489ba96..fba8ded 100644 4627--- a/ext/DB_File/DB_File.xs 4628+++ b/ext/DB_File/DB_File.xs 4629\@\@ -183,4 +187,8 \@\@ 4630 #endif 4631 4632+#if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 1) 4633+# define AT_LEAST_DB_4_1 4634+#endif 4635+ 4636 /* map version 2 features & constants onto their version 1 equivalent */ 4637 4638\@\@ -1334,7 +1419,12 \@\@ SV * sv ; 4639 #endif 4640 4641+#ifdef AT_LEAST_DB_4_1 4642+ status = (RETVAL->dbp->open)(RETVAL->dbp, NULL, name, NULL, RETVAL->type, 4643+ Flags, mode) ; 4644+#else 4645 $line 4646 Flags, mode) ; 4647+#endif 4648 /* printf("open returned %d %s\\n", status, db_strerror(status)) ; */ 4649 4650EOPATCH 4651 } 4652 4653 if (!extract_from_file('ext/DB_File/DB_File.xs', 4654 qr/\bextern void __getBerkeleyDBInfo\b/)) { 4655 # A prototype for __getBerkeleyDBInfo(); 4656 apply_commit('b92372bcedd4cbc4'); 4657 } 4658 } 4659 } 4660 4661 if ($major < 10 and -f 'ext/IPC/SysV/SysV.xs') { 4662 edit_file('ext/IPC/SysV/SysV.xs', sub { 4663 my $xs = shift; 4664 my $fixed = <<'EOFIX'; 4665 4666#include <sys/types.h> 4667#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) 4668#ifndef HAS_SEM 4669# include <sys/ipc.h> 4670#endif 4671# ifdef HAS_MSG 4672# include <sys/msg.h> 4673# endif 4674# ifdef HAS_SHM 4675# if defined(PERL_SCO) || defined(PERL_ISC) 4676# include <sys/sysmacros.h> /* SHMLBA */ 4677# endif 4678# include <sys/shm.h> 4679# ifndef HAS_SHMAT_PROTOTYPE 4680 extern Shmat_t shmat (int, char *, int); 4681# endif 4682# if defined(HAS_SYSCONF) && defined(_SC_PAGESIZE) 4683# undef SHMLBA /* not static: determined at boot time */ 4684# define SHMLBA sysconf(_SC_PAGESIZE) 4685# elif defined(HAS_GETPAGESIZE) 4686# undef SHMLBA /* not static: determined at boot time */ 4687# define SHMLBA getpagesize() 4688# endif 4689# endif 4690#endif 4691EOFIX 4692 $xs =~ s! 4693#include <sys/types\.h> 4694.* 4695(#ifdef newCONSTSUB|/\* Required)!$fixed$1!ms; 4696 return $xs; 4697 }); 4698 } 4699 4700 if ($major < 10 and -f 'ext/Digest/MD5/MD5.xs') { 4701 require Digest::MD5; 4702 my ($was, $now); 4703 # The edit to the XS is commit 9ee8e69ab2318ba3, but the testcase fixup 4704 # needs to work for several earlier commits. 4705 edit_file('ext/Digest/MD5/MD5.xs', sub { 4706 my $xs = shift; 4707 $was = Digest::MD5::md5_hex($xs); 4708 $xs =~ s{\Q#if PATCHLEVEL <= 4 && !defined(PL_dowarn)} 4709 {#if PERL_VERSION <= 4 && !defined(PL_dowarn)}; 4710 $now = Digest::MD5::md5_hex($xs); 4711 return $xs; 4712 }); 4713 4714 edit_file('ext/Digest/MD5/t/files.t', sub { 4715 my $testcase = shift; 4716 $testcase =~ s/$was/$now/g; 4717 return $testcase; 4718 }) 4719 if $was ne $now; 4720 } 4721 4722 if ($major >= 10 && $major < 20 4723 && !extract_from_file('ext/SDBM_File/Makefile.PL', qr/MY::subdir_x/)) { 4724 # Parallel make fix for SDBM_File 4725 # Technically this is needed for pre v5.10.0, but we don't attempt 4726 # parallel makes on earlier versions because it's unreliable due to 4727 # other bugs. 4728 # So far, only AIX make has come acropper on this bug. 4729 apply_commit('4d106cc5d8fd328d', 'ext/SDBM_File/Makefile.PL'); 4730 } 4731 4732 if (-f 'ext/Errno/Errno_pm.PL') { 4733 if ($major < 22 && !extract_from_file('ext/Errno/Errno_pm.PL', 4734 qr/RT#123784/)) { 4735 my $gcc_major = extract_from_file('config.sh', 4736 qr/^gccversion='([0-9]+)\./, 4737 0); 4738 if ($gcc_major >= 5) { 4739 # This is the fix of commit 816b056ffb99ae54, but implemented in 4740 # a way that should work back to the earliest versions of Errno: 4741 edit_file('ext/Errno/Errno_pm.PL', sub { 4742 my $code = shift; 4743 $code =~ s/( \$Config\{cppflags\})/$1 -P/g; 4744 return $code; 4745 }); 4746 } 4747 } 4748 if ($major < 8 && !extract_from_file('ext/Errno/Errno_pm.PL', 4749 qr/With the -dM option, gcc/)) { 4750 # This is the fix of commit 9ae2e8df64ee1443 re-ordered slightly so 4751 # that it should work back to the earliest versions of Errno: 4752 apply_patch(<<'EOPATCH'); 4753diff --git a/ext/Errno/Errno_pm.PL b/ext/Errno/Errno_pm.PL 4754index b669790314..c00d6c1a86 100644 4755--- a/ext/Errno/Errno_pm.PL 4756+++ b/ext/Errno/Errno_pm.PL 4757@@ -30,6 +30,12 @@ sub process_file { 4758 warn "Cannot open '$file'"; 4759 return; 4760 } 4761+ } elsif ($Config{gccversion} ne '') { 4762+ # With the -dM option, gcc outputs every #define it finds 4763+ unless(open(FH,"$Config{cc} -E -dM $file |")) { 4764+ warn "Cannot open '$file'"; 4765+ return; 4766+ } 4767 } else { 4768 unless(open(FH,"< $file")) { 4769 warn "Cannot open '$file'"; 4770@@ -45,8 +51,12 @@ sub process_file { 4771 4772 sub get_files { 4773 my %file = (); 4774- # VMS keeps its include files in system libraries (well, except for Gcc) 4775- if ($^O eq 'VMS') { 4776+ if ($^O eq 'linux') { 4777+ # Some Linuxes have weird errno.hs which generate 4778+ # no #file or #line directives 4779+ $file{'/usr/include/errno.h'} = 1; 4780+ } elsif ($^O eq 'VMS') { 4781+ # VMS keeps its include files in system libraries (well, except for Gcc) 4782 if ($Config{vms_cc_type} eq 'decc') { 4783 $file{'Sys$Library:DECC$RTLDEF.TLB'} = 1; 4784 } elsif ($Config{vms_cc_type} eq 'vaxc') { 4785EOPATCH 4786 } 4787 } 4788} 4789 4790sub patch_t { 4791 if ($^O eq 'darwin') { 4792 # This has # $x = `$^X -le "print 'hi there'"`; 4793 # and it needs to pass for the automated validation self-test: 4794 edit_file('t/base/term.t', sub { 4795 my $code = shift; 4796 $code =~ s/`(\$\^X )/`$aggressive_apple_security$1/; 4797 return $code; 4798 }); 4799 } 4800} 4801 4802sub apply_fixups { 4803 my $fixups = shift; 4804 return unless $fixups; 4805 foreach my $file (@$fixups) { 4806 my $fh = open_or_die($file); 4807 my $line = <$fh>; 4808 close_or_die($fh); 4809 if ($line =~ /^#!perl\b/) { 4810 system $^X, $file 4811 and die_255("$^X $file failed: \$!=$!, \$?=$?"); 4812 } elsif ($line =~ /^#!(\/\S+)/) { 4813 system $file 4814 and die_255("$file failed: \$!=$!, \$?=$?"); 4815 } else { 4816 if (my ($target, $action, $pattern) 4817 = $line =~ m#^(\S+) ([=!])~ /(.*)/#) { 4818 if (length $pattern) { 4819 next unless -f $target; 4820 if ($action eq '=') { 4821 next unless extract_from_file($target, $pattern); 4822 } else { 4823 next if extract_from_file($target, $pattern); 4824 } 4825 } else { 4826 # Avoid the special case meaning of the empty pattern, 4827 # and instead use this to simply test for the file being 4828 # present or absent 4829 if ($action eq '=') { 4830 next unless -f $target; 4831 } else { 4832 next if -f $target; 4833 } 4834 } 4835 } 4836 system_or_die("patch -p1 <$file"); 4837 } 4838 } 4839} 4840 4841# ex: set ts=8 sts=4 sw=4 et: 4842