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 perl stop segfaulting on certain code? 1106 1107=over 4 1108 1109=item * Problem 1110 1111It was reported that perl was segfaulting on this code in perl-5.36.0: 1112 1113 @a = sort{eval"("}1,2 1114 1115Bisection subsequently identified the commit at which the segfaulting first 1116appeared. But when we ran that code against what was then the HEAD of blead 1117(L<Commit 70d911|https://github.com/Perl/perl5/commit/70d911984f>), we got no 1118segfault. So the next question we faced was: At what commit did the 1119segfaulting cease? 1120 1121=item * Solution 1122 1123Because the code in question loaded no libraries, it was amenable to bisection 1124with C<miniperl>, thereby shortening bisection time considerably. 1125 1126 perl Porting/bisect.pl \ 1127 --start=v5.36.0 \ 1128 --target=miniperl \ 1129 --expect-fail -e '@a = sort{eval"("}1,2' 1130 1131=item * Reference 1132 1133L<GH issue 20261|https://github.com/Perl/perl5/issues/20261> 1134 1135=back 1136 1137=head2 When did perl stop emitting warnings when running on certain code? 1138 1139=over 4 1140 1141=item * Background 1142 1143Most of the time, we bisect in order to identify the first "bad" commit: the 1144first time code failed to compile; the first time the code emitted warnings; 1145and so forth. 1146 1147Some times, however, we want to identify the first "good" commit: the point 1148where the code began to compile; the point where the code no longer emitted 1149warnings; etc. 1150 1151We can use this program for that purpose, but we have to reverse our sense of 1152"good" and "bad" commits. We use the C<--expect-fail> option to do that 1153reversal. 1154 1155=item * Problem 1156 1157It was reported that in an older version of Perl, a warning was being emitted 1158when a program was using the F<bigrat> module and 1159C<Scalar::Util::looks_like_number()> was called passing a non-integral number 1160(I<i.e.,> a rational). 1161 1162 $ perl -wE 'use Scalar::Util; use bigrat; 1163 say "mercy" if Scalar::Util::looks_like_number(1/9);' 1164 1165In perl-5.32, this emitted: 1166 1167 $ Argument "1/9" isn't numeric in addition (+) at 1168 /usr/local/lib/perl5/5.32/Math/BigRat.pm line 1955. 1169 mercy 1170 1171But it was observed that there was no warning in perl-5.36. 1172 1173=item * Solution 1174 1175 $ perl Porting/bisect.pl \ 1176 --start=5624cfff8f \ 1177 --end=b80b9f7fc6 \ 1178 --expect-fail \ 1179 -we 'use Scalar::Util; use bigrat; my @w; 1180 local $SIG{__WARN__} = sub { die }; 1181 print "mercy\n" if Scalar::Util::looks_like_number(1/9)' 1182 1183=item * Reference 1184 1185L<GH issue 20685|https://github.com/Perl/perl5/issues/20685> 1186 1187=back 1188 1189=cut 1190 1191# Ensure we always exit with 255, to cause git bisect to abort. 1192sub croak_255 { 1193 my $message = join '', @_; 1194 if ($message =~ /\n\z/) { 1195 print STDERR $message; 1196 } else { 1197 my (undef, $file, $line) = caller 1; 1198 print STDERR "@_ at $file line $line\n"; 1199 } 1200 exit 255; 1201} 1202 1203sub die_255 { 1204 croak_255(@_); 1205} 1206 1207die_255("$0: Can't build $target") 1208 if defined $target && !grep {@targets} $target; 1209 1210foreach my $phase (qw(early late)) { 1211 next unless $options{"$phase-fixup"}; 1212 my $bail_out; 1213 require File::Glob; 1214 my @expanded; 1215 foreach my $glob (@{$options{"$phase-fixup"}}) { 1216 my @got = File::Glob::bsd_glob($glob); 1217 push @expanded, @got ? @got : $glob; 1218 } 1219 @expanded = sort @expanded; 1220 $options{"$phase-fixup"} = \@expanded; 1221 foreach (@expanded) { 1222 unless (-f $_) { 1223 print STDERR "$phase-fixup '$_' is not a readable file\n"; 1224 ++$bail_out; 1225 } 1226 } 1227 exit 255 if $bail_out; 1228} 1229 1230unless (exists $defines{cc}) { 1231 # If it fails, the heuristic of 63f9ec3008baf7d6 is noisy, and hence 1232 # confusing. 1233 # FIXME - really it should be replaced with a proper test of 1234 # "can we build something?" and a helpful diagnostic if we can't. 1235 # For now, simply move it here. 1236 $defines{cc} = (`ccache -V`, $?) ? 'cc' : 'ccache cc'; 1237} 1238 1239my $j = $options{jobs} ? "-j$options{jobs}" : ''; 1240 1241if (exists $options{make}) { 1242 if (!exists $defines{make}) { 1243 $defines{make} = $options{make}; 1244 } 1245} else { 1246 $options{make} = 'make'; 1247} 1248 1249# Sadly, however hard we try, I don't think that it will be possible to build 1250# modules in ext/ on x86_64 Linux before commit e1666bf5602ae794 on 1999/12/29, 1251# which updated to MakeMaker 3.7, which changed from using a hard coded ld 1252# in the Makefile to $(LD). On x86_64 Linux the "linker" is gcc. 1253 1254sub open_or_die { 1255 my $file = shift; 1256 my $mode = @_ ? shift : '<'; 1257 open my $fh, $mode, $file or croak_255("Can't open $file: $!"); 1258 ${*$fh{SCALAR}} = $file; 1259 return $fh; 1260} 1261 1262sub close_or_die { 1263 my $fh = shift; 1264 return if close $fh; 1265 croak_255("Can't close: $!") unless ref $fh eq 'GLOB'; 1266 croak_255("Can't close ${*$fh{SCALAR}}: $!"); 1267} 1268 1269sub system_or_die { 1270 my $command = '</dev/null ' . shift; 1271 system($command) and croak_255("'$command' failed, \$!=$!, \$?=$?"); 1272} 1273 1274sub run_with_options { 1275 my $options = shift; 1276 my $name = $options->{name}; 1277 $name = "@_" unless defined $name; 1278 1279 my $setgrp = $options->{setpgrp}; 1280 if ($options->{timeout}) { 1281 # Unless you explicitly disabled it on the commandline, set it: 1282 $setgrp = 1 unless defined $setgrp; 1283 } 1284 my $pid = fork; 1285 die_255("Can't fork: $!") unless defined $pid; 1286 if (!$pid) { 1287 if (exists $options->{stdin}) { 1288 open STDIN, '<', $options->{stdin} 1289 or die "Can't open STDIN from $options->{stdin}: $!"; 1290 } 1291 if ($setgrp) { 1292 setpgrp 0, 0 1293 or die "Can't setpgrp 0, 0: $!"; 1294 } 1295 { exec @_ }; 1296 die_255("Failed to start $name: $!"); 1297 } 1298 my $start; 1299 if ($options->{timeout}) { 1300 require Errno; 1301 require POSIX; 1302 die_255("No POSIX::WNOHANG") 1303 unless &POSIX::WNOHANG; 1304 $start = time; 1305 $SIG{ALRM} = sub { 1306 my $victim = $setgrp ? -$pid : $pid; 1307 my $delay = 1; 1308 kill 'TERM', $victim; 1309 waitpid(-1, &POSIX::WNOHANG); 1310 while (kill 0, $victim) { 1311 sleep $delay; 1312 waitpid(-1, &POSIX::WNOHANG); 1313 $delay *= 2; 1314 if ($delay > 8) { 1315 if (kill 'KILL', $victim) { 1316 print STDERR "$0: Had to kill 'KILL', $victim\n" 1317 } elsif (! $!{ESRCH}) { 1318 print STDERR "$0: kill 'KILL', $victim failed: $!\n"; 1319 } 1320 last; 1321 } 1322 } 1323 report_and_exit(0, 'No timeout', 'Timeout', "when running $name"); 1324 }; 1325 alarm $options->{timeout}; 1326 } 1327 waitpid $pid, 0 1328 or die_255("wait for $name, pid $pid failed: $!"); 1329 alarm 0; 1330 if ($options->{timeout}) { 1331 my $elapsed = time - $start; 1332 if ($elapsed / $options->{timeout} > 0.8) { 1333 print STDERR "$0: Beware, took $elapsed seconds of $options->{timeout} permitted to run $name\n"; 1334 } 1335 } 1336 return $?; 1337} 1338 1339sub extract_from_file { 1340 my ($file, $rx, $default) = @_; 1341 my $fh = open_or_die($file); 1342 while (<$fh>) { 1343 my @got = $_ =~ $rx; 1344 return wantarray ? @got : $got[0] 1345 if @got; 1346 } 1347 return $default if defined $default; 1348 return; 1349} 1350 1351sub edit_file { 1352 my ($file, $munger) = @_; 1353 my $fh = open_or_die($file); 1354 my $orig = do { 1355 local $/; 1356 <$fh>; 1357 }; 1358 die_255("Can't read $file: $!") unless defined $orig && close $fh; 1359 my $new = $munger->($orig); 1360 return if $new eq $orig; 1361 $fh = open_or_die($file, '>'); 1362 print $fh $new or die_255("Can't print to $file: $!"); 1363 close_or_die($fh); 1364} 1365 1366# AIX supplies a pre-historic patch program, which certainly predates Linux 1367# and is probably older than NT. It can't cope with unified diffs. Meanwhile, 1368# it's hard enough to get git diff to output context diffs, let alone git show, 1369# and nearly all the patches embedded here are unified. So it seems that the 1370# path of least resistance is to convert unified diffs to context diffs: 1371 1372sub process_hunk { 1373 my ($from_out, $to_out, $has_from, $has_to, $delete, $add) = @_; 1374 ++$$has_from if $delete; 1375 ++$$has_to if $add; 1376 1377 if ($delete && $add) { 1378 $$from_out .= "! $_\n" foreach @$delete; 1379 $$to_out .= "! $_\n" foreach @$add; 1380 } elsif ($delete) { 1381 $$from_out .= "- $_\n" foreach @$delete; 1382 } elsif ($add) { 1383 $$to_out .= "+ $_\n" foreach @$add; 1384 } 1385} 1386 1387# This isn't quite general purpose, as it can't cope with 1388# '\ No newline at end of file' 1389sub ud2cd { 1390 my $diff_in = shift; 1391 my $diff_out = ''; 1392 1393 # Stuff before the diff 1394 while ($diff_in =~ s/\A(?!\*\*\* )(?!--- )([^\n]*\n?)//ms && length $1) { 1395 $diff_out .= $1; 1396 } 1397 1398 if (!length $diff_in) { 1399 die_255("That didn't seem to be a diff"); 1400 } 1401 1402 if ($diff_in =~ /\A\*\*\* /ms) { 1403 warn "Seems to be a context diff already\n"; 1404 return $diff_out . $diff_in; 1405 } 1406 1407 # Loop for files 1408 FILE: while (1) { 1409 if ($diff_in =~ s/\A((?:diff |index )[^\n]+\n)//ms) { 1410 $diff_out .= $1; 1411 next; 1412 } 1413 if ($diff_in !~ /\A--- /ms) { 1414 # Stuff after the diff; 1415 return $diff_out . $diff_in; 1416 } 1417 $diff_in =~ s/\A([^\n]+\n?)//ms; 1418 my $line = $1; 1419 die_255("Can't parse '$line'") unless $line =~ s/\A--- /*** /ms; 1420 $diff_out .= $line; 1421 $diff_in =~ s/\A([^\n]+\n?)//ms; 1422 $line = $1; 1423 die_255("Can't parse '$line'") unless $line =~ s/\A\+\+\+ /--- /ms; 1424 $diff_out .= $line; 1425 1426 # Loop for hunks 1427 while (1) { 1428 next FILE 1429 unless $diff_in =~ s/\A\@\@ (-([0-9]+),([0-9]+) \+([0-9]+),([0-9]+)) \@\@[^\n]*\n?//; 1430 my ($hunk, $from_start, $from_count, $to_start, $to_count) 1431 = ($1, $2, $3, $4, $5); 1432 my $from_end = $from_start + $from_count - 1; 1433 my $to_end = $to_start + $to_count - 1; 1434 my ($from_out, $to_out, $has_from, $has_to, $add, $delete); 1435 while (length $diff_in && ($from_count || $to_count)) { 1436 die_255("Confused in $hunk") 1437 unless $diff_in =~ s/\A([^\n]*)\n//ms; 1438 my $line = $1; 1439 $line = ' ' unless length $line; 1440 if ($line =~ /^ .*/) { 1441 process_hunk(\$from_out, \$to_out, \$has_from, \$has_to, 1442 $delete, $add); 1443 undef $delete; 1444 undef $add; 1445 $from_out .= " $line\n"; 1446 $to_out .= " $line\n"; 1447 --$from_count; 1448 --$to_count; 1449 } elsif ($line =~ /^-(.*)/) { 1450 push @$delete, $1; 1451 --$from_count; 1452 } elsif ($line =~ /^\+(.*)/) { 1453 push @$add, $1; 1454 --$to_count; 1455 } else { 1456 die_255("Can't parse '$line' as part of hunk $hunk"); 1457 } 1458 } 1459 process_hunk(\$from_out, \$to_out, \$has_from, \$has_to, 1460 $delete, $add); 1461 die_255("No lines in hunk $hunk") 1462 unless length $from_out || length $to_out; 1463 die_255("No changes in hunk $hunk") 1464 unless $has_from || $has_to; 1465 $diff_out .= "***************\n"; 1466 $diff_out .= "*** $from_start,$from_end ****\n"; 1467 $diff_out .= $from_out if $has_from; 1468 $diff_out .= "--- $to_start,$to_end ----\n"; 1469 $diff_out .= $to_out if $has_to; 1470 } 1471 } 1472} 1473 1474{ 1475 my $use_context; 1476 1477 sub placate_patch_prog { 1478 my $patch = shift; 1479 1480 if (!defined $use_context) { 1481 my $version = `patch -v 2>&1`; 1482 die_255("Can't run `patch -v`, \$?=$?, bailing out") 1483 unless defined $version; 1484 if ($version =~ /Free Software Foundation/) { 1485 $use_context = 0; 1486 } elsif ($version =~ /Header: patch\.c,v.*\blwall\b/) { 1487 # The system patch is older than Linux, and probably older than 1488 # Windows NT. 1489 $use_context = 1; 1490 } elsif ($version =~ /Header: patch\.c,v.*\babhinav\b/) { 1491 # Thank you HP. No, we have no idea *which* version this is: 1492 # $Header: patch.c,v 76.1.1.2.1.3 2001/12/03 12:24:52 abhinav Exp $ 1493 $use_context = 1; 1494 } else { 1495 # Don't know. 1496 $use_context = 0; 1497 } 1498 } 1499 1500 return $use_context ? ud2cd($patch) : $patch; 1501 } 1502} 1503 1504sub apply_patch { 1505 my ($patch, $what, $files) = @_; 1506 $what = 'patch' unless defined $what; 1507 unless (defined $files) { 1508 # Handle context diffs (*** ---) and unified diffs (+++ ---) 1509 # and ignore trailing "garbage" after the filenames 1510 $patch =~ m!^[-*]{3} [ab]/(\S+)[^\n]*\n[-+]{3} [ba]/\1!sm; 1511 $files = " $1"; 1512 } 1513 my $patch_to_use = placate_patch_prog($patch); 1514 open my $fh, '|-', 'patch', '-p1' or die_255("Can't run patch: $!"); 1515 print $fh $patch_to_use; 1516 return if close $fh; 1517 print STDERR "Patch is <<'EOPATCH'\n${patch}EOPATCH\n"; 1518 print STDERR "\nConverted to a context diff <<'EOCONTEXT'\n${patch_to_use}EOCONTEXT\n" 1519 if $patch_to_use ne $patch; 1520 die_255("Can't $what$files: $?, $!"); 1521} 1522 1523sub apply_commit { 1524 my ($commit, @files) = @_; 1525 my $patch = `git show $commit @files`; 1526 if (!defined $patch) { 1527 die_255("Can't get commit $commit for @files: $?") if @files; 1528 die_255("Can't get commit $commit: $?"); 1529 } 1530 apply_patch($patch, "patch $commit", @files ? " for @files" : ''); 1531} 1532 1533sub revert_commit { 1534 my ($commit, @files) = @_; 1535 my $patch = `git show -R $commit @files`; 1536 if (!defined $patch) { 1537 die_255("Can't get revert commit $commit for @files: $?") if @files; 1538 die_255("Can't get revert commit $commit: $?"); 1539 } 1540 apply_patch($patch, "revert $commit", @files ? " for @files" : ''); 1541} 1542 1543sub checkout_file { 1544 my ($file, $commit) = @_; 1545 $commit ||= $options{gold} || 'blead'; 1546 system "git show $commit:$file > $file </dev/null" 1547 and die_255("Could not extract $file at revision $commit"); 1548} 1549 1550sub check_shebang { 1551 my $file = shift; 1552 return unless -e $file; 1553 my $fh = open_or_die($file); 1554 my $line = <$fh>; 1555 return if $line =~ $run_with_our_perl; 1556 if (!-x $file) { 1557 die_255("$file is not executable. 1558system($file, ...) is always going to fail. 1559 1560Bailing out"); 1561 } 1562 return unless $line =~ m{\A#!(/\S+/perl\S*)\s}; 1563 die_255("$file will always be run by $1 1564It won't be tested by the ./perl we build. 1565If you intended to run it with that perl binary, please change your 1566test case to 1567 1568 $1 @ARGV 1569 1570If you intended to test it with the ./perl we build, please change your 1571test case to 1572 1573 ./perl -Ilib @ARGV 1574 1575[You may also need to add -- before ./perl to prevent that -Ilib as being 1576parsed as an argument to bisect.pl] 1577 1578Bailing out"); 1579} 1580 1581sub clean { 1582 if ($options{clean}) { 1583 # Needed, because files that are build products in this checked out 1584 # version might be in git in the next desired version. 1585 system 'git clean -qdxf </dev/null'; 1586 # Needed, because at some revisions the build alters checked out files. 1587 # (eg pod/perlapi.pod). Also undoes any changes to makedepend.SH 1588 system 'git reset --hard HEAD </dev/null'; 1589 } 1590} 1591 1592sub skip { 1593 my $reason = shift; 1594 clean(); 1595 warn "skipping - $reason"; 1596 exit 125; 1597} 1598 1599sub report_and_exit { 1600 my ($good, $pass, $fail, $desc) = @_; 1601 1602 clean(); 1603 1604 my $got = ($options{'expect-pass'} ? $good : !$good) ? 'good' : 'bad'; 1605 if ($good) { 1606 print "$got - $pass $desc\n"; 1607 } else { 1608 print "$got - $fail $desc\n"; 1609 } 1610 1611 exit($got eq 'bad'); 1612} 1613 1614sub run_report_and_exit { 1615 my $ret = run_with_options({setprgp => $options{setpgrp}, 1616 timeout => $options{timeout}, 1617 }, @_); 1618 $ret &= 0xff if $options{crash}; 1619 report_and_exit(!$ret, 'zero exit from', 'non-zero exit from', "@_"); 1620} 1621 1622sub match_and_exit { 1623 my ($target, @globs) = @_; 1624 my $matches = 0; 1625 my $re = qr/$match/; 1626 my @files; 1627 1628 if (@globs) { 1629 require File::Glob; 1630 foreach (sort map { File::Glob::bsd_glob($_)} @globs) { 1631 if (!-f $_ || !-r _) { 1632 warn "Skipping matching '$_' as it is not a readable file\n"; 1633 } else { 1634 push @files, $_; 1635 } 1636 } 1637 } else { 1638 local $/ = "\0"; 1639 @files = defined $target ? `git ls-files -o -z`: `git ls-files -z`; 1640 chomp @files; 1641 } 1642 1643 foreach my $file (@files) { 1644 my $fh = open_or_die($file); 1645 while (<$fh>) { 1646 if ($_ =~ $re) { 1647 ++$matches; 1648 if (/[^[:^cntrl:]\h\v]/) { # Matches non-spacing non-C1 controls 1649 print "Binary file $file matches\n"; 1650 } else { 1651 $_ .= "\n" unless /\n\z/; 1652 print "$file: $_"; 1653 } 1654 } 1655 } 1656 close_or_die($fh); 1657 } 1658 report_and_exit($matches, 1659 $matches == 1 ? '1 match for' : "$matches matches for", 1660 'no matches for', $match); 1661} 1662 1663# Not going to assume that system perl is yet new enough to have autodie 1664system_or_die('git clean -dxf'); 1665 1666if (!defined $target) { 1667 match_and_exit(undef, @ARGV) if $match; 1668 $target = 'test_prep'; 1669} elsif ($target eq 'none') { 1670 match_and_exit(undef, @ARGV) if $match; 1671 run_report_and_exit(@ARGV); 1672} 1673 1674skip('no Configure - is this the //depot/perlext/Compiler branch?') 1675 unless -f 'Configure'; 1676 1677my $case_insensitive; 1678{ 1679 my ($dev_C, $ino_C) = stat 'Configure'; 1680 die_255("Could not stat Configure: $!") unless defined $dev_C; 1681 my ($dev_c, $ino_c) = stat 'configure'; 1682 ++$case_insensitive 1683 if defined $dev_c && $dev_C == $dev_c && $ino_C == $ino_c; 1684} 1685 1686# This changes to PERL_VERSION in 4d8076ea25903dcb in 1999 1687my $major 1688 = extract_from_file('patchlevel.h', 1689 qr/^#define\s+(?:PERL_VERSION|PATCHLEVEL)\s+(\d+)\s/, 1690 0); 1691 1692my $unfixable_db_file; 1693 1694if ($major < 10 1695 && !extract_from_file('ext/DB_File/DB_File.xs', 1696 qr!^#else /\* Berkeley DB Version > 2 \*/$!)) { 1697 # This DB_File.xs is really too old to patch up. 1698 # Skip DB_File, unless we're invoked with an explicit -Unoextensions 1699 if (!exists $defines{noextensions}) { 1700 $defines{noextensions} = 'DB_File'; 1701 } elsif (defined $defines{noextensions}) { 1702 $defines{noextensions} .= ' DB_File'; 1703 } 1704 ++$unfixable_db_file; 1705} 1706 1707patch_Configure(); 1708patch_hints(); 1709if ($options{'all-fixups'}) { 1710 patch_SH(); 1711 patch_C(); 1712 patch_ext(); 1713 patch_t(); 1714} 1715apply_fixups($options{'early-fixup'}); 1716 1717# if Encode is not needed for the test, you can speed up the bisect by 1718# excluding it from the runs with -Dnoextensions=Encode 1719# ccache is an easy win. Remove it if it causes problems. 1720# Commit 1cfa4ec74d4933da adds ignore_versioned_solibs to Configure, and sets it 1721# to true in hints/linux.sh 1722# On dromedary, from that point on, Configure (by default) fails to find any 1723# libraries, because it scans /usr/local/lib /lib /usr/lib, which only contain 1724# versioned libraries. Without -lm, the build fails. 1725# Telling /usr/local/lib64 /lib64 /usr/lib64 works from that commit onwards, 1726# until commit faae14e6e968e1c0 adds it to the hints. 1727# However, prior to 1cfa4ec74d4933da telling Configure the truth doesn't work, 1728# because it will spot versioned libraries, pass them to the compiler, and then 1729# bail out pretty early on. Configure won't let us override libswanted, but it 1730# will let us override the entire libs list. 1731 1732foreach (@{$options{A}}) { 1733 push @paths, $1 if /^libpth=(.*)/s; 1734} 1735 1736unless (extract_from_file('Configure', 'ignore_versioned_solibs')) { 1737 # Before 1cfa4ec74d4933da, so force the libs list. 1738 1739 my @libs; 1740 # This is the current libswanted list from Configure, less the libs removed 1741 # by current hints/linux.sh 1742 foreach my $lib (qw(sfio socket inet nsl nm ndbm gdbm dbm db malloc dl 1743 ld sun m crypt sec util c cposix posix ucb BSD)) { 1744 foreach my $dir (@paths) { 1745 # Note the wonderful consistency of dot-or-not in the config vars: 1746 next unless -f "$dir/lib$lib.$Config{dlext}" 1747 || -f "$dir/lib$lib$Config{lib_ext}"; 1748 push @libs, "-l$lib"; 1749 last; 1750 } 1751 } 1752 $defines{libs} = \@libs unless exists $defines{libs}; 1753} 1754 1755# a4f3eea9be6bcf3c added a test for GNU libc to Configure 1756# Prior to that we really don't get much choice but to force usenm off 1757# everywhere (and modern systems are fast enough that this doesn't matter) 1758$defines{usenm} = undef 1759 if $major < 4 && !exists $defines{usenm}; 1760 1761my ($missing, $created_dirs); 1762($missing, $created_dirs) = force_manifest() 1763 if $options{'force-manifest'}; 1764 1765my @ARGS = '-dEs'; 1766foreach my $key (sort keys %defines) { 1767 my $val = $defines{$key}; 1768 if (ref $val) { 1769 push @ARGS, "-D$key=@$val"; 1770 } elsif (!defined $val) { 1771 push @ARGS, "-U$key"; 1772 } elsif (!length $val) { 1773 push @ARGS, "-D$key"; 1774 } else { 1775 $val = "" if $val eq "\0"; 1776 push @ARGS, "-D$key=$val"; 1777 } 1778} 1779push @ARGS, map {"-A$_"} @{$options{A}}; 1780 1781my $prefix; 1782 1783# Testing a module? We need to install perl/cpan modules to a temp dir 1784if ($options{module} || $options{'with-module'} || $options{'test-module'}) 1785{ 1786 $prefix = tempdir(CLEANUP => 1); 1787 1788 push @ARGS, "-Dprefix=$prefix"; 1789 push @ARGS, "-Uversiononly", "-Dinstallusrbinperl=n"; 1790} 1791 1792# If a file in MANIFEST is missing, Configure asks if you want to 1793# continue (the default being 'n'). With stdin closed or /dev/null, 1794# it exits immediately and the check for config.sh below will skip. 1795# Without redirecting stdin, the commands called will attempt to read from 1796# stdin (and thus effectively hang) 1797run_with_options({stdin => '/dev/null', name => 'Configure'}, 1798 './Configure', @ARGS); 1799 1800patch_SH() unless $options{'all-fixups'}; 1801apply_fixups($options{'late-fixup'}); 1802 1803if (-f 'config.sh') { 1804 # Emulate noextensions if Configure doesn't support it. 1805 fake_noextensions() 1806 if $major < 10 && $defines{noextensions}; 1807 if (system './Configure -S') { 1808 # See commit v5.23.5-89-g7a4fcb3. Configure may try to run 1809 # ./optdef.sh instead of UU/optdef.sh. Copying the file is 1810 # easier than patching Configure (which mentions optdef.sh multi- 1811 # ple times). 1812 require File::Copy; 1813 File::Copy::copy("UU/optdef.sh", "./optdef.sh"); 1814 system_or_die('./Configure -S'); 1815 } 1816} 1817 1818if ($target =~ /config\.s?h/) { 1819 match_and_exit($target, @ARGV) if $match && -f $target; 1820 report_and_exit(-f $target, 'could build', 'could not build', $target) 1821 if $options{'test-build'}; 1822 1823 skip("could not build $target") unless -f $target; 1824 1825 run_report_and_exit(@ARGV); 1826} elsif (!-f 'config.sh') { 1827 report_and_exit(undef, 'PLEASE REPORT BUG', 'could not build', 'config.sh') 1828 if $options{'test-build'}; 1829 1830 # Skip if something went wrong with Configure 1831 skip('could not build config.sh'); 1832} 1833 1834force_manifest_cleanup($missing, $created_dirs) 1835 if $missing; 1836 1837if($options{'force-regen'} 1838 && extract_from_file('Makefile', qr/\bregen_headers\b/)) { 1839 # regen_headers was added in e50aee73b3d4c555, patch.1m for perl5.001 1840 # It's not worth faking it for earlier revisions. 1841 system_or_die('make regen_headers'); 1842} 1843 1844unless ($options{'all-fixups'}) { 1845 patch_C(); 1846 patch_ext(); 1847 patch_t(); 1848} 1849 1850# Parallel build for miniperl is safe 1851system "$options{make} $j miniperl </dev/null"; 1852 1853# This is the file we expect make to create 1854my $expected_file = $target =~ /^test/ ? 't/perl' 1855 : $target eq 'Fcntl' ? "lib/auto/Fcntl/Fcntl.$Config{so}" 1856 : $target; 1857# This is the target we tell make to build in order to get $expected_file 1858my $real_target = $target eq 'Fcntl' ? $expected_file : $target; 1859 1860if ($target ne 'miniperl') { 1861 # Nearly all parallel build issues fixed by 5.10.0. Untrustworthy before that. 1862 $j = '' if $major < 10; 1863 1864 if ($real_target eq 'test_prep') { 1865 if ($major < 8) { 1866 # test-prep was added in 5.004_01, 3e3baf6d63945cb6. 1867 # renamed to test_prep in 2001 in 5fe84fd29acaf55c. 1868 # earlier than that, just make test. It will be fast enough. 1869 $real_target = extract_from_file('Makefile.SH', 1870 qr/^(test[-_]prep):/, 1871 'test'); 1872 } 1873 } 1874 1875 system "$options{make} $j $real_target </dev/null"; 1876} 1877 1878my $expected_file_found = $expected_file =~ /perl$/ 1879 ? -x $expected_file : -r $expected_file; 1880 1881if ($expected_file_found && $expected_file eq 't/perl') { 1882 # Check that it isn't actually pointing to ../miniperl, which will happen 1883 # if the sanity check ./miniperl -Ilib -MExporter -e '<?>' fails, and 1884 # Makefile tries to run minitest. 1885 1886 # Of course, helpfully sometimes it's called ../perl, other times .././perl 1887 # and who knows if that list is exhaustive... 1888 my ($dev0, $ino0) = stat 't/perl'; 1889 my ($dev1, $ino1) = stat 'perl'; 1890 unless (defined $dev0 && defined $dev1 && $dev0 == $dev1 && $ino0 == $ino1) { 1891 undef $expected_file_found; 1892 my $link = readlink $expected_file; 1893 warn "'t/perl' => '$link', not 'perl'"; 1894 die_255("Could not realink t/perl: $!") unless defined $link; 1895 } 1896} 1897 1898my $just_testing = 0; 1899 1900if ($options{'test-build'}) { 1901 report_and_exit($expected_file_found, 'could build', 'could not build', 1902 $real_target); 1903} elsif (!$expected_file_found) { 1904 skip("could not build $real_target"); 1905} elsif (my $mod_opt = $options{module} || $options{'with-module'} 1906 || ($just_testing++, $options{'test-module'})) { 1907 # Testing a cpan module? See if it will install 1908 # First we need to install this perl somewhere 1909 system_or_die('./installperl'); 1910 1911 my @m = split(',', $mod_opt); 1912 1913 my $bdir = File::Temp::tempdir( 1914 CLEANUP => 1, 1915 ) or die $!; 1916 1917 # Don't ever stop to ask the user for input 1918 $ENV{AUTOMATED_TESTING} = 1; 1919 $ENV{PERL_MM_USE_DEFAULT} = 1; 1920 1921 # Don't let these interfere with our cpan installs 1922 delete $ENV{PERL_MB_OPT}; 1923 delete $ENV{PERL_MM_OPT}; 1924 1925 # Make sure we load up our CPAN::MyConfig and then 1926 # override the build_dir so we have a fresh one 1927 # every build 1928 my $cdir = $options{'cpan-config-dir'} 1929 || File::Spec->catfile($ENV{HOME},".cpan"); 1930 1931 my @cpanshell = ( 1932 "$prefix/bin/perl", 1933 "-I", "$cdir", 1934 "-MCPAN::MyConfig", 1935 "-MCPAN", 1936 "-e","\$CPAN::Config->{build_dir}=q{$bdir};", 1937 "-e", 1938 ); 1939 1940 for (@m) { 1941 s/-/::/g if /-/ and !m|/|; 1942 } 1943 my $install = join ",", map { "'$_'" } @m; 1944 if ($just_testing) { 1945 $install = "test($install)"; 1946 } elsif ($options{'no-module-tests'}) { 1947 $install = "notest('install',$install)"; 1948 } else { 1949 $install = "install($install)"; 1950 } 1951 my $last = $m[-1]; 1952 my $status_method = $just_testing ? 'test' : 'uptodate'; 1953 my $shellcmd = "$install; die unless CPAN::Shell->expand(Module => '$last')->$status_method;"; 1954 1955 if ($options{module} || $options{'test-module'}) { 1956 run_report_and_exit(@cpanshell, $shellcmd); 1957 } else { 1958 my $ret = run_with_options({setprgp => $options{setpgrp}, 1959 timeout => $options{timeout}, 1960 }, @cpanshell, $shellcmd); 1961 $ret &= 0xff if $options{crash}; 1962 1963 # Failed? Give up 1964 if ($ret) { 1965 report_and_exit(!$ret, 'zero exit from', 'non-zero exit from', "@_"); 1966 } 1967 } 1968} 1969 1970match_and_exit($real_target, @ARGV) if $match; 1971 1972if (defined $options{'one-liner'}) { 1973 my $exe = $target =~ /^(?:perl$|test)/ ? 'perl' : 'miniperl'; 1974 unshift @ARGV, map {('-e', $_)} @{$options{'one-liner'}}; 1975 foreach (qw(c l w)) { 1976 unshift @ARGV, "-$_" if $options{$_}; 1977 } 1978 unshift @ARGV, "./$exe", '-Ilib'; 1979} 1980 1981if (-f $ARGV[0]) { 1982 my $fh = open_or_die($ARGV[0]); 1983 my $line = <$fh>; 1984 unshift @ARGV, $1, '-Ilib' 1985 if $line =~ $run_with_our_perl; 1986} 1987 1988if ($options{valgrind}) { 1989 # Turns out to be too confusing to use an optional argument with the path 1990 # of the valgrind binary, as if --valgrind takes an optional argument, 1991 # then specifying it as the last option eats the first part of the testcase. 1992 # ie this: .../bisect.pl --valgrind testcase 1993 # is treated as --valgrind=testcase and as there is no test case given, 1994 # it's an invalid commandline, bailing out with the usage message. 1995 1996 # Currently, the test script can't signal a skip with 125, so anything 1997 # non-zero would do. But to keep that option open in future, use 124 1998 unshift @ARGV, 'valgrind', '--error-exitcode=124'; 1999} 2000 2001# This is what we came here to run: 2002 2003if (exists $Config{ldlibpthname}) { 2004 require Cwd; 2005 my $varname = $Config{ldlibpthname}; 2006 my $cwd = Cwd::getcwd(); 2007 if (defined $ENV{$varname}) { 2008 $ENV{$varname} = $cwd . $Config{path_sep} . $ENV{$varname}; 2009 } else { 2010 $ENV{$varname} = $cwd; 2011 } 2012} 2013 2014run_report_and_exit(@ARGV); 2015 2016############################################################################ 2017# 2018# Patching, editing and faking routines only below here. 2019# 2020############################################################################ 2021 2022sub fake_noextensions { 2023 edit_file('config.sh', sub { 2024 my @lines = split /\n/, shift; 2025 my @ext = split /\s+/, $defines{noextensions}; 2026 foreach (@lines) { 2027 next unless /^extensions=/ || /^dynamic_ext/; 2028 foreach my $ext (@ext) { 2029 s/\b$ext( )?\b/$1/; 2030 } 2031 } 2032 return join "\n", @lines; 2033 }); 2034} 2035 2036sub force_manifest { 2037 my (@missing, @created_dirs); 2038 my $fh = open_or_die('MANIFEST'); 2039 while (<$fh>) { 2040 next unless /^(\S+)/; 2041 # -d is special case needed (at least) between 27332437a2ed1941 and 2042 # bf3d9ec563d25054^ inclusive, as manifest contains ext/Thread/Thread 2043 push @missing, $1 2044 unless -f $1 || -d $1; 2045 } 2046 close_or_die($fh); 2047 2048 foreach my $pathname (@missing) { 2049 my @parts = split '/', $pathname; 2050 my $leaf = pop @parts; 2051 my $path = '.'; 2052 while (@parts) { 2053 $path .= '/' . shift @parts; 2054 next if -d $path; 2055 mkdir $path, 0700 or die_255("Can't create $path: $!"); 2056 unshift @created_dirs, $path; 2057 } 2058 $fh = open_or_die($pathname, '>'); 2059 close_or_die($fh); 2060 chmod 0, $pathname or die_255("Can't chmod 0 $pathname: $!"); 2061 } 2062 return \@missing, \@created_dirs; 2063} 2064 2065sub force_manifest_cleanup { 2066 my ($missing, $created_dirs) = @_; 2067 # This is probably way too paranoid: 2068 my @errors; 2069 require Fcntl; 2070 foreach my $file (@$missing) { 2071 my (undef, undef, $mode, undef, undef, undef, undef, $size) 2072 = stat $file; 2073 if (!defined $mode) { 2074 push @errors, "Added file $file has been deleted by Configure"; 2075 next; 2076 } 2077 if (Fcntl::S_IMODE($mode) != 0) { 2078 push @errors, 2079 sprintf 'Added file %s had mode changed by Configure to %03o', 2080 $file, $mode; 2081 } 2082 if ($size != 0) { 2083 push @errors, 2084 "Added file $file had sized changed by Configure to $size"; 2085 } 2086 unlink $file or die_255("Can't unlink $file: $!"); 2087 } 2088 foreach my $dir (@$created_dirs) { 2089 rmdir $dir or die_255("Can't rmdir $dir: $!"); 2090 } 2091 skip("@errors") 2092 if @errors; 2093} 2094 2095sub patch_Configure { 2096 if ($major < 1) { 2097 if (extract_from_file('Configure', 2098 qr/^\t\t\*=\*\) echo "\$1" >> \$optdef;;$/)) { 2099 # This is " Spaces now allowed in -D command line options.", 2100 # part of commit ecfc54246c2a6f42 2101 apply_patch(<<'EOPATCH'); 2102diff --git a/Configure b/Configure 2103index 3d3b38d..78ffe16 100755 2104--- a/Configure 2105+++ b/Configure 2106@@ -652,7 +777,8 @@ while test $# -gt 0; do 2107 echo "$me: use '-U symbol=', not '-D symbol='." >&2 2108 echo "$me: ignoring -D $1" >&2 2109 ;; 2110- *=*) echo "$1" >> $optdef;; 2111+ *=*) echo "$1" | \ 2112+ sed -e "s/'/'\"'\"'/g" -e "s/=\(.*\)/='\1'/" >> $optdef;; 2113 *) echo "$1='define'" >> $optdef;; 2114 esac 2115 shift 2116EOPATCH 2117 } 2118 2119 if (extract_from_file('Configure', qr/^if \$contains 'd_namlen' \$xinc\b/)) { 2120 # Configure's original simple "grep" for d_namlen falls foul of the 2121 # approach taken by the glibc headers: 2122 # #ifdef _DIRENT_HAVE_D_NAMLEN 2123 # # define _D_EXACT_NAMLEN(d) ((d)->d_namlen) 2124 # 2125 # where _DIRENT_HAVE_D_NAMLEN is not defined on Linux. 2126 # This is also part of commit ecfc54246c2a6f42 2127 apply_patch(<<'EOPATCH'); 2128diff --git a/Configure b/Configure 2129index 3d3b38d..78ffe16 100755 2130--- a/Configure 2131+++ b/Configure 2132@@ -3935,7 +4045,8 @@ $rm -f try.c 2133 2134 : see if the directory entry stores field length 2135 echo " " 2136-if $contains 'd_namlen' $xinc >/dev/null 2>&1; then 2137+$cppstdin $cppflags $cppminus < "$xinc" > try.c 2138+if $contains 'd_namlen' try.c >/dev/null 2>&1; then 2139 echo "Good, your directory entry keeps length information in d_namlen." >&4 2140 val="$define" 2141 else 2142EOPATCH 2143 } 2144 } 2145 2146 if ($major < 2 2147 && !extract_from_file('Configure', 2148 qr/Try to guess additional flags to pick up local libraries/)) { 2149 my $mips = extract_from_file('Configure', 2150 qr!(''\) if (?:\./)?mips; then)!); 2151 # This is part of perl-5.001n. It's needed, to add -L/usr/local/lib to 2152 # the ld flags if libraries are found there. It shifts the code to set 2153 # up libpth earlier, and then adds the code to add libpth entries to 2154 # ldflags 2155 # mips was changed to ./mips in ecfc54246c2a6f42, perl5.000 patch.0g 2156 apply_patch(sprintf <<'EOPATCH', $mips); 2157diff --git a/Configure b/Configure 2158index 53649d5..0635a6e 100755 2159--- a/Configure 2160+++ b/Configure 2161@@ -2749,6 +2749,52 @@ EOM 2162 ;; 2163 esac 2164 2165+: Set private lib path 2166+case "$plibpth" in 2167+'') if ./mips; then 2168+ plibpth="$incpath/usr/lib /usr/local/lib /usr/ccs/lib" 2169+ fi;; 2170+esac 2171+case "$libpth" in 2172+' ') dlist='';; 2173+'') dlist="$plibpth $glibpth";; 2174+*) dlist="$libpth";; 2175+esac 2176+ 2177+: Now check and see which directories actually exist, avoiding duplicates 2178+libpth='' 2179+for xxx in $dlist 2180+do 2181+ if $test -d $xxx; then 2182+ case " $libpth " in 2183+ *" $xxx "*) ;; 2184+ *) libpth="$libpth $xxx";; 2185+ esac 2186+ fi 2187+done 2188+$cat <<'EOM' 2189+ 2190+Some systems have incompatible or broken versions of libraries. Among 2191+the directories listed in the question below, please remove any you 2192+know not to be holding relevant libraries, and add any that are needed. 2193+Say "none" for none. 2194+ 2195+EOM 2196+case "$libpth" in 2197+'') dflt='none';; 2198+*) 2199+ set X $libpth 2200+ shift 2201+ dflt=${1+"$@"} 2202+ ;; 2203+esac 2204+rp="Directories to use for library searches?" 2205+. ./myread 2206+case "$ans" in 2207+none) libpth=' ';; 2208+*) libpth="$ans";; 2209+esac 2210+ 2211 : flags used in final linking phase 2212 case "$ldflags" in 2213 '') if ./venix; then 2214@@ -2765,6 +2811,23 @@ case "$ldflags" in 2215 ;; 2216 *) dflt="$ldflags";; 2217 esac 2218+ 2219+: Possible local library directories to search. 2220+loclibpth="/usr/local/lib /opt/local/lib /usr/gnu/lib" 2221+loclibpth="$loclibpth /opt/gnu/lib /usr/GNU/lib /opt/GNU/lib" 2222+ 2223+: Try to guess additional flags to pick up local libraries. 2224+for thislibdir in $libpth; do 2225+ case " $loclibpth " in 2226+ *" $thislibdir "*) 2227+ case "$dflt " in 2228+ "-L$thislibdir ") ;; 2229+ *) dflt="$dflt -L$thislibdir" ;; 2230+ esac 2231+ ;; 2232+ esac 2233+done 2234+ 2235 echo " " 2236 rp="Any additional ld flags (NOT including libraries)?" 2237 . ./myread 2238@@ -2828,52 +2891,6 @@ n) echo "OK, that should do.";; 2239 esac 2240 $rm -f try try.* core 2241 2242-: Set private lib path 2243-case "$plibpth" in 2244-%s 2245- plibpth="$incpath/usr/lib /usr/local/lib /usr/ccs/lib" 2246- fi;; 2247-esac 2248-case "$libpth" in 2249-' ') dlist='';; 2250-'') dlist="$plibpth $glibpth";; 2251-*) dlist="$libpth";; 2252-esac 2253- 2254-: Now check and see which directories actually exist, avoiding duplicates 2255-libpth='' 2256-for xxx in $dlist 2257-do 2258- if $test -d $xxx; then 2259- case " $libpth " in 2260- *" $xxx "*) ;; 2261- *) libpth="$libpth $xxx";; 2262- esac 2263- fi 2264-done 2265-$cat <<'EOM' 2266- 2267-Some systems have incompatible or broken versions of libraries. Among 2268-the directories listed in the question below, please remove any you 2269-know not to be holding relevant libraries, and add any that are needed. 2270-Say "none" for none. 2271- 2272-EOM 2273-case "$libpth" in 2274-'') dflt='none';; 2275-*) 2276- set X $libpth 2277- shift 2278- dflt=${1+"$@"} 2279- ;; 2280-esac 2281-rp="Directories to use for library searches?" 2282-. ./myread 2283-case "$ans" in 2284-none) libpth=' ';; 2285-*) libpth="$ans";; 2286-esac 2287- 2288 : compute shared library extension 2289 case "$so" in 2290 '') 2291EOPATCH 2292 } 2293 2294 if ($major < 4 && extract_from_file('Configure', 2295 qr/: see which flavor of setpgrp is in use/)) { 2296 edit_file('Configure', sub { 2297 my $code = shift; 2298 my $new = <<'EOT'; 2299if $cc $ccflags $ldflags -o set set.c $libs >/dev/null 2>&1; then 2300EOT 2301 chomp $new; 2302 2303 # before commit ecfc54246c2a6f42: 2304 # before commit 8e07c86ebc651fe9: 2305 my @old = (<<'EOT', <<'EOT'); 2306if $cc $ccflags -o set $ldflags set.c $libs >/dev/null 2>&1; then 2307EOT 2308if $cc $ccflags -o set set.c $ldflags $libs >/dev/null 2>&1; then 2309EOT 2310 for my $was (@old) { 2311 # Yes, this modifies @old. No problem here: 2312 chomp $was; 2313 $was = quotemeta $was; 2314 $code =~ s/$was/$new/; 2315 } 2316 2317 # also commit ecfc54246c2a6f42: 2318 $code =~ s!\tif usg; then!\tif ./usg; then!; 2319 2320 return $code; 2321 }); 2322 2323 # We need the new probe from 2afac517c48c20de, which has prototypes 2324 # (but include the various C headers unconditionally) 2325 apply_patch(<<'EOPATCH'); 2326diff --git a/Configure b/Configure 2327index 18f2172435..5a75ebd767 100755 2328--- a/Configure 2329+++ b/Configure 2330@@ -4986,45 +5055,61 @@ eval $inlibc 2331 set setpgrp d_setpgrp 2332 eval $inlibc 2333 2334-: see which flavor of setpgrp is in use 2335+echo "Checking to see which flavor of setpgrp is in use . . . " 2336 case "$d_setpgrp" in 2337 "$define") 2338 echo " " 2339 $cat >set.c <<EOP 2340+#include <stdio.h> 2341+#include <sys/types.h> 2342+#include <unistd.h> 2343 main() 2344 { 2345 if (getuid() == 0) { 2346 printf("(I see you are running Configure as super-user...)\n"); 2347 setuid(1); 2348 } 2349+#ifdef TRY_BSD_PGRP 2350 if (-1 == setpgrp(1, 1)) 2351- exit(1); 2352- exit(0); 2353+ exit(0); 2354+#else 2355+ if (setpgrp() != -1) 2356+ exit(0); 2357+#endif 2358+ exit(1); 2359 } 2360 EOP 2361- if $cc $ccflags $ldflags -o set set.c $libs >/dev/null 2>&1; then 2362- ./set 2>/dev/null 2363- case $? in 2364- 0) echo "You have to use setpgrp() instead of setpgrp(pid, pgrp)." >&4 2365- val="$undef";; 2366- *) echo "You have to use setpgrp(pid, pgrp) instead of setpgrp()." >&4 2367- val="$define";; 2368- esac 2369+ if $cc -DTRY_BSD_PGRP $ccflags $ldflags -o set set.c $libs >/dev/null 2>&1 && ./set; then 2370+ echo 'You have to use setpgrp(pid,pgrp) instead of setpgrp().' >&4 2371+ val="$define" 2372+ elif $cc $ccflags $ldflags -o set set.c $libs >/dev/null 2>&1 && ./set; then 2373+ echo 'You have to use setpgrp() instead of setpgrp(pid,pgrp).' >&4 2374+ val="$undef" 2375 else 2376+ echo "I can't seem to compile and run the test program." 2377 if ./usg; then 2378- xxx="USG one, i.e. you use setpgrp()." 2379- val="$undef" 2380+ xxx="a USG one, i.e. you use setpgrp()." 2381 else 2382- xxx="BSD one, i.e. you use setpgrp(pid, pgrp)." 2383- val="$define" 2384+ # SVR4 systems can appear rather BSD-ish. 2385+ case "$i_unistd" in 2386+ $undef) 2387+ xxx="a BSD one, i.e. you use setpgrp(pid,pgrp)." 2388+ val="$define" 2389+ ;; 2390+ $define) 2391+ xxx="probably a USG one, i.e. you use setpgrp()." 2392+ val="$undef" 2393+ ;; 2394+ esac 2395 fi 2396- echo "Assuming your setpgrp is a $xxx" >&4 2397+ echo "Assuming your setpgrp is $xxx" >&4 2398 fi 2399 ;; 2400 *) val="$undef";; 2401 esac 2402-set d_bsdpgrp 2403+set d_bsdsetpgrp 2404 eval $setvar 2405+d_bsdpgrp=$d_bsdsetpgrp 2406 $rm -f set set.c 2407 2408 : see if bzero exists 2409EOPATCH 2410 } 2411 2412 if ($major == 4 && extract_from_file('Configure', qr/^d_gethbynam=/)) { 2413 # Fixes a bug introduced in 4599a1dedd47b916 2414 apply_commit('3cbc818d1d0ac470'); 2415 } 2416 2417 if ($major == 4 && extract_from_file('Configure', 2418 qr/gethbadd_addr_type=`echo \$gethbadd_addr_type/)) { 2419 # Fixes a bug introduced in 3fd537d4b944bc7a 2420 apply_commit('6ff9219da6cf8cfd'); 2421 } 2422 2423 if ($major == 4 && extract_from_file('Configure', 2424 qr/^pthreads_created_joinable=/)) { 2425 # Fix for bug introduced in 52e1cb5ebf5e5a8c 2426 # Part of commit ce637636a41b2fef 2427 edit_file('Configure', sub { 2428 my $code = shift; 2429 $code =~ s{^pthreads_created_joinable=''} 2430 {d_pthreads_created_joinable=''}ms 2431 or die_255("Substitution failed"); 2432 $code =~ s{^pthreads_created_joinable='\$pthreads_created_joinable'} 2433 {d_pthreads_created_joinable='\$d_pthreads_created_joinable'}ms 2434 or die_255("Substitution failed"); 2435 return $code; 2436 }); 2437 } 2438 2439 if ($major < 5 && extract_from_file('Configure', 2440 qr!if \$cc \$ccflags try\.c -o try >/dev/null 2>&1; then!)) { 2441 # Analogous to the more general fix of dfe9444ca7881e71 2442 # Without this flags such as -m64 may not be passed to this compile, 2443 # which results in a byteorder of '1234' instead of '12345678', which 2444 # can then cause crashes. 2445 2446 if (extract_from_file('Configure', qr/xxx_prompt=y/)) { 2447 # 8e07c86ebc651fe9 or later 2448 # ("This is my patch patch.1n for perl5.001.") 2449 apply_patch(<<'EOPATCH'); 2450diff --git a/Configure b/Configure 2451index 62249dd..c5c384e 100755 2452--- a/Configure 2453+++ b/Configure 2454@@ -8247,7 +8247,7 @@ main() 2455 } 2456 EOCP 2457 xxx_prompt=y 2458- if $cc $ccflags try.c -o try >/dev/null 2>&1 && ./try > /dev/null; then 2459+ if $cc $ccflags $ldflags try.c -o try >/dev/null 2>&1 && ./try > /dev/null; then 2460 dflt=`./try` 2461 case "$dflt" in 2462 [1-4][1-4][1-4][1-4]|12345678|87654321) 2463EOPATCH 2464 } else { 2465 apply_patch(<<'EOPATCH'); 2466diff --git a/Configure b/Configure 2467index 53649d5..f1cd64a 100755 2468--- a/Configure 2469+++ b/Configure 2470@@ -6362,7 +6362,7 @@ main() 2471 printf("\n"); 2472 } 2473 EOCP 2474- if $cc $ccflags try.c -o try >/dev/null 2>&1 ; then 2475+ if $cc $ccflags $ldflags try.c -o try >/dev/null 2>&1 ; then 2476 dflt=`./try` 2477 case "$dflt" in 2478 ????|????????) echo "(The test program ran ok.)";; 2479EOPATCH 2480 } 2481 } 2482 2483 if ($major < 5) { 2484 my $what = extract_from_file('Configure', qr!(\s+)return __libc_main!); 2485 if ($what) { 2486 # To add to the fun commit commit dfe9444ca7881e71 in Feb 1988 2487 # changed several things: 2488 if ($what !~ /\t/) { 2489 apply_patch(<<'EOPATCH'); 2490--- a/Configure 2491+++ b/Configure 2492@@ -3854,11 +3911,12 @@ n) echo "OK, that should do.";; 2493 int 2494 main() 2495 { 2496- return __libc_main(); 2497+ return __libc_main(); 2498 } 2499 EOM 2500-if $cc $ccflags $ldflags -o gnulibc gnulibc.c $libs >/dev/null 2>&1 && \ 2501- ./gnulibc | $contains '^GNU C Library' >/dev/null 2>&1; then 2502+set gnulibc 2503+if eval $compile && \ 2504+ ./gnulibc | $contains '^GNU C Library' >/dev/null 2>&1; then 2505 val="$define" 2506 echo "You are using the GNU C Library" 2507 else 2508EOPATCH 2509 } 2510 2511 # And commit dc45a647708b6c54 tweaks 1 line in April 1998 2512 edit_file('Configure', sub { 2513 my $code = shift; 2514 $code =~ s{contains '\^GNU C Library' >/dev/null 2>&1; then} 2515 {contains '^GNU C Library'; then}; 2516 return $code; 2517 }); 2518 2519 # This is part of aebf16e7cdbc86ec from June 1998 2520 # but with compiles_ok inlined 2521 apply_patch(<<'EOPATCH'); 2522diff --git a/Configure b/Configure 2523index 38072f0e5e..43735feacf 100755 2524--- a/Configure 2525+++ b/Configure 2526@@ -4024,15 +4024,19 @@ $cc $optimize $ccflags $ldflags -o ${mc_file} $* ${mc_file}.c $libs;' 2527 echo " " 2528 echo "Checking for GNU C Library..." >&4 2529 cat >gnulibc.c <<EOM 2530+#include <stdio.h> 2531 int 2532 main() 2533 { 2534- return __libc_main(); 2535+#ifdef __GLIBC__ 2536+ exit(0); 2537+#else 2538+ exit(1); 2539+#endif 2540 } 2541 EOM 2542 set gnulibc 2543-if eval $compile && \ 2544- ./gnulibc | $contains '^GNU C Library'; then 2545+if $cc $ccflags $ldflags -o gnulibc gnulibc.c $libs && ./gnulibc; then 2546 val="$define" 2547 echo "You are using the GNU C Library" 2548 else 2549EOPATCH 2550 } 2551 } 2552 2553 if ($major < 6 && !extract_from_file('Configure', 2554 qr!^\t-A\)$!)) { 2555 # This adds the -A option to Configure, which is incredibly useful 2556 # Effectively this is commits 02e93a22d20fc9a5, 5f83a3e9d818c3ad, 2557 # bde6b06b2c493fef, f7c3111703e46e0c and 2 lines of trailing whitespace 2558 # removed by 613d6c3e99b9decc, but applied at slightly different 2559 # locations to ensure a clean patch back to 5.000 2560 # Note, if considering patching to the intermediate revisions to fix 2561 # bugs in -A handling, f7c3111703e46e0c is from 2002, and hence 2562 # $major == 8 2563 2564 # To add to the fun, early patches add -K and -O options, and it's not 2565 # trivial to get patch to put the C<. ./posthint.sh> in the right place 2566 edit_file('Configure', sub { 2567 my $code = shift; 2568 $code =~ s/(optstr = ")([^"]+";\s*# getopt-style specification)/$1A:$2/ 2569 or die_255("Substitution failed"); 2570 $code =~ s!^(: who configured the system)! 2571touch posthint.sh 2572. ./posthint.sh 2573 2574$1!ms 2575 or die_255("Substitution failed"); 2576 return $code; 2577 }); 2578 apply_patch(<<'EOPATCH'); 2579diff --git a/Configure b/Configure 2580index 4b55fa6..60c3c64 100755 2581--- a/Configure 2582+++ b/Configure 2583@@ -1150,6 +1150,7 @@ set X `for arg in "$@"; do echo "X$arg"; done | 2584 eval "set $*" 2585 shift 2586 rm -f options.awk 2587+rm -f posthint.sh 2588 2589 : set up default values 2590 fastread='' 2591@@ -1172,6 +1173,56 @@ while test $# -gt 0; do 2592 case "$1" in 2593 -d) shift; fastread=yes;; 2594 -e) shift; alldone=cont;; 2595+ -A) 2596+ shift 2597+ xxx='' 2598+ yyy="$1" 2599+ zzz='' 2600+ uuu=undef 2601+ case "$yyy" in 2602+ *=*) zzz=`echo "$yyy"|sed 's!=.*!!'` 2603+ case "$zzz" in 2604+ *:*) zzz='' ;; 2605+ *) xxx=append 2606+ zzz=" "`echo "$yyy"|sed 's!^[^=]*=!!'` 2607+ yyy=`echo "$yyy"|sed 's!=.*!!'` ;; 2608+ esac 2609+ ;; 2610+ esac 2611+ case "$xxx" in 2612+ '') case "$yyy" in 2613+ *:*) xxx=`echo "$yyy"|sed 's!:.*!!'` 2614+ yyy=`echo "$yyy"|sed 's!^[^:]*:!!'` 2615+ zzz=`echo "$yyy"|sed 's!^[^=]*=!!'` 2616+ yyy=`echo "$yyy"|sed 's!=.*!!'` ;; 2617+ *) xxx=`echo "$yyy"|sed 's!:.*!!'` 2618+ yyy=`echo "$yyy"|sed 's!^[^:]*:!!'` ;; 2619+ esac 2620+ ;; 2621+ esac 2622+ case "$xxx" in 2623+ append) 2624+ echo "$yyy=\"\${$yyy}$zzz\"" >> posthint.sh ;; 2625+ clear) 2626+ echo "$yyy=''" >> posthint.sh ;; 2627+ define) 2628+ case "$zzz" in 2629+ '') zzz=define ;; 2630+ esac 2631+ echo "$yyy='$zzz'" >> posthint.sh ;; 2632+ eval) 2633+ echo "eval \"$yyy=$zzz\"" >> posthint.sh ;; 2634+ prepend) 2635+ echo "$yyy=\"$zzz\${$yyy}\"" >> posthint.sh ;; 2636+ undef) 2637+ case "$zzz" in 2638+ '') zzz="$uuu" ;; 2639+ esac 2640+ echo "$yyy=$zzz" >> posthint.sh ;; 2641+ *) echo "$me: unknown -A command '$xxx', ignoring -A $1" >&2 ;; 2642+ esac 2643+ shift 2644+ ;; 2645 -f) 2646 shift 2647 cd .. 2648EOPATCH 2649 } 2650 2651 if ($major < 6) { 2652 edit_file('Configure', sub { 2653 my $code = shift; 2654 # This will cause a build failure, but it will stop 2655 # Configure looping endlessly trying to get a different 2656 # answer: 2657 $code =~ s{(dflt=)n(\n\s+rp="Function \$ans does not exist)} 2658 {$1y$2}; 2659 return $code; 2660 }); 2661 } 2662 2663 if ($major < 8 && $^O eq 'aix') { 2664 edit_file('Configure', sub { 2665 my $code = shift; 2666 # Replicate commit a8c676c69574838b 2667 # Whitespace allowed at the ends of /lib/syscalls.exp lines 2668 # and half of commit c6912327ae30e6de 2669 # AIX syscalls.exp scan: the syscall might be marked 32, 3264, or 64 2670 $code =~ s{(\bsed\b.*\bsyscall)(?:\[0-9\]\*)?(\$.*/lib/syscalls\.exp)} 2671 {$1 . "[0-9]*[ \t]*" . $2}e; 2672 return $code; 2673 }); 2674 } 2675 2676 if ($major < 8 && !extract_from_file('Configure', 2677 qr/^\t\tif test ! -t 0; then$/)) { 2678 # Before dfe9444ca7881e71, Configure would refuse to run if stdin was 2679 # not a tty. With that commit, the tty requirement was dropped for -de 2680 # and -dE 2681 # Commit aaeb8e512e8e9e14 dropped the tty requirement for -S 2682 # For those older versions, it's probably easiest if we simply remove 2683 # the sanity test. 2684 edit_file('Configure', sub { 2685 my $code = shift; 2686 $code =~ s/test ! -t 0/test Perl = rules/; 2687 return $code; 2688 }); 2689 } 2690 2691 if ($major < 32) { 2692 edit_file('Configure', sub { 2693 my $code = shift; 2694 2695 # A lot of the probes used to be written assuming no need 2696 # for prototypes for exit(), printf() etc. 2697 # Curiously also the code was written to call exit() 2698 # rather than return from main - early portability? 2699 # 2700 # Commit 55954f198635e488 did most of the work in ensuring 2701 # that there was always a prototype for exit, by adding 2702 # #include <stdlib.h> in many probes. However the last 2703 # missing prototype was only addressed by f16c94bc75aefb81 2704 # (for futimes), and the last missing prototypes a few 2705 # commits later in f82f0f36c7188b6d 2706 # 2707 # As an aside, commit dc45a647708b6c54 fixes the signal 2708 # name probe (etc) - the commit tagged as perl-5.004_01 2709 # *seems* to fix the signal name probe, but actually it 2710 # fixes an error in the fallback awk code, not the C 2711 # probe's missing prototype. 2712 # 2713 # With current C compilers there is no correctness risk 2714 # from including a header more than once, so the easiest 2715 # approach to making this all work is to add includes 2716 # "to be sure to be sure" 2717 # 2718 # The trick is not to break *working* probes by 2719 # accidentally including a header *within* a construction. 2720 # So we need to have some confidence that it's the start 2721 # of a file (or somewhere safe) 2722 2723 my $headers = <<'EOFIX'; 2724#include <stdio.h> 2725#include <stdlib.h> 2726#include <string.h> 2727EOFIX 2728 2729 # This handles $cat and plain cat: 2730 $code =~ s{([\$\t\n ]cat > *[a-z0-9]+\.c <<[^\n]*\n)} 2731 {$1$headers}g; 2732 # Of course, there's always one that's backwards: 2733 $code =~ s{([\$\t\n ]cat <<[^\n]* > *[a-z0-9]+\.c\n)} 2734 {$1$headers}g; 2735 2736 # and >> used to *create* a file. 2737 # We have to be careful to distinguish those from >> used 2738 # to append to a file. All the first lines have #include 2739 # or #ifdef. Except the few that don't... 2740 $code =~ s{ 2741 ([\$\t\n ]cat\ >>\ *[a-z]+\.c\ <<[^\n]*\n) 2742 ( 2743 # #include/#ifdef ... 2744 \# 2745 | 2746 # The non-blocking IO probe 2747 (?:int\ )?main\(\) 2748 | 2749 # The alignment constraint probe 2750 struct\ foobar 2751 ) 2752 } 2753 {$1$headers$2}gx; 2754 2755 # This is part of commit c727eafaa06ca49a: 2756 $code =~ s{\(int\)exit\(0\);} 2757 {\(void\)exit\(0\);}; 2758 2759 return $code; 2760 }); 2761 } 2762 2763 if ($major < 10) { 2764 # Fix symbol detection to that of commit 373dfab3839ca168 if it's any 2765 # intermediate version 5129fff43c4fe08c or later, as the intermediate 2766 # versions don't work correctly on (at least) Sparc Linux. 2767 # 5129fff43c4fe08c adds the first mention of mistrustnm. 2768 # 373dfab3839ca168 removes the last mention of lc="" 2769 # 2770 # Fix symbol detection prior to 5129fff43c4fe08c to use the same 2771 # approach, where we don't call printf without a prototype 2772 # We can't include <stdio.h> to get its prototype, as the way this works 2773 # is to create a (wrong) prototype for the probed functions, and those 2774 # conflict if the function in question is in stdio.h. 2775 edit_file('Configure', sub { 2776 my $code = shift; 2777 return $code 2778 if $code !~ /\btc="";/; # 373dfab3839ca168 or later 2779 if ($code !~ /\bmistrustnm\b/) { 2780 # doing this as a '' heredoc seems to be the easiest 2781 # way to avoid confusing levels of backslashes: 2782 my $now = <<'EOT'; 2783void *(*(p()))$tdc { extern void *$1$tdc; return &$1; } int main() { if(p()) return(0); else return(1); } 2784EOT 2785 chomp $now; 2786 2787 # before 5129fff43c4fe08c 2788 # befure 16d20bd98cd29be7 2789 my @old = (<<'EOT', <<'EOT'); 2790main() { extern short $1$tdc; printf(\"%hd\", $1$tc); } 2791EOT 2792main() { extern int $1$tdc; printf(\"%d\", $1$tc); } 2793EOT 2794 for my $was (@old) { 2795 chomp $was; 2796 $was = quotemeta $was; 2797 2798 # Prior to commit d674cd6de52ff38b there was no 2799 # 'int ' for 'int main' 2800 $code =~ s/(?:int )?$was/$now/; 2801 } 2802 return $code; 2803 } 2804 2805 my $fixed = <<'EOC'; 2806 2807: is a C symbol defined? 2808csym='tlook=$1; 2809case "$3" in 2810-v) tf=libc.tmp; tdc="";; 2811-a) tf=libc.tmp; tdc="[]";; 2812*) tlook="^$1\$"; tf=libc.list; tdc="()";; 2813esac; 2814tx=yes; 2815case "$reuseval-$4" in 2816true-) ;; 2817true-*) tx=no; eval "tval=\$$4"; case "$tval" in "") tx=yes;; esac;; 2818esac; 2819case "$tx" in 2820yes) 2821 tval=false; 2822 if $test "$runnm" = true; then 2823 if $contains $tlook $tf >/dev/null 2>&1; then 2824 tval=true; 2825 elif $test "$mistrustnm" = compile -o "$mistrustnm" = run; then 2826 echo "void *(*(p()))$tdc { extern void *$1$tdc; return &$1; } int main() { if(p()) return(0); else return(1); }"> try.c; 2827 $cc -o try $optimize $ccflags $ldflags try.c >/dev/null 2>&1 $libs && tval=true; 2828 $test "$mistrustnm" = run -a -x try && { $run ./try$_exe >/dev/null 2>&1 || tval=false; }; 2829 $rm -f try$_exe try.c core core.* try.core; 2830 fi; 2831 else 2832 echo "void *(*(p()))$tdc { extern void *$1$tdc; return &$1; } int main() { if(p()) return(0); else return(1); }"> try.c; 2833 $cc -o try $optimize $ccflags $ldflags try.c $libs >/dev/null 2>&1 && tval=true; 2834 $rm -f try$_exe try.c; 2835 fi; 2836 ;; 2837*) 2838 case "$tval" in 2839 $define) tval=true;; 2840 *) tval=false;; 2841 esac; 2842 ;; 2843esac; 2844eval "$2=$tval"' 2845 2846EOC 2847 $code =~ s/\n: is a C symbol defined\?\n.*?\neval "\$2=\$tval"'\n\n/$fixed/sm 2848 or die_255("substitution failed"); 2849 return $code; 2850 }); 2851 } 2852 2853 if ($major < 10 2854 && extract_from_file('Configure', qr/^set malloc\.h i_malloc$/)) { 2855 # This is commit 01d07975f7ef0e7d, trimmed, with $compile inlined as 2856 # prior to bd9b35c97ad661cc Configure had the malloc.h test before the 2857 # definition of $compile. 2858 apply_patch(<<'EOPATCH'); 2859diff --git a/Configure b/Configure 2860index 3d2e8b9..6ce7766 100755 2861--- a/Configure 2862+++ b/Configure 2863@@ -6743,5 +6743,22 @@ set d_dosuid 2864 2865 : see if this is a malloc.h system 2866-set malloc.h i_malloc 2867-eval $inhdr 2868+: we want a real compile instead of Inhdr because some systems have a 2869+: malloc.h that just gives a compile error saying to use stdlib.h instead 2870+echo " " 2871+$cat >try.c <<EOCP 2872+#include <stdlib.h> 2873+#include <malloc.h> 2874+int main () { return 0; } 2875+EOCP 2876+set try 2877+if $cc $optimize $ccflags $ldflags -o try $* try.c $libs > /dev/null 2>&1; then 2878+ echo "<malloc.h> found." >&4 2879+ val="$define" 2880+else 2881+ echo "<malloc.h> NOT found." >&4 2882+ val="$undef" 2883+fi 2884+$rm -f try.c try 2885+set i_malloc 2886+eval $setvar 2887 2888EOPATCH 2889 } 2890 2891 if ($major < 38 && !extract_from_file('Configure', qr/Too many attempts asking the same question/)) { 2892 # Without this, myread can loop infinitely trying to get a valid answer, 2893 # and hence Configure gets stuck in a loop, outputting the same question 2894 # repeatedly. This isn't what we need. 2895 apply_commit('46bfb3c49f22629a'); 2896 } 2897} 2898 2899sub patch_hints { 2900 if ($^O eq 'freebsd') { 2901 # There are rather too many version-specific FreeBSD hints fixes to 2902 # patch individually. Also, more than once the FreeBSD hints file has 2903 # been written in what turned out to be a rather non-future-proof style, 2904 # with case statements treating the most recent version as the 2905 # exception, instead of treating previous versions' behaviour explicitly 2906 # and changing the default to cater for the current behaviour. (As 2907 # strangely, future versions inherit the current behaviour.) 2908 checkout_file('hints/freebsd.sh'); 2909 } elsif ($^O eq 'darwin') { 2910 if ($major < 8) { 2911 # We can't build on darwin without some of the data in the hints 2912 # file. Probably less surprising to use the earliest version of 2913 # hints/darwin.sh and then edit in place just below, than use 2914 # blead's version, as that would create a discontinuity at 2915 # f556e5b971932902 - before it, hints bugs would be "fixed", after 2916 # it they'd resurface. This way, we should give the illusion of 2917 # monotonic bug fixing. 2918 my $faking_it; 2919 if (!-f 'hints/darwin.sh') { 2920 checkout_file('hints/darwin.sh', 'f556e5b971932902'); 2921 ++$faking_it; 2922 } 2923 2924 edit_file('hints/darwin.sh', sub { 2925 my $code = shift; 2926 # Part of commit 8f4f83badb7d1ba9, which mostly undoes 2927 # commit 0511a818910f476c. 2928 $code =~ s/^cppflags='-traditional-cpp';$/cppflags="\${cppflags} -no-cpp-precomp"/m; 2929 # commit 14c11978e9b52e08/803bb6cc74d36a3f 2930 # Without this, code in libperl.bundle links against op.o 2931 # in preference to opmini.o on the linker command line, 2932 # and hence miniperl tries to use File::Glob instead of 2933 # csh 2934 $code =~ s/^(lddlflags=)/ldflags="\${ldflags} -flat_namespace"\n$1/m; 2935 # f556e5b971932902 also patches Makefile.SH with some 2936 # special case code to deal with useshrplib for darwin. 2937 # Given that post 5.8.0 the darwin hints default was 2938 # changed to false, and it would be very complex to splice 2939 # in that code in various versions of Makefile.SH back 2940 # to 5.002, lets just turn it off. 2941 $code =~ s/^useshrplib='true'/useshrplib='false'/m 2942 if $faking_it; 2943 2944 # Part of commit d235852b65d51c44 2945 # Don't do this on a case sensitive HFS+ partition, as it 2946 # breaks the build for 5.003 and earlier. 2947 if ($case_insensitive 2948 && $code !~ /^firstmakefile=GNUmakefile/) { 2949 $code .= "\nfirstmakefile=GNUmakefile;\n"; 2950 } 2951 2952 return $code; 2953 }); 2954 } 2955 2956 if ($major < 8 || 2957 ($major < 10 && !extract_from_file('ext/DynaLoader/Makefile.PL', 2958 qr/sub MY::static /))) { 2959 edit_file('hints/darwin.sh', sub { 2960 my $code = shift; 2961 # As above, the build fails if version of code in op.o 2962 # is linked to, instead of opmini.o 2963 # We don't need this after commit 908fcb8bef8cbab8, 2964 # which moves DynaLoader.o into the shared perl 2965 # library, as it *also* redoes the build so that 2966 # miniperl is linked against all the object files 2967 # (explicitly excluding op.o), instead of against the 2968 # shared library (and reyling on "flat namespaces" 2969 # - ie make Mach-O behave like ELF - to end up with 2970 # objects in the library linking against opmini.o) 2971 $code .= <<'EOHACK'; 2972 2973# Force a flat namespace everywhere: 2974echo $ldflags | grep flat_namespace || ldflags=`echo \$lddflags -flat_namespace` 2975echo $lddlflags | grep flat_namespace || lddlflags=`echo \$lddlflags -flat_namespace` 2976EOHACK 2977 return $code; 2978 }); 2979 } 2980 2981 if ($major < 16) { 2982 edit_file('hints/darwin.sh', sub { 2983 my $code = shift; 2984 # This is commit 60a655a1ee05c577 2985 $code =~ s/usenm='true'/usenm='false'/; 2986 2987 # With the Configure probes fixed (in patch_Configure) 2988 # the "d_stdstdio" logic now concludes "define". 2989 # Unfortunately that is not correct - attempting to 2990 # build 5.8.0 without this override results in SEGVs 2991 # or similar chaos. 2992 # 2993 # The problem is introduced by commit 5a3a8a022aa61cba 2994 # which enables perlio by default. 2995 # The problem is hidden after 15b61c98f82f3010, which 2996 # adds "d_faststdio" and defaults it to "undef" from 2997 # that commit onwards, but override that and the build 2998 # would break, up until "turning off perlio" was 2999 # disabled by commit dd35fa16610ef2fa 3000 $code .= "\nd_stdstdio='undef'\n"; 3001 3002 return $code; 3003 }); 3004 } 3005 3006 if ($major < 34) { 3007 edit_file('hints/darwin.sh', sub { 3008 my $code = shift; 3009 # This is commits aadc6422eaec39c2 and 54d41b60822734cf 3010 # rolled into one: 3011 $code =~ s/ 10\.\*(?: \| 11\.\*)?\)/ [1-9][0-9].*)/g; 3012 return $code; 3013 }); 3014 } 3015 } elsif ($^O eq 'netbsd') { 3016 if ($major < 6) { 3017 # These are part of commit 099685bc64c7dbce 3018 edit_file('hints/netbsd.sh', sub { 3019 my $code = shift; 3020 my $fixed = <<'EOC'; 3021case "$osvers" in 30220.9|0.8*) 3023 usedl="$undef" 3024 ;; 3025*) 3026 if [ -f /usr/libexec/ld.elf_so ]; then 3027 d_dlopen=$define 3028 d_dlerror=$define 3029 ccdlflags="-Wl,-E -Wl,-R${PREFIX}/lib $ccdlflags" 3030 cccdlflags="-DPIC -fPIC $cccdlflags" 3031 lddlflags="--whole-archive -shared $lddlflags" 3032 elif [ "`uname -m`" = "pmax" ]; then 3033# NetBSD 1.3 and 1.3.1 on pmax shipped an 'old' ld.so, which will not work. 3034 d_dlopen=$undef 3035 elif [ -f /usr/libexec/ld.so ]; then 3036 d_dlopen=$define 3037 d_dlerror=$define 3038 ccdlflags="-Wl,-R${PREFIX}/lib $ccdlflags" 3039# we use -fPIC here because -fpic is *NOT* enough for some of the 3040# extensions like Tk on some netbsd platforms (the sparc is one) 3041 cccdlflags="-DPIC -fPIC $cccdlflags" 3042 lddlflags="-Bforcearchive -Bshareable $lddlflags" 3043 else 3044 d_dlopen=$undef 3045 fi 3046 ;; 3047esac 3048EOC 3049 $code =~ s/^case "\$osvers" in\n0\.9\|0\.8.*?^esac\n/$fixed/ms; 3050 return $code; 3051 }); 3052 } 3053 } elsif ($^O eq 'openbsd') { 3054 if ($major < 8) { 3055 checkout_file('hints/openbsd.sh', '43051805d53a3e4c') 3056 unless -f 'hints/openbsd.sh'; 3057 my $which = extract_from_file('hints/openbsd.sh', 3058 qr/# from (2\.8|3\.1) onwards/, 3059 ''); 3060 if ($which eq '') { 3061 my $was = extract_from_file('hints/openbsd.sh', 3062 qr/(lddlflags="(?:-Bforcearchive )?-Bshareable)/); 3063 # This is commit 154d43cbcf57271c and parts of 5c75dbfa77b0949c 3064 # and 29b5585702e5e025 3065 apply_patch(sprintf <<'EOPATCH', $was); 3066diff --git a/hints/openbsd.sh b/hints/openbsd.sh 3067index a7d8bf2..5b79709 100644 3068--- a/hints/openbsd.sh 3069+++ b/hints/openbsd.sh 3070@@ -37,7 +37,25 @@ OpenBSD.alpha|OpenBSD.mips|OpenBSD.powerpc|OpenBSD.vax) 3071 # we use -fPIC here because -fpic is *NOT* enough for some of the 3072 # extensions like Tk on some OpenBSD platforms (ie: sparc) 3073 cccdlflags="-DPIC -fPIC $cccdlflags" 3074- %s $lddlflags" 3075+ case "$osvers" in 3076+ [01].*|2.[0-7]|2.[0-7].*) 3077+ lddlflags="-Bshareable $lddlflags" 3078+ ;; 3079+ 2.[8-9]|3.0) 3080+ ld=${cc:-cc} 3081+ lddlflags="-shared -fPIC $lddlflags" 3082+ ;; 3083+ *) # from 3.1 onwards 3084+ ld=${cc:-cc} 3085+ lddlflags="-shared -fPIC $lddlflags" 3086+ libswanted=`echo $libswanted | sed 's/ dl / /'` 3087+ ;; 3088+ esac 3089+ 3090+ # We need to force ld to export symbols on ELF platforms. 3091+ # Without this, dlopen() is crippled. 3092+ ELF=`${cc:-cc} -dM -E - </dev/null | grep __ELF__` 3093+ test -n "$ELF" && ldflags="-Wl,-E $ldflags" 3094 ;; 3095 esac 3096 3097EOPATCH 3098 } elsif ($which eq '2.8') { 3099 # This is parts of 5c75dbfa77b0949c and 29b5585702e5e025, and 3100 # possibly eb9cd59d45ad2908 3101 my $was = extract_from_file('hints/openbsd.sh', 3102 qr/lddlflags="(-shared(?: -fPIC)?) \$lddlflags"/); 3103 3104 apply_patch(sprintf <<'EOPATCH', $was); 3105--- a/hints/openbsd.sh 2011-10-21 17:25:20.000000000 +0200 3106+++ b/hints/openbsd.sh 2011-10-21 16:58:43.000000000 +0200 3107@@ -44,11 +44,21 @@ 3108 [01].*|2.[0-7]|2.[0-7].*) 3109 lddlflags="-Bshareable $lddlflags" 3110 ;; 3111- *) # from 2.8 onwards 3112+ 2.[8-9]|3.0) 3113 ld=${cc:-cc} 3114- lddlflags="%s $lddlflags" 3115+ lddlflags="-shared -fPIC $lddlflags" 3116+ ;; 3117+ *) # from 3.1 onwards 3118+ ld=${cc:-cc} 3119+ lddlflags="-shared -fPIC $lddlflags" 3120+ libswanted=`echo $libswanted | sed 's/ dl / /'` 3121 ;; 3122 esac 3123+ 3124+ # We need to force ld to export symbols on ELF platforms. 3125+ # Without this, dlopen() is crippled. 3126+ ELF=`${cc:-cc} -dM -E - </dev/null | grep __ELF__` 3127+ test -n "$ELF" && ldflags="-Wl,-E $ldflags" 3128 ;; 3129 esac 3130 3131EOPATCH 3132 } elsif ($which eq '3.1' 3133 && !extract_from_file('hints/openbsd.sh', 3134 qr/We need to force ld to export symbols on ELF platforms/)) { 3135 # This is part of 29b5585702e5e025 3136 apply_patch(<<'EOPATCH'); 3137diff --git a/hints/openbsd.sh b/hints/openbsd.sh 3138index c6b6bc9..4839d04 100644 3139--- a/hints/openbsd.sh 3140+++ b/hints/openbsd.sh 3141@@ -54,6 +54,11 @@ alpha-2.[0-8]|mips-*|vax-*|powerpc-2.[0-7]|m88k-*) 3142 libswanted=`echo $libswanted | sed 's/ dl / /'` 3143 ;; 3144 esac 3145+ 3146+ # We need to force ld to export symbols on ELF platforms. 3147+ # Without this, dlopen() is crippled. 3148+ ELF=`${cc:-cc} -dM -E - </dev/null | grep __ELF__` 3149+ test -n "$ELF" && ldflags="-Wl,-E $ldflags" 3150 ;; 3151 esac 3152 3153EOPATCH 3154 } 3155 } 3156 } elsif ($^O eq 'linux') { 3157 if ($major < 1) { 3158 # sparc linux seems to need the -Dbool=char -DHAS_BOOL part of 3159 # perl5.000 patch.0n: [address Configure and build issues] 3160 edit_file('hints/linux.sh', sub { 3161 my $code = shift; 3162 $code =~ s!-I/usr/include/bsd!-Dbool=char -DHAS_BOOL!g; 3163 return $code; 3164 }); 3165 } 3166 3167 if ($major <= 9) { 3168 if (`uname -sm` =~ qr/^Linux sparc/) { 3169 if (extract_from_file('hints/linux.sh', qr/sparc-linux/)) { 3170 # Be sure to use -fPIC not -fpic on Linux/SPARC 3171 apply_commit('f6527d0ef0c13ad4'); 3172 } elsif(!extract_from_file('hints/linux.sh', 3173 qr/^sparc-linux\)$/)) { 3174 my $fh = open_or_die('hints/linux.sh', '>>'); 3175 print $fh <<'EOT' or die_255($!); 3176 3177case "`uname -m`" in 3178sparc*) 3179 case "$cccdlflags" in 3180 *-fpic*) cccdlflags="`echo $cccdlflags|sed 's/-fpic/-fPIC/'`" ;; 3181 *) cccdlflags="$cccdlflags -fPIC" ;; 3182 esac 3183 ;; 3184esac 3185EOT 3186 close_or_die($fh); 3187 } 3188 } 3189 } 3190 } elsif ($^O eq 'solaris') { 3191 if (($major == 13 || $major == 14) 3192 && extract_from_file('hints/solaris_2.sh', qr/getconfldllflags/)) { 3193 apply_commit('c80bde4388070c45'); 3194 } 3195 } 3196} 3197 3198sub patch_SH { 3199 # Cwd.xs added in commit 0d2079faa739aaa9. Cwd.pm moved to ext/ 8 years 3200 # later in commit 403f501d5b37ebf0 3201 if ($major > 0 && <*/Cwd/Cwd.xs>) { 3202 if ($major < 10 3203 && !extract_from_file('Makefile.SH', qr/^extra_dep=''$/)) { 3204 # The Makefile.PL for Unicode::Normalize needs 3205 # lib/unicore/CombiningClass.pl. Even without a parallel build, we 3206 # need a dependency to ensure that it builds. This is a variant of 3207 # commit 9f3ef600c170f61e. Putting this for earlier versions gives 3208 # us a spot on which to hang the edits below 3209 apply_patch(<<'EOPATCH'); 3210diff --git a/Makefile.SH b/Makefile.SH 3211index f61d0db..6097954 100644 3212--- a/Makefile.SH 3213+++ b/Makefile.SH 3214@@ -155,10 +155,20 @@ esac 3215 3216 : Prepare dependency lists for Makefile. 3217 dynamic_list=' ' 3218+extra_dep='' 3219 for f in $dynamic_ext; do 3220 : the dependency named here will never exist 3221 base=`echo "$f" | sed 's/.*\///'` 3222- dynamic_list="$dynamic_list lib/auto/$f/$base.$dlext" 3223+ this_target="lib/auto/$f/$base.$dlext" 3224+ dynamic_list="$dynamic_list $this_target" 3225+ 3226+ : Parallel makes reveal that we have some interdependencies 3227+ case $f in 3228+ Math/BigInt/FastCalc) extra_dep="$extra_dep 3229+$this_target: lib/auto/List/Util/Util.$dlext" ;; 3230+ Unicode/Normalize) extra_dep="$extra_dep 3231+$this_target: lib/unicore/CombiningClass.pl" ;; 3232+ esac 3233 done 3234 3235 static_list=' ' 3236@@ -987,2 +997,9 @@ n_dummy $(nonxs_ext): miniperl$(EXE_EXT) preplibrary $(DYNALOADER) FORCE 3237 @$(LDLIBPTH) sh ext/util/make_ext nonxs $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL) 3238+!NO!SUBS! 3239+ 3240+$spitshell >>Makefile <<EOF 3241+$extra_dep 3242+EOF 3243+ 3244+$spitshell >>Makefile <<'!NO!SUBS!' 3245 3246EOPATCH 3247 } 3248 3249 if ($major == 15 && $^O !~ /^(linux|darwin|.*bsd)$/ 3250 && extract_from_file('Makefile.SH', qr/^V.* \?= /)) { 3251 # Remove the GNU-make-ism (which the BSD makes also support, but 3252 # most other makes choke on) 3253 apply_patch(<<'EOPATCH'); 3254diff --git a/Makefile.SH b/Makefile.SH 3255index 94952bd..13e9001 100755 3256--- a/Makefile.SH 3257+++ b/Makefile.SH 3258@@ -338,8 +338,8 @@ linux*|darwin) 3259 $spitshell >>$Makefile <<!GROK!THIS! 3260 # If you're going to use valgrind and it can't be invoked as plain valgrind 3261 # then you'll need to change this, or override it on the make command line. 3262-VALGRIND ?= valgrind 3263-VG_TEST ?= ./perl -e 1 2>/dev/null 3264+VALGRIND = valgrind 3265+VG_TEST = ./perl -e 1 2>/dev/null 3266 3267 !GROK!THIS! 3268 ;; 3269EOPATCH 3270 } 3271 3272 if ($major == 11) { 3273 if (extract_from_file('patchlevel.h', 3274 qr/^#include "unpushed\.h"/)) { 3275 # I had thought it easier to detect when building one of the 52 3276 # commits with the original method of incorporating the git 3277 # revision and drop parallel make flags. Commits shown by 3278 # git log 46807d8e809cc127^..dcff826f70bf3f64^ ^d4fb0a1f15d1a1c4 3279 # However, it's not actually possible to make miniperl for that 3280 # configuration as-is, because the file .patchnum is only made 3281 # as a side effect of target 'all' 3282 # I also don't think that it's "safe" to simply run 3283 # make_patchnum.sh before the build. We need the proper 3284 # dependency rules in the Makefile to *stop* it being run again 3285 # at the wrong time. 3286 # This range is important because contains the commit that 3287 # merges Schwern's y2038 work. 3288 apply_patch(<<'EOPATCH'); 3289diff --git a/Makefile.SH b/Makefile.SH 3290index 9ad8b6f..106e721 100644 3291--- a/Makefile.SH 3292+++ b/Makefile.SH 3293@@ -540,9 +544,14 @@ sperl.i: perl.c $(h) 3294 3295 .PHONY: all translators utilities make_patchnum 3296 3297-make_patchnum: 3298+make_patchnum: lib/Config_git.pl 3299+ 3300+lib/Config_git.pl: make_patchnum.sh 3301 sh $(shellflags) make_patchnum.sh 3302 3303+# .patchnum, unpushed.h and lib/Config_git.pl are built by make_patchnum.sh 3304+unpushed.h .patchnum: lib/Config_git.pl 3305+ 3306 # make sure that we recompile perl.c if .patchnum changes 3307 perl$(OBJ_EXT): .patchnum unpushed.h 3308 3309EOPATCH 3310 } elsif (-f '.gitignore' 3311 && extract_from_file('.gitignore', qr/^\.patchnum$/)) { 3312 # 8565263ab8a47cda to 46807d8e809cc127^ inclusive. 3313 edit_file('Makefile.SH', sub { 3314 my $code = shift; 3315 $code =~ s/^make_patchnum:\n/make_patchnum: .patchnum 3316 3317.sha1: .patchnum 3318 3319.patchnum: make_patchnum.sh 3320/m; 3321 return $code; 3322 }); 3323 } elsif (-f 'lib/.gitignore' 3324 && extract_from_file('lib/.gitignore', 3325 qr!^/Config_git.pl!) 3326 && !extract_from_file('Makefile.SH', 3327 qr/^uudmap\.h.*:bitcount.h$/)) { 3328 # Between commits and dcff826f70bf3f64 and 0f13ebd5d71f8177^ 3329 edit_file('Makefile.SH', sub { 3330 my $code = shift; 3331 # Bug introduced by 344af494c35a9f0f 3332 # fixed in 0f13ebd5d71f8177 3333 $code =~ s{^(pod/perlapi\.pod) (pod/perlintern\.pod): } 3334 {$1: $2\n\n$2: }m; 3335 # Bug introduced by efa50c51e3301a2c 3336 # fixed in 0f13ebd5d71f8177 3337 $code =~ s{^(uudmap\.h) (bitcount\.h): } 3338 {$1: $2\n\n$2: }m; 3339 3340 # The rats nest of getting git_version.h correct 3341 3342 if ($code =~ s{git_version\.h: stock_git_version\.h 3343\tcp stock_git_version\.h git_version\.h} 3344 {}m) { 3345 # before 486cd780047ff224 3346 3347 # We probably can't build between 3348 # 953f6acfa20ec275^ and 8565263ab8a47cda 3349 # inclusive, but all commits in that range 3350 # relate to getting make_patchnum.sh working, 3351 # so it is extremely unlikely to be an 3352 # interesting bisect target. They will skip. 3353 3354 # No, don't spawn a submake if 3355 # make_patchnum.sh or make_patchnum.pl fails 3356 $code =~ s{\|\| \$\(MAKE\) miniperl.*} 3357 {}m; 3358 $code =~ s{^\t(sh.*make_patchnum\.sh.*)} 3359 {\t-$1}m; 3360 3361 # Use an external perl to run make_patchnum.pl 3362 # because miniperl still depends on 3363 # git_version.h 3364 $code =~ s{^\t.*make_patchnum\.pl} 3365 {\t-$^X make_patchnum.pl}m; 3366 3367 3368 # "Truth in advertising" - running 3369 # make_patchnum generates 2 files. 3370 $code =~ s{^make_patchnum:.*}{ 3371make_patchnum: lib/Config_git.pl 3372 3373git_version.h: lib/Config_git.pl 3374 3375perlmini\$(OBJ_EXT): git_version.h 3376 3377lib/Config_git.pl:}m; 3378 } 3379 # Right, now we've corrected Makefile.SH to 3380 # correctly describe how lib/Config_git.pl and 3381 # git_version.h are made, we need to fix the rest 3382 3383 # This emulates commit 2b63e250843b907e 3384 # This might duplicate the rule stating that 3385 # git_version.h depends on lib/Config_git.pl 3386 # This is harmless. 3387 $code =~ s{^(?:lib/Config_git\.pl )?git_version\.h: (.* make_patchnum\.pl.*)} 3388 {git_version.h: lib/Config_git.pl 3389 3390lib/Config_git.pl: $1}m; 3391 3392 # This emulates commits 0f13ebd5d71f8177 3393 # and a04d4598adc57886. It ensures that 3394 # lib/Config_git.pl is built before configpm, 3395 # and that configpm is run exactly once. 3396 $code =~ s{^(\$\(.*?\) )?(\$\(CONFIGPOD\))(: .*? configpm Porting/Glossary)( lib/Config_git\.pl)?}{ 3397 # If present, other files depend on $(CONFIGPOD) 3398 ($1 ? "$1: $2\n\n" : '') 3399 # Then the rule we found 3400 . $2 . $3 3401 # Add dependency if not there 3402 . ($4 ? $4 : ' lib/Config_git.pl') 3403 }me; 3404 3405 return $code; 3406 }); 3407 } 3408 } 3409 3410 if ($major < 14) { 3411 # Commits dc0655f797469c47 and d11a62fe01f2ecb2 3412 edit_file('Makefile.SH', sub { 3413 my $code = shift; 3414 foreach my $ext (qw(Encode SDBM_File)) { 3415 next if $code =~ /\b$ext\) extra_dep=/s; 3416 $code =~ s!(\) extra_dep="\$extra_dep 3417\$this_target: .*?" ;;) 3418( esac 3419)!$1 3420 $ext) extra_dep="\$extra_dep 3421\$this_target: lib/auto/Cwd/Cwd.\$dlext" ;; 3422$2!; 3423 } 3424 return $code; 3425 }); 3426 } 3427 } 3428 3429 if ($major == 3) { 3430 # This is part of commit f0efd8cf98c95b42: 3431 edit_file('Makefile.SH', sub { 3432 my $code = shift; 3433 $code =~ s/<<!NO!SUBS!/<<'!NO!SUBS!'/; 3434 return $code; 3435 }); 3436 } 3437 3438 if ($major == 7) { 3439 # Remove commits 9fec149bb652b6e9 and 5bab1179608f81d8, which add/amend 3440 # rules to automatically run regen scripts that rebuild C headers. These 3441 # cause problems because a git checkout doesn't preserve relative file 3442 # modification times, hence the regen scripts may fire. This will 3443 # obscure whether the repository had the correct generated headers 3444 # checked in. 3445 # Also, the dependency rules for running the scripts were not correct, 3446 # which could cause spurious re-builds on re-running make, and can cause 3447 # complete build failures for a parallel make. 3448 if (extract_from_file('Makefile.SH', 3449 qr/Writing it this way gives make a big hint to always run opcode\.pl before/)) { 3450 apply_commit('70c6e6715e8fec53'); 3451 } elsif (extract_from_file('Makefile.SH', 3452 qr/^opcode\.h opnames\.h pp_proto\.h pp\.sym: opcode\.pl$/)) { 3453 revert_commit('9fec149bb652b6e9'); 3454 } 3455 } 3456 3457 if ($^O eq 'darwin' && ($major < 8 3458 || ($major < 10 3459 && !extract_from_file('ext/DynaLoader/Makefile.PL', 3460 qr/sub MY::static /)))) { 3461 my $cwd = Cwd::getcwd(); 3462 my $wrapper = 'miniperl.sh'; 3463 my $fh = open_or_die($wrapper, '>'); 3464 print $fh <<"EOT"; 3465#!/bin/sh 3466${aggressive_apple_security}exec $cwd/miniperl "\$\@" 3467EOT 3468 close_or_die($fh); 3469 chmod 0755, $wrapper 3470 or die "Couldn't chmod 0755 $wrapper: $!"; 3471 3472 edit_file('ext/util/make_ext', sub { 3473 my $code = shift; 3474 # This is shell expansion syntax 3475 $code =~ s{ (\.\./\$depth/miniperl) } 3476 { $1.sh }; 3477 # This is actually the same line as edited above. 3478 # We need this because (yay), without this EU::MM will 3479 # default to searching for a working perl binary 3480 # (sensible plan) but due to macOS stripping 3481 # DYLD_LIBRARY_PATH during system(...), .../miniperl 3482 # (as found from $^X) *isn't* going to work. 3483 $code =~ s{ (Makefile\.PL INSTALLDIRS=perl) } 3484 { $1 PERL=\.\./\$depth/miniperl.sh }; 3485 return $code; 3486 }); 3487 } 3488 3489 if ($^O eq 'aix' && $major >= 8 && $major < 28 3490 && extract_from_file('Makefile.SH', qr!\Q./$(MINIPERLEXP) makedef.pl\E.*aix!)) { 3491 # This is a variant the AIX part of commit 72bbce3da5eeffde: 3492 # miniperl also needs -Ilib for perl.exp on AIX etc 3493 edit_file('Makefile.SH', sub { 3494 my $code = shift; 3495 $code =~ s{(\Q./$(MINIPERLEXP)\E) (makedef\.pl.*aix)} 3496 {$1 -Ilib $2}; 3497 return $code; 3498 }) 3499 } 3500 # This is the line before the line we've edited just above: 3501 if ($^O eq 'aix' && $major >= 11 && $major <= 15 3502 && extract_from_file('makedef.pl', qr/^use Config/)) { 3503 edit_file('Makefile.SH', sub { 3504 # The AIX part of commit e6807d8ab22b761c 3505 # It's safe to substitute lib/Config.pm for config.sh 3506 # as lib/Config.pm depends on config.sh 3507 # If the tree is post e6807d8ab22b761c, the substitution 3508 # won't match, which is harmless. 3509 my $code = shift; 3510 $code =~ s{^(perl\.exp:.* )config\.sh(\b.*)} 3511 {$1 . '$(CONFIGPM)' . $2}me; 3512 return $code; 3513 }); 3514 } 3515 3516 # There was a bug in makedepend.SH which was fixed in version 96a8704c. 3517 # Symptom was './makedepend: 1: Syntax error: Unterminated quoted string' 3518 # Remove this if you're actually bisecting a problem related to 3519 # makedepend.SH 3520 # If you do this, you may need to add in code to correct the output of older 3521 # makedepends, which don't correctly filter newer gcc output such as 3522 # <built-in> 3523 3524 # It's the same version in v5.26.0 to v5.34.0 3525 # Post v5.34.0, commit 8d469d0ecbd06a99 completely changes how makedepend.SH 3526 # interacts with Makefile.SH, meaning that it's not a drop-in upgrade. 3527 checkout_file('makedepend.SH', 'v5.34.0') 3528 if $major < 26; 3529 3530 if ($major < 4 && -f 'config.sh' 3531 && !extract_from_file('config.sh', qr/^trnl=/)) { 3532 # This seems to be necessary to avoid makedepend becoming confused, 3533 # and hanging on stdin. Seems that the code after 3534 # make shlist || ...here... is never run. 3535 edit_file('makedepend.SH', sub { 3536 my $code = shift; 3537 $code =~ s/^trnl='\$trnl'$/trnl='\\n'/m; 3538 return $code; 3539 }); 3540 } 3541} 3542 3543sub patch_C { 3544 # This is ordered by $major, as it's likely that different platforms may 3545 # well want to share code. 3546 3547 if ($major == 0) { 3548 apply_patch(<<'EOPATCH'); 3549diff --git a/proto.h b/proto.h 3550index 9ffc6bbabc..16da198342 100644 3551--- a/proto.h 3552+++ b/proto.h 3553@@ -8,6 +8,7 @@ 3554 #endif 3555 #ifdef OVERLOAD 3556 SV* amagic_call _((SV* left,SV* right,int method,int dir)); 3557+bool Gv_AMupdate _((HV* stash)); 3558 #endif /* OVERLOAD */ 3559 OP* append_elem _((I32 optype, OP* head, OP* tail)); 3560 OP* append_list _((I32 optype, LISTOP* first, LISTOP* last)); 3561EOPATCH 3562 } 3563 3564 if ($major == 2 && extract_from_file('perl.c', qr/^\tfclose\(e_fp\);$/)) { 3565 # need to patch perl.c to avoid calling fclose() twice on e_fp when 3566 # using -e 3567 # This diff is part of commit ab821d7fdc14a438. The second close was 3568 # introduced with perl-5.002, commit a5f75d667838e8e7 3569 # Might want a6c477ed8d4864e6 too, for the corresponding change to 3570 # pp_ctl.c (likely without this, eval will have "fun") 3571 apply_patch(<<'EOPATCH'); 3572diff --git a/perl.c b/perl.c 3573index 03c4d48..3c814a2 100644 3574--- a/perl.c 3575+++ b/perl.c 3576@@ -252,6 +252,7 @@ setuid perl scripts securely.\n"); 3577 #ifndef VMS /* VMS doesn't have environ array */ 3578 origenviron = environ; 3579 #endif 3580+ e_tmpname = Nullch; 3581 3582 if (do_undump) { 3583 3584@@ -405,6 +406,7 @@ setuid perl scripts securely.\n"); 3585 if (e_fp) { 3586 if (Fflush(e_fp) || ferror(e_fp) || fclose(e_fp)) 3587 croak("Can't write to temp file for -e: %s", Strerror(errno)); 3588+ e_fp = Nullfp; 3589 argc++,argv--; 3590 scriptname = e_tmpname; 3591 } 3592@@ -470,10 +472,10 @@ setuid perl scripts securely.\n"); 3593 curcop->cop_line = 0; 3594 curstash = defstash; 3595 preprocess = FALSE; 3596- if (e_fp) { 3597- fclose(e_fp); 3598- e_fp = Nullfp; 3599+ if (e_tmpname) { 3600 (void)UNLINK(e_tmpname); 3601+ Safefree(e_tmpname); 3602+ e_tmpname = Nullch; 3603 } 3604 3605 /* now that script is parsed, we can modify record separator */ 3606@@ -1369,7 +1371,7 @@ SV *sv; 3607 scriptname = xfound; 3608 } 3609 3610- origfilename = savepv(e_fp ? "-e" : scriptname); 3611+ origfilename = savepv(e_tmpname ? "-e" : scriptname); 3612 curcop->cop_filegv = gv_fetchfile(origfilename); 3613 if (strEQ(origfilename,"-")) 3614 scriptname = ""; 3615 3616EOPATCH 3617 } 3618 3619 if ($major < 3 && $^O eq 'openbsd' 3620 && !extract_from_file('pp_sys.c', qr/BSD_GETPGRP/)) { 3621 # Part of commit c3293030fd1b7489 3622 apply_patch(<<'EOPATCH'); 3623diff --git a/pp_sys.c b/pp_sys.c 3624index 4608a2a..f0c9d1d 100644 3625--- a/pp_sys.c 3626+++ b/pp_sys.c 3627@@ -2903,8 +2903,8 @@ PP(pp_getpgrp) 3628 pid = 0; 3629 else 3630 pid = SvIVx(POPs); 3631-#ifdef USE_BSDPGRP 3632- value = (I32)getpgrp(pid); 3633+#ifdef BSD_GETPGRP 3634+ value = (I32)BSD_GETPGRP(pid); 3635 #else 3636 if (pid != 0) 3637 DIE("POSIX getpgrp can't take an argument"); 3638@@ -2933,8 +2933,8 @@ PP(pp_setpgrp) 3639 } 3640 3641 TAINT_PROPER("setpgrp"); 3642-#ifdef USE_BSDPGRP 3643- SETi( setpgrp(pid, pgrp) >= 0 ); 3644+#ifdef BSD_SETPGRP 3645+ SETi( BSD_SETPGRP(pid, pgrp) >= 0 ); 3646 #else 3647 if ((pgrp != 0) || (pid != 0)) { 3648 DIE("POSIX setpgrp can't take an argument"); 3649EOPATCH 3650 } 3651 3652 # _(( was the macro wrapper for hiding ANSI prototypes from K&R C compilers: 3653 if ($major == 3 && !extract_from_file('proto.h', qr/\bsafemalloc\s+_\(\(/)) { 3654 # This is part of commit bbce6d69784bf43b: 3655 # [inseparable changes from patch from perl5.003_08 to perl5.003_09] 3656 # This only affects a few versions, but without this safemalloc etc get 3657 # an implicit return type (of int), and that is truncating addresses on 3658 # 64 bit systems. (And these days, seems that x86_64 linux has a memory 3659 # map which causes malloc to return addresses >= 2**32) 3660 apply_patch(<<'EOPATCH'); 3661diff --git a/proto.h b/proto.h 3662index 851567b340..e650c8b07d 100644 3663--- a/proto.h 3664+++ b/proto.h 3665@@ -479,6 +479,13 @@ Malloc_t realloc _((Malloc_t where, MEM_SIZE nbytes)); 3666 Free_t free _((Malloc_t where)); 3667 #endif 3668 3669+#ifndef MYMALLOC 3670+Malloc_t safemalloc _((MEM_SIZE nbytes)); 3671+Malloc_t safecalloc _((MEM_SIZE elements, MEM_SIZE size)); 3672+Malloc_t saferealloc _((Malloc_t where, MEM_SIZE nbytes)); 3673+Free_t safefree _((Malloc_t where)); 3674+#endif 3675+ 3676 #ifdef LEAKTEST 3677 Malloc_t safexmalloc _((I32 x, MEM_SIZE size)); 3678 Malloc_t safexcalloc _((I32 x, MEM_SIZE elements, MEM_SIZE size)); 3679EOPATCH 3680 } 3681 3682 if ($major < 4 && $^O eq 'openbsd') { 3683 my $bad; 3684 # Need changes from commit a6e633defa583ad5. 3685 # Commits c07a80fdfe3926b5 and f82b3d4130164d5f changed the same part 3686 # of perl.h 3687 3688 if (extract_from_file('perl.h', 3689 qr/^#ifdef HAS_GETPGRP2$/)) { 3690 $bad = <<'EOBAD'; 3691*************** 3692*** 57,71 **** 3693 #define TAINT_PROPER(s) if (tainting) taint_proper(no_security, s) 3694 #define TAINT_ENV() if (tainting) taint_env() 3695 3696! #ifdef HAS_GETPGRP2 3697! # ifndef HAS_GETPGRP 3698! # define HAS_GETPGRP 3699! # endif 3700! #endif 3701! 3702! #ifdef HAS_SETPGRP2 3703! # ifndef HAS_SETPGRP 3704! # define HAS_SETPGRP 3705! # endif 3706 #endif 3707 3708EOBAD 3709 } elsif (extract_from_file('perl.h', 3710 qr/Gack, you have one but not both of getpgrp2/)) { 3711 $bad = <<'EOBAD'; 3712*************** 3713*** 56,76 **** 3714 #define TAINT_PROPER(s) if (tainting) taint_proper(no_security, s) 3715 #define TAINT_ENV() if (tainting) taint_env() 3716 3717! #if defined(HAS_GETPGRP2) && defined(HAS_SETPGRP2) 3718! # define getpgrp getpgrp2 3719! # define setpgrp setpgrp2 3720! # ifndef HAS_GETPGRP 3721! # define HAS_GETPGRP 3722! # endif 3723! # ifndef HAS_SETPGRP 3724! # define HAS_SETPGRP 3725! # endif 3726! # ifndef USE_BSDPGRP 3727! # define USE_BSDPGRP 3728! # endif 3729! #else 3730! # if defined(HAS_GETPGRP2) || defined(HAS_SETPGRP2) 3731! #include "Gack, you have one but not both of getpgrp2() and setpgrp2()." 3732! # endif 3733 #endif 3734 3735EOBAD 3736 } elsif (extract_from_file('perl.h', 3737 qr/^#ifdef USE_BSDPGRP$/)) { 3738 $bad = <<'EOBAD' 3739*************** 3740*** 91,116 **** 3741 #define TAINT_PROPER(s) if (tainting) taint_proper(no_security, s) 3742 #define TAINT_ENV() if (tainting) taint_env() 3743 3744! #ifdef USE_BSDPGRP 3745! # ifdef HAS_GETPGRP 3746! # define BSD_GETPGRP(pid) getpgrp((pid)) 3747! # endif 3748! # ifdef HAS_SETPGRP 3749! # define BSD_SETPGRP(pid, pgrp) setpgrp((pid), (pgrp)) 3750! # endif 3751! #else 3752! # ifdef HAS_GETPGRP2 3753! # define BSD_GETPGRP(pid) getpgrp2((pid)) 3754! # ifndef HAS_GETPGRP 3755! # define HAS_GETPGRP 3756! # endif 3757! # endif 3758! # ifdef HAS_SETPGRP2 3759! # define BSD_SETPGRP(pid, pgrp) setpgrp2((pid), (pgrp)) 3760! # ifndef HAS_SETPGRP 3761! # define HAS_SETPGRP 3762! # endif 3763! # endif 3764 #endif 3765 3766 #ifndef _TYPES_ /* If types.h defines this it's easy. */ 3767EOBAD 3768 } 3769 if ($bad) { 3770 apply_patch(<<"EOPATCH"); 3771*** a/perl.h 2011-10-21 09:46:12.000000000 +0200 3772--- b/perl.h 2011-10-21 09:46:12.000000000 +0200 3773$bad--- 91,144 ---- 3774 #define TAINT_PROPER(s) if (tainting) taint_proper(no_security, s) 3775 #define TAINT_ENV() if (tainting) taint_env() 3776 3777! /* XXX All process group stuff is handled in pp_sys.c. Should these 3778! defines move there? If so, I could simplify this a lot. --AD 9/96. 3779! */ 3780! /* Process group stuff changed from traditional BSD to POSIX. 3781! perlfunc.pod documents the traditional BSD-style syntax, so we'll 3782! try to preserve that, if possible. 3783! */ 3784! #ifdef HAS_SETPGID 3785! # define BSD_SETPGRP(pid, pgrp) setpgid((pid), (pgrp)) 3786! #else 3787! # if defined(HAS_SETPGRP) && defined(USE_BSD_SETPGRP) 3788! # define BSD_SETPGRP(pid, pgrp) setpgrp((pid), (pgrp)) 3789! # else 3790! # ifdef HAS_SETPGRP2 /* DG/UX */ 3791! # define BSD_SETPGRP(pid, pgrp) setpgrp2((pid), (pgrp)) 3792! # endif 3793! # endif 3794! #endif 3795! #if defined(BSD_SETPGRP) && !defined(HAS_SETPGRP) 3796! # define HAS_SETPGRP /* Well, effectively it does . . . */ 3797! #endif 3798! 3799! /* getpgid isn't POSIX, but at least Solaris and Linux have it, and it makes 3800! our life easier :-) so we'll try it. 3801! */ 3802! #ifdef HAS_GETPGID 3803! # define BSD_GETPGRP(pid) getpgid((pid)) 3804! #else 3805! # if defined(HAS_GETPGRP) && defined(USE_BSD_GETPGRP) 3806! # define BSD_GETPGRP(pid) getpgrp((pid)) 3807! # else 3808! # ifdef HAS_GETPGRP2 /* DG/UX */ 3809! # define BSD_GETPGRP(pid) getpgrp2((pid)) 3810! # endif 3811! # endif 3812! #endif 3813! #if defined(BSD_GETPGRP) && !defined(HAS_GETPGRP) 3814! # define HAS_GETPGRP /* Well, effectively it does . . . */ 3815! #endif 3816! 3817! /* These are not exact synonyms, since setpgrp() and getpgrp() may 3818! have different behaviors, but perl.h used to define USE_BSDPGRP 3819! (prior to 5.003_05) so some extension might depend on it. 3820! */ 3821! #if defined(USE_BSD_SETPGRP) || defined(USE_BSD_GETPGRP) 3822! # ifndef USE_BSDPGRP 3823! # define USE_BSDPGRP 3824! # endif 3825 #endif 3826 3827 #ifndef _TYPES_ /* If types.h defines this it's easy. */ 3828EOPATCH 3829 } 3830 } 3831 3832 if ($major < 4 && $^O eq 'hpux' 3833 && extract_from_file('sv.c', qr/i = _filbuf\(/)) { 3834 apply_patch(<<'EOPATCH'); 3835diff --git a/sv.c b/sv.c 3836index a1f1d60..0a806f1 100644 3837--- a/sv.c 3838+++ b/sv.c 3839@@ -2641,7 +2641,7 @@ I32 append; 3840 3841 FILE_cnt(fp) = cnt; /* deregisterize cnt and ptr */ 3842 FILE_ptr(fp) = ptr; 3843- i = _filbuf(fp); /* get more characters */ 3844+ i = __filbuf(fp); /* get more characters */ 3845 cnt = FILE_cnt(fp); 3846 ptr = FILE_ptr(fp); /* reregisterize cnt and ptr */ 3847 3848 3849EOPATCH 3850 } 3851 3852 if ($major == 4 && extract_from_file('scope.c', qr/\(SV\*\)SSPOPINT/)) { 3853 # [PATCH] 5.004_04 +MAINT_TRIAL_1 broken when sizeof(int) != sizeof(void) 3854 # Fixes a bug introduced in 161b7d1635bc830b 3855 apply_commit('9002cb76ec83ef7f'); 3856 } 3857 3858 if ($major == 4 && extract_from_file('av.c', qr/AvARRAY\(av\) = 0;/)) { 3859 # Fixes a bug introduced in 1393e20655efb4bc 3860 apply_commit('e1c148c28bf3335b', 'av.c'); 3861 } 3862 3863 if ($major == 4) { 3864 my $rest = extract_from_file('perl.c', qr/delimcpy(.*)/); 3865 if (defined $rest and $rest !~ /,$/) { 3866 # delimcpy added in fc36a67e8855d031, perl.c refactored to use it. 3867 # bug introduced in 2a92aaa05aa1acbf, fixed in 8490252049bf42d3 3868 # code then moved to util.c in commit 491527d0220de34e 3869 apply_patch(<<'EOPATCH'); 3870diff --git a/perl.c b/perl.c 3871index 4eb69e3..54bbb00 100644 3872--- a/perl.c 3873+++ b/perl.c 3874@@ -1735,7 +1735,7 @@ SV *sv; 3875 if (len < sizeof tokenbuf) 3876 tokenbuf[len] = '\0'; 3877 #else /* ! (atarist || DOSISH) */ 3878- s = delimcpy(tokenbuf, tokenbuf + sizeof tokenbuf, s, bufend 3879+ s = delimcpy(tokenbuf, tokenbuf + sizeof tokenbuf, s, bufend, 3880 ':', 3881 &len); 3882 #endif /* ! (atarist || DOSISH) */ 3883EOPATCH 3884 } 3885 } 3886 3887 if ($major == 4 && $^O eq 'linux') { 3888 # Whilst this is fixed properly in f0784f6a4c3e45e1 which provides the 3889 # Configure probe, it's easier to back out the problematic changes made 3890 # in these previous commits. 3891 3892 # In maint-5.004, the simplest addition is to "correct" the file to 3893 # use the same pre-processor macros as blead had used. Whilst commit 3894 # 9b599b2a63d2324d (reverted below) is described as 3895 # [win32] merge change#887 from maintbranch 3896 # it uses __sun__ and __svr4__ instead of the __sun and __SVR4 of the 3897 # maint branch commit 6cdf74fe31f049dc 3898 3899 edit_file('doio.c', sub { 3900 my $code = shift; 3901 $code =~ s{defined\(__sun\) && defined\(__SVR4\)} 3902 {defined(__sun__) && defined(__svr4__)}g; 3903 return $code; 3904 }); 3905 3906 if (extract_from_file('doio.c', 3907 qr!^/\* XXX REALLY need metaconfig test \*/$!)) { 3908 revert_commit('4682965a1447ea44', 'doio.c'); 3909 } 3910 if (my $token = extract_from_file('doio.c', 3911 qr!^#if (defined\(__sun(?:__)?\)) && defined\(__svr4__\) /\* XXX Need metaconfig test \*/$!)) { 3912 my $patch = `git show -R 9b599b2a63d2324d doio.c`; 3913 $patch =~ s/defined\(__sun__\)/$token/g; 3914 apply_patch($patch); 3915 } 3916 if (extract_from_file('doio.c', 3917 qr!^/\* linux \(and Solaris2\?\) uses :$!)) { 3918 revert_commit('8490252049bf42d3', 'doio.c'); 3919 } 3920 if (extract_from_file('doio.c', 3921 qr/^ unsemds.buf = &semds;$/)) { 3922 revert_commit('8e591e46b4c6543e'); 3923 } 3924 if (extract_from_file('doio.c', 3925 qr!^#ifdef __linux__ /\* XXX Need metaconfig test \*/$!)) { 3926 # Reverts part of commit 3e3baf6d63945cb6 3927 apply_patch(<<'EOPATCH'); 3928diff --git b/doio.c a/doio.c 3929index 62b7de9..0d57425 100644 3930--- b/doio.c 3931+++ a/doio.c 3932@@ -1333,9 +1331,6 @@ SV **sp; 3933 char *a; 3934 I32 id, n, cmd, infosize, getinfo; 3935 I32 ret = -1; 3936-#ifdef __linux__ /* XXX Need metaconfig test */ 3937- union semun unsemds; 3938-#endif 3939 3940 id = SvIVx(*++mark); 3941 n = (optype == OP_SEMCTL) ? SvIVx(*++mark) : 0; 3942@@ -1364,29 +1359,11 @@ SV **sp; 3943 infosize = sizeof(struct semid_ds); 3944 else if (cmd == GETALL || cmd == SETALL) 3945 { 3946-#ifdef __linux__ /* XXX Need metaconfig test */ 3947-/* linux uses : 3948- int semctl (int semid, int semnun, int cmd, union semun arg) 3949- 3950- union semun { 3951- int val; 3952- struct semid_ds *buf; 3953- ushort *array; 3954- }; 3955-*/ 3956- union semun semds; 3957- if (semctl(id, 0, IPC_STAT, semds) == -1) 3958-#else 3959 struct semid_ds semds; 3960 if (semctl(id, 0, IPC_STAT, &semds) == -1) 3961-#endif 3962 return -1; 3963 getinfo = (cmd == GETALL); 3964-#ifdef __linux__ /* XXX Need metaconfig test */ 3965- infosize = semds.buf->sem_nsems * sizeof(short); 3966-#else 3967 infosize = semds.sem_nsems * sizeof(short); 3968-#endif 3969 /* "short" is technically wrong but much more portable 3970 than guessing about u_?short(_t)? */ 3971 } 3972@@ -1429,12 +1406,7 @@ SV **sp; 3973 #endif 3974 #ifdef HAS_SEM 3975 case OP_SEMCTL: 3976-#ifdef __linux__ /* XXX Need metaconfig test */ 3977- unsemds.buf = (struct semid_ds *)a; 3978- ret = semctl(id, n, cmd, unsemds); 3979-#else 3980 ret = semctl(id, n, cmd, (struct semid_ds *)a); 3981-#endif 3982 break; 3983 #endif 3984 #ifdef HAS_SHM 3985EOPATCH 3986 } 3987 # Incorrect prototype added as part of 8ac853655d9b7447, fixed as part 3988 # of commit dc45a647708b6c54, with at least one intermediate 3989 # modification. Correct prototype for gethostbyaddr has socklen_t 3990 # second. Linux has uint32_t first for getnetbyaddr. 3991 # Easiest just to remove, instead of attempting more complex patching. 3992 # Something similar may be needed on other platforms. 3993 edit_file('pp_sys.c', sub { 3994 my $code = shift; 3995 $code =~ s/^ struct hostent \*(?:PerlSock_)?gethostbyaddr\([^)]+\);$//m; 3996 $code =~ s/^ struct netent \*getnetbyaddr\([^)]+\);$//m; 3997 return $code; 3998 }); 3999 } 4000 4001 if ($major < 5 && $^O eq 'aix' 4002 && !extract_from_file('pp_sys.c', 4003 qr/defined\(HOST_NOT_FOUND\) && !defined\(h_errno\)/)) { 4004 # part of commit dc45a647708b6c54 4005 # Andy Dougherty's configuration patches (Config_63-01 up to 04). 4006 apply_patch(<<'EOPATCH') 4007diff --git a/pp_sys.c b/pp_sys.c 4008index c2fcb6f..efa39fb 100644 4009--- a/pp_sys.c 4010+++ b/pp_sys.c 4011@@ -54,7 +54,7 @@ extern "C" int syscall(unsigned long,...); 4012 #endif 4013 #endif 4014 4015-#ifdef HOST_NOT_FOUND 4016+#if defined(HOST_NOT_FOUND) && !defined(h_errno) 4017 extern int h_errno; 4018 #endif 4019 4020EOPATCH 4021 } 4022 4023 if ($major == 5 4024 && `git rev-parse HEAD` eq "22c35a8c2392967a5ba6b5370695be464bd7012c\n") { 4025 # Commit 22c35a8c2392967a is significant, 4026 # "phase 1 of somewhat major rearrangement of PERL_OBJECT stuff" 4027 # but doesn't build due to 2 simple errors. blead in this broken state 4028 # was merged to the cfgperl branch, and then these were immediately 4029 # corrected there. cfgperl (with the fixes) was merged back to blead. 4030 # The resultant rather twisty maze of commits looks like this: 4031 4032=begin comment 4033 4034* | | commit 137225782c183172f360c827424b9b9f8adbef0e 4035|\ \ \ Merge: 22c35a8 2a8ee23 4036| |/ / Author: Gurusamy Sarathy <gsar@cpan.org> 4037| | | Date: Fri Oct 30 17:38:36 1998 +0000 4038| | | 4039| | | integrate cfgperl tweaks into mainline 4040| | | 4041| | | p4raw-id: //depot/perl@2144 4042| | | 4043| * | commit 2a8ee23279873759693fa83eca279355db2b665c 4044| | | Author: Jarkko Hietaniemi <jhi@iki.fi> 4045| | | Date: Fri Oct 30 13:27:39 1998 +0000 4046| | | 4047| | | There can be multiple yacc/bison errors. 4048| | | 4049| | | p4raw-id: //depot/cfgperl@2143 4050| | | 4051| * | commit 93fb2ac393172fc3e2c14edb20b718309198abbc 4052| | | Author: Jarkko Hietaniemi <jhi@iki.fi> 4053| | | Date: Fri Oct 30 13:18:43 1998 +0000 4054| | | 4055| | | README.posix-bc update. 4056| | | 4057| | | p4raw-id: //depot/cfgperl@2142 4058| | | 4059| * | commit 4ec43091e8e6657cb260b5e563df30aaa154effe 4060| | | Author: Jarkko Hietaniemi <jhi@iki.fi> 4061| | | Date: Fri Oct 30 09:12:59 1998 +0000 4062| | | 4063| | | #2133 fallout. 4064| | | 4065| | | p4raw-id: //depot/cfgperl@2141 4066| | | 4067| * | commit 134ca994cfefe0f613d43505a885e4fc2100b05c 4068| |\ \ Merge: 7093112 22c35a8 4069| |/ / Author: Jarkko Hietaniemi <jhi@iki.fi> 4070|/| | Date: Fri Oct 30 08:43:18 1998 +0000 4071| | | 4072| | | Integrate from mainperl. 4073| | | 4074| | | p4raw-id: //depot/cfgperl@2140 4075| | | 4076* | | commit 22c35a8c2392967a5ba6b5370695be464bd7012c 4077| | | Author: Gurusamy Sarathy <gsar@cpan.org> 4078| | | Date: Fri Oct 30 02:51:39 1998 +0000 4079| | | 4080| | | phase 1 of somewhat major rearrangement of PERL_OBJECT stuff 4081| | | (objpp.h is gone, embed.pl now does some of that); objXSUB.h 4082| | | should soon be automated also; the global variables that 4083| | | escaped the PL_foo conversion are now reined in; renamed 4084| | | MAGIC in regcomp.h to REG_MAGIC to avoid collision with the 4085| | | type of same name; duplicated lists of pp_things in various 4086| | | places is now gone; result has only been tested on win32 4087| | | 4088| | | p4raw-id: //depot/perl@2133 4089 4090=end comment 4091 4092=cut 4093 4094 # and completely confuses git bisect (and at least me), causing it to 4095 # the bisect run to confidently return the wrong answer, an unrelated 4096 # commit on the cfgperl branch. 4097 4098 apply_commit('4ec43091e8e6657c'); 4099 } 4100 4101 if ($major == 5 4102 && extract_from_file('pp_sys.c', qr/PERL_EFF_ACCESS_R_OK/) 4103 && !extract_from_file('pp_sys.c', qr/XXX Configure test needed for eaccess/)) { 4104 # Between 5ff3f7a4e03a6b10 and c955f1177b2e311d^ 4105 # This is the meat of commit c955f1177b2e311d (without the other 4106 # indenting changes that would cause a conflict). 4107 # Without this 538 revisions won't build on (at least) Linux 4108 apply_patch(<<'EOPATCH'); 4109diff --git a/pp_sys.c b/pp_sys.c 4110index d60c8dc..867dee4 100644 4111--- a/pp_sys.c 4112+++ b/pp_sys.c 4113@@ -198,9 +198,18 @@ static char zero_but_true[ZBTLEN + 1] = "0 but true"; 4114 # if defined(I_SYS_SECURITY) 4115 # include <sys/security.h> 4116 # endif 4117-# define PERL_EFF_ACCESS_R_OK(p) (eaccess((p), R_OK, ACC_SELF)) 4118-# define PERL_EFF_ACCESS_W_OK(p) (eaccess((p), W_OK, ACC_SELF)) 4119-# define PERL_EFF_ACCESS_X_OK(p) (eaccess((p), X_OK, ACC_SELF)) 4120+ /* XXX Configure test needed for eaccess */ 4121+# ifdef ACC_SELF 4122+ /* HP SecureWare */ 4123+# define PERL_EFF_ACCESS_R_OK(p) (eaccess((p), R_OK, ACC_SELF)) 4124+# define PERL_EFF_ACCESS_W_OK(p) (eaccess((p), W_OK, ACC_SELF)) 4125+# define PERL_EFF_ACCESS_X_OK(p) (eaccess((p), X_OK, ACC_SELF)) 4126+# else 4127+ /* SCO */ 4128+# define PERL_EFF_ACCESS_R_OK(p) (eaccess((p), R_OK)) 4129+# define PERL_EFF_ACCESS_W_OK(p) (eaccess((p), W_OK)) 4130+# define PERL_EFF_ACCESS_X_OK(p) (eaccess((p), X_OK)) 4131+# endif 4132 #endif 4133 4134 #if !defined(PERL_EFF_ACCESS_R_OK) && defined(HAS_ACCESSX) && defined(ACC_SELF) 4135EOPATCH 4136 } 4137 4138 if ($major == 5 4139 && extract_from_file('mg.c', qr/If we're still on top of the stack, pop us off/) 4140 && !extract_from_file('mg.c', qr/PL_savestack_ix -= popval/)) { 4141 # Fix up commit 455ece5e082708b1: 4142 # SSNEW() API for allocating memory on the savestack 4143 # Message-Id: <tqemtae338.fsf@puma.genscan.com> 4144 # Subject: [PATCH 5.005_51] (was: why SAVEDESTRUCTOR()...) 4145 apply_commit('3c8a44569607336e', 'mg.c'); 4146 } 4147 4148 if ($major == 5) { 4149 if (extract_from_file('doop.c', qr/croak\(no_modify\);/) 4150 && extract_from_file('doop.c', qr/croak\(PL_no_modify\);/)) { 4151 # Whilst the log suggests that this would only fix 5 commits, in 4152 # practice this area of history is a complete tarpit, and git bisect 4153 # gets very confused by the skips in the middle of the back and 4154 # forth merging between //depot/perl and //depot/cfgperl 4155 apply_commit('6393042b638dafd3'); 4156 } 4157 4158 # One error "fixed" with another: 4159 if (extract_from_file('pp_ctl.c', 4160 qr/\Qstatic void *docatch_body _((void *o));\E/)) { 4161 apply_commit('5b51e982882955fe'); 4162 } 4163 # Which is then fixed by this: 4164 if (extract_from_file('pp_ctl.c', 4165 qr/\Qstatic void *docatch_body _((valist\E/)) { 4166 apply_commit('47aa779ee4c1a50e'); 4167 } 4168 4169 if (extract_from_file('thrdvar.h', qr/PERLVARI\(Tprotect/) 4170 && !extract_from_file('embedvar.h', qr/PL_protect/)) { 4171 # Commit 312caa8e97f1c7ee didn't update embedvar.h 4172 apply_commit('e0284a306d2de082', 'embedvar.h'); 4173 } 4174 } 4175 4176 if ($major == 5 4177 && extract_from_file('sv.c', 4178 qr/PerlDir_close\(IoDIRP\((?:\(IO\*\))?sv\)\);/) 4179 && !(extract_from_file('toke.c', 4180 qr/\QIoDIRP(FILTER_DATA(AvFILLp(PL_rsfp_filters))) = NULL\E/) 4181 || extract_from_file('toke.c', 4182 qr/\QIoDIRP(datasv) = (DIR*)NULL;\E/))) { 4183 # Commit 93578b34124e8a3b, //depot/perl@3298 4184 # close directory handles properly when localized, 4185 # tweaked slightly by commit 1236053a2c722e2b, 4186 # add test case for change#3298 4187 # 4188 # The fix is the last part of: 4189 # 4190 # various fixes for clean build and test on win32; configpm broken, 4191 # needed to open myconfig.SH rather than myconfig; sundry adjustments 4192 # to bytecode stuff; tweaks to DYNAMIC_ENV_FETCH code to make it 4193 # work under win32; getenv_sv() changed to getenv_len() since SVs 4194 # aren't visible in the lower echelons; remove bogus exports from 4195 # config.sym; PERL_OBJECT-ness for C++ exception support; null out 4196 # IoDIRP in filter_del() or sv_free() will attempt to close it 4197 # 4198 # The changed code is modified subsequently by commit e0c198038146b7a4 4199 apply_commit('a6c403648ecd5cc7', 'toke.c'); 4200 } 4201 4202 if ($major < 6 && $^O eq 'netbsd' 4203 && !extract_from_file('unixish.h', 4204 qr/defined\(NSIG\).*defined\(__NetBSD__\)/)) { 4205 apply_patch(<<'EOPATCH') 4206diff --git a/unixish.h b/unixish.h 4207index 2a6cbcd..eab2de1 100644 4208--- a/unixish.h 4209+++ b/unixish.h 4210@@ -89,7 +89,7 @@ 4211 */ 4212 /* #define ALTERNATE_SHEBANG "#!" / **/ 4213 4214-#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) 4215+#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) || defined(__NetBSD__) 4216 # include <signal.h> 4217 #endif 4218 4219EOPATCH 4220 } 4221 4222 if ($major < 6 && extract_from_file('perl.h', qr/PL_uuemap\[\]/)) { 4223 # That [] needs to be [65]: 4224 apply_commit('7575fa06ca7baf15'); 4225 } 4226 4227 if ($major < 6 && $^O eq 'darwin' 4228 && !extract_from_file('perl.h', qr/ifdef I_FCNTL/)) { 4229 # This is part of commit 9a34ef1dede5fef4, but in a stable part of the 4230 # file: 4231 apply_patch(<<'EOPATCH') 4232diff --git a/perl.h b/perl.h 4233index 0d3f0b8333..19f6684894 100644 4234--- a/perl.h 4235+++ b/perl.h 4236@@ -310,6 +310,14 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); 4237 # define BYTEORDER 0x1234 4238 #endif 4239 4240+#ifdef I_FCNTL 4241+# include <fcntl.h> 4242+#endif 4243+ 4244+#ifdef I_SYS_FILE 4245+# include <sys/file.h> 4246+#endif 4247+ 4248 /* Overall memory policy? */ 4249 #ifndef CONSERVATIVE 4250 # define LIBERAL 1 4251EOPATCH 4252 } 4253 4254 if ($major == 7 && $^O eq 'aix' && -f 'ext/List/Util/Util.xs' 4255 && extract_from_file('ext/List/Util/Util.xs', qr/PUSHBLOCK/) 4256 && !extract_from_file('makedef.pl', qr/^Perl_cxinc/)) { 4257 # Need this to get List::Utils 1.03 and later to compile. 4258 # 1.03 also expects to call Perl_pp_rand. Commit d3632a54487acc5f 4259 # fixes this (for the unthreaded case), but it's not until 1.05, 4260 # two days later, that this is fixed properly. 4261 apply_commit('cbb96eed3f175499'); 4262 } 4263 4264 if (($major >= 7 || $major <= 9) && $^O eq 'openbsd' 4265 && `uname -m` eq "sparc64\n" 4266 # added in 2000 by commit cb434fcc98ac25f5: 4267 && extract_from_file('regexec.c', 4268 qr!/\* No need to save/restore up to this paren \*/!) 4269 # re-indented in 2006 by commit 95b2444054382532: 4270 && extract_from_file('regexec.c', qr/^\t\tCURCUR cc;$/)) { 4271 # Need to work around a bug in (at least) OpenBSD's 4.6's sparc64 # 4272 # compiler ["gcc (GCC) 3.3.5 (propolice)"]. Between commits 4273 # 3ec562b0bffb8b8b (2002) and 1a4fad37125bac3e^ (2005) the darling thing 4274 # fails to compile any code for the statement cc.oldcc = PL_regcc; 4275 # 4276 # If you refactor the code to "fix" that, or force the issue using set 4277 # in the debugger, the stack smashing detection code fires on return 4278 # from S_regmatch(). Turns out that the compiler doesn't allocate any 4279 # (or at least enough) space for cc. 4280 # 4281 # Restore the "uninitialised" value for cc before function exit, and the 4282 # stack smashing code is placated. "Fix" 3ec562b0bffb8b8b (which 4283 # changes the size of auto variables used elsewhere in S_regmatch), and 4284 # the crash is visible back to bc517b45fdfb539b (which also changes 4285 # buffer sizes). "Unfix" 1a4fad37125bac3e and the crash is visible until 4286 # 5b47454deb66294b. Problem goes away if you compile with -O, or hack 4287 # the code as below. 4288 # 4289 # Hence this turns out to be a bug in (old) gcc. Not a security bug we 4290 # still need to fix. 4291 apply_patch(<<'EOPATCH'); 4292diff --git a/regexec.c b/regexec.c 4293index 900b491..6251a0b 100644 4294--- a/regexec.c 4295+++ b/regexec.c 4296@@ -2958,7 +2958,11 @@ S_regmatch(pTHX_ regnode *prog) 4297 I,I 4298 *******************************************************************/ 4299 case CURLYX: { 4300- CURCUR cc; 4301+ union { 4302+ CURCUR hack_cc; 4303+ char hack_buff[sizeof(CURCUR) + 1]; 4304+ } hack; 4305+#define cc hack.hack_cc 4306 CHECKPOINT cp = PL_savestack_ix; 4307 /* No need to save/restore up to this paren */ 4308 I32 parenfloor = scan->flags; 4309@@ -2983,6 +2987,7 @@ S_regmatch(pTHX_ regnode *prog) 4310 n = regmatch(PREVOPER(next)); /* start on the WHILEM */ 4311 regcpblow(cp); 4312 PL_regcc = cc.oldcc; 4313+#undef cc 4314 saySAME(n); 4315 } 4316 /* NOT REACHED */ 4317EOPATCH 4318} 4319 4320 if ($major < 8 && !extract_from_file('perl.h', qr/\bshort htovs\b/)) { 4321 # This is part of commit c623ac675720b314 4322 apply_patch(<<'EOPATCH'); 4323diff --git a/perl.h b/perl.h 4324index 023b90b7ea..59a21faecd 100644 4325--- a/perl.h 4326+++ b/perl.h 4327@@ -2279,4 +2279,8 @@ struct ptr_tbl { 4328 # endif 4329 /* otherwise default to functions in util.c */ 4330+short htovs(short n); 4331+short vtohs(short n); 4332+long htovl(long n); 4333+long vtohl(long n); 4334 #endif 4335 4336EOPATCH 4337 } 4338 4339 if ($major < 8 && !extract_from_file('perl.h', qr/include <unistd\.h>/)) { 4340 # This is part of commit 3f270f98f9305540, applied at a slightly 4341 # different location in perl.h, where the context is stable back to 4342 # 5.000 4343 apply_patch(<<'EOPATCH'); 4344diff --git a/perl.h b/perl.h 4345index 9418b52..b8b1a7c 100644 4346--- a/perl.h 4347+++ b/perl.h 4348@@ -496,6 +496,10 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); 4349 # include <sys/param.h> 4350 #endif 4351 4352+/* If this causes problems, set i_unistd=undef in the hint file. */ 4353+#ifdef I_UNISTD 4354+# include <unistd.h> 4355+#endif 4356 4357 /* Use all the "standard" definitions? */ 4358 #if defined(STANDARD_C) && defined(I_STDLIB) 4359EOPATCH 4360 } 4361 4362 if ($major < 10) { 4363 # This is commit 731e259481f36b35, but adapted to remove all the 4364 # variations of guards around the inclusion of <signal.h> 4365 # Whilst we only hit this as a problem on arm64 macOS (so far), because 4366 # it insists on prototypes for everything, I'm assuming that doing this 4367 # everywhere and unconditionally might solve similar problems on other 4368 # platforms. Certainly, it *ought* to be safe to include a C89 header 4369 # these days. 4370 for my $file (qw(doop.c mg.c mpeix/mpeixish.h plan9/plan9ish.h unixish.h util.c)) { 4371 next 4372 unless -f $file; 4373 edit_file($file, sub { 4374 my $code = shift; 4375 $code =~ s{ 4376 \n 4377 \#if \s+ [^\n]+ 4378 \n 4379 \# \s* include \s+ <signal\.h> 4380 \n 4381 \#endif 4382 \n 4383 } 4384 {\n#include <signal.h>\n}x; 4385 return $code; 4386 }); 4387 } 4388 } 4389 4390 if ($major == 15) { 4391 # This affects a small range of commits around July 2011, but build 4392 # failures here get in the way of bisecting other problems: 4393 4394 my $line = extract_from_file('embed.fnc', qr/^X?pR\t\|I32\t\|was_lvalue_sub$/); 4395 if ($line) { 4396 # Need to export Perl_was_lvalue_sub: 4397 apply_commit('7b70e8177801df4e') 4398 unless $line =~ /X/; 4399 4400 # It needs to be 'ApR' not 'XpR', to be visible to List::Util 4401 # (arm64 macOS treats the missing prototypes as errors) 4402 apply_commit('c73b0699db4d0b8b'); 4403 } 4404 } 4405} 4406 4407sub patch_ext { 4408 if (-f 'ext/POSIX/Makefile.PL' 4409 && extract_from_file('ext/POSIX/Makefile.PL', 4410 qr/Explicitly avoid including/)) { 4411 # commit 6695a346c41138df, which effectively reverts 170888cff5e2ffb7 4412 4413 # PERL5LIB is populated by make_ext.pl with paths to the modules we need 4414 # to run, don't override this with "../../lib" since that may not have 4415 # been populated yet in a parallel build. 4416 apply_commit('6695a346c41138df'); 4417 } 4418 4419 if (-f 'ext/Hash/Util/Makefile.PL' 4420 && extract_from_file('ext/Hash/Util/Makefile.PL', 4421 qr/\bDIR\b.*'FieldHash'/)) { 4422 # ext/Hash/Util/Makefile.PL should not recurse to FieldHash's Makefile.PL 4423 # *nix, VMS and Win32 all know how to (and have to) call the latter directly. 4424 # As is, targets in ext/Hash/Util/FieldHash get called twice, which may result 4425 # in race conditions, and certainly messes up make clean; make distclean; 4426 apply_commit('550428fe486b1888'); 4427 } 4428 4429 if ($major < 8 && $^O eq 'darwin' && !-f 'ext/DynaLoader/dl_dyld.xs') { 4430 checkout_file('ext/DynaLoader/dl_dyld.xs', 'f556e5b971932902'); 4431 apply_patch(<<'EOPATCH'); 4432diff -u a/ext/DynaLoader/dl_dyld.xs~ a/ext/DynaLoader/dl_dyld.xs 4433--- a/ext/DynaLoader/dl_dyld.xs 2011-10-11 21:41:27.000000000 +0100 4434+++ b/ext/DynaLoader/dl_dyld.xs 2011-10-11 21:42:20.000000000 +0100 4435@@ -41,6 +41,35 @@ 4436 #include "perl.h" 4437 #include "XSUB.h" 4438 4439+#ifndef pTHX 4440+# define pTHX void 4441+# define pTHX_ 4442+#endif 4443+#ifndef aTHX 4444+# define aTHX 4445+# define aTHX_ 4446+#endif 4447+#ifndef dTHX 4448+# define dTHXa(a) extern int Perl___notused(void) 4449+# define dTHX extern int Perl___notused(void) 4450+#endif 4451+ 4452+#ifndef Perl_form_nocontext 4453+# define Perl_form_nocontext form 4454+#endif 4455+ 4456+#ifndef Perl_warn_nocontext 4457+# define Perl_warn_nocontext warn 4458+#endif 4459+ 4460+#ifndef PTR2IV 4461+# define PTR2IV(p) (IV)(p) 4462+#endif 4463+ 4464+#ifndef get_av 4465+# define get_av perl_get_av 4466+#endif 4467+ 4468 #define DL_LOADONCEONLY 4469 4470 #include "dlutils.c" /* SaveError() etc */ 4471@@ -104,7 +145,7 @@ 4472 dl_last_error = savepv(error); 4473 } 4474 4475-static char *dlopen(char *path, int mode /* mode is ignored */) 4476+static char *dlopen(char *path) 4477 { 4478 int dyld_result; 4479 NSObjectFileImage ofile; 4480@@ -161,13 +202,11 @@ 4481 dl_load_file(filename, flags=0) 4482 char * filename 4483 int flags 4484- PREINIT: 4485- int mode = 1; 4486 CODE: 4487 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags)); 4488 if (flags & 0x01) 4489- Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename); 4490- RETVAL = dlopen(filename, mode) ; 4491+ Perl_warn_nocontext("Can't make loaded symbols global on this platform while loading %s",filename); 4492+ RETVAL = dlopen(filename); 4493 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", RETVAL)); 4494 ST(0) = sv_newmortal() ; 4495 if (RETVAL == NULL) 4496EOPATCH 4497 if ($major < 4 && !extract_from_file('util.c', qr/^form/m)) { 4498 apply_patch(<<'EOPATCH'); 4499diff -u a/ext/DynaLoader/dl_dyld.xs~ a/ext/DynaLoader/dl_dyld.xs 4500--- a/ext/DynaLoader/dl_dyld.xs 2011-10-11 21:56:25.000000000 +0100 4501+++ b/ext/DynaLoader/dl_dyld.xs 2011-10-11 22:00:00.000000000 +0100 4502@@ -60,6 +60,18 @@ 4503 # define get_av perl_get_av 4504 #endif 4505 4506+static char * 4507+form(char *pat, ...) 4508+{ 4509+ char *retval; 4510+ va_list args; 4511+ va_start(args, pat); 4512+ vasprintf(&retval, pat, &args); 4513+ va_end(args); 4514+ SAVEFREEPV(retval); 4515+ return retval; 4516+} 4517+ 4518 #define DL_LOADONCEONLY 4519 4520 #include "dlutils.c" /* SaveError() etc */ 4521EOPATCH 4522 } 4523 } 4524 4525 if ($major < 10) { 4526 if ($unfixable_db_file) { 4527 # Nothing we can do. 4528 } else { 4529 if (!extract_from_file('ext/DB_File/DB_File.xs', 4530 qr/^#ifdef AT_LEAST_DB_4_1$/)) { 4531 # This line is changed by commit 3245f0580c13b3ab 4532 my $line = extract_from_file('ext/DB_File/DB_File.xs', 4533 qr/^( status = \(?RETVAL->dbp->open\)?\(RETVAL->dbp, name, NULL, RETVAL->type, $)/); 4534 apply_patch(<<"EOPATCH"); 4535diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs 4536index 489ba96..fba8ded 100644 4537--- a/ext/DB_File/DB_File.xs 4538+++ b/ext/DB_File/DB_File.xs 4539\@\@ -183,4 +187,8 \@\@ 4540 #endif 4541 4542+#if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 1) 4543+# define AT_LEAST_DB_4_1 4544+#endif 4545+ 4546 /* map version 2 features & constants onto their version 1 equivalent */ 4547 4548\@\@ -1334,7 +1419,12 \@\@ SV * sv ; 4549 #endif 4550 4551+#ifdef AT_LEAST_DB_4_1 4552+ status = (RETVAL->dbp->open)(RETVAL->dbp, NULL, name, NULL, RETVAL->type, 4553+ Flags, mode) ; 4554+#else 4555 $line 4556 Flags, mode) ; 4557+#endif 4558 /* printf("open returned %d %s\\n", status, db_strerror(status)) ; */ 4559 4560EOPATCH 4561 } 4562 4563 if (!extract_from_file('ext/DB_File/DB_File.xs', 4564 qr/\bextern void __getBerkeleyDBInfo\b/)) { 4565 # A prototype for __getBerkeleyDBInfo(); 4566 apply_commit('b92372bcedd4cbc4'); 4567 } 4568 } 4569 } 4570 4571 if ($major < 10 and -f 'ext/IPC/SysV/SysV.xs') { 4572 edit_file('ext/IPC/SysV/SysV.xs', sub { 4573 my $xs = shift; 4574 my $fixed = <<'EOFIX'; 4575 4576#include <sys/types.h> 4577#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) 4578#ifndef HAS_SEM 4579# include <sys/ipc.h> 4580#endif 4581# ifdef HAS_MSG 4582# include <sys/msg.h> 4583# endif 4584# ifdef HAS_SHM 4585# if defined(PERL_SCO) || defined(PERL_ISC) 4586# include <sys/sysmacros.h> /* SHMLBA */ 4587# endif 4588# include <sys/shm.h> 4589# ifndef HAS_SHMAT_PROTOTYPE 4590 extern Shmat_t shmat (int, char *, int); 4591# endif 4592# if defined(HAS_SYSCONF) && defined(_SC_PAGESIZE) 4593# undef SHMLBA /* not static: determined at boot time */ 4594# define SHMLBA sysconf(_SC_PAGESIZE) 4595# elif defined(HAS_GETPAGESIZE) 4596# undef SHMLBA /* not static: determined at boot time */ 4597# define SHMLBA getpagesize() 4598# endif 4599# endif 4600#endif 4601EOFIX 4602 $xs =~ s! 4603#include <sys/types\.h> 4604.* 4605(#ifdef newCONSTSUB|/\* Required)!$fixed$1!ms; 4606 return $xs; 4607 }); 4608 } 4609 4610 if ($major < 10 and -f 'ext/Digest/MD5/MD5.xs') { 4611 require Digest::MD5; 4612 my ($was, $now); 4613 # The edit to the XS is commit 9ee8e69ab2318ba3, but the testcase fixup 4614 # needs to work for several earlier commits. 4615 edit_file('ext/Digest/MD5/MD5.xs', sub { 4616 my $xs = shift; 4617 $was = Digest::MD5::md5_hex($xs); 4618 $xs =~ s{\Q#if PATCHLEVEL <= 4 && !defined(PL_dowarn)} 4619 {#if PERL_VERSION <= 4 && !defined(PL_dowarn)}; 4620 $now = Digest::MD5::md5_hex($xs); 4621 return $xs; 4622 }); 4623 4624 edit_file('ext/Digest/MD5/t/files.t', sub { 4625 my $testcase = shift; 4626 $testcase =~ s/$was/$now/g; 4627 return $testcase; 4628 }) 4629 if $was ne $now; 4630 } 4631 4632 if ($major >= 10 && $major < 20 4633 && !extract_from_file('ext/SDBM_File/Makefile.PL', qr/MY::subdir_x/)) { 4634 # Parallel make fix for SDBM_File 4635 # Technically this is needed for pre v5.10.0, but we don't attempt 4636 # parallel makes on earlier versions because it's unreliable due to 4637 # other bugs. 4638 # So far, only AIX make has come acropper on this bug. 4639 apply_commit('4d106cc5d8fd328d', 'ext/SDBM_File/Makefile.PL'); 4640 } 4641 4642 if (-f 'ext/Errno/Errno_pm.PL') { 4643 if ($major < 22 && !extract_from_file('ext/Errno/Errno_pm.PL', 4644 qr/RT#123784/)) { 4645 my $gcc_major = extract_from_file('config.sh', 4646 qr/^gccversion='([0-9]+)\./, 4647 0); 4648 if ($gcc_major >= 5) { 4649 # This is the fix of commit 816b056ffb99ae54, but implemented in 4650 # a way that should work back to the earliest versions of Errno: 4651 edit_file('ext/Errno/Errno_pm.PL', sub { 4652 my $code = shift; 4653 $code =~ s/( \$Config\{cppflags\})/$1 -P/g; 4654 return $code; 4655 }); 4656 } 4657 } 4658 if ($major < 8 && !extract_from_file('ext/Errno/Errno_pm.PL', 4659 qr/With the -dM option, gcc/)) { 4660 # This is the fix of commit 9ae2e8df64ee1443 re-ordered slightly so 4661 # that it should work back to the earliest versions of Errno: 4662 apply_patch(<<'EOPATCH'); 4663diff --git a/ext/Errno/Errno_pm.PL b/ext/Errno/Errno_pm.PL 4664index b669790314..c00d6c1a86 100644 4665--- a/ext/Errno/Errno_pm.PL 4666+++ b/ext/Errno/Errno_pm.PL 4667@@ -30,6 +30,12 @@ sub process_file { 4668 warn "Cannot open '$file'"; 4669 return; 4670 } 4671+ } elsif ($Config{gccversion} ne '') { 4672+ # With the -dM option, gcc outputs every #define it finds 4673+ unless(open(FH,"$Config{cc} -E -dM $file |")) { 4674+ warn "Cannot open '$file'"; 4675+ return; 4676+ } 4677 } else { 4678 unless(open(FH,"< $file")) { 4679 warn "Cannot open '$file'"; 4680@@ -45,8 +51,12 @@ sub process_file { 4681 4682 sub get_files { 4683 my %file = (); 4684- # VMS keeps its include files in system libraries (well, except for Gcc) 4685- if ($^O eq 'VMS') { 4686+ if ($^O eq 'linux') { 4687+ # Some Linuxes have weird errno.hs which generate 4688+ # no #file or #line directives 4689+ $file{'/usr/include/errno.h'} = 1; 4690+ } elsif ($^O eq 'VMS') { 4691+ # VMS keeps its include files in system libraries (well, except for Gcc) 4692 if ($Config{vms_cc_type} eq 'decc') { 4693 $file{'Sys$Library:DECC$RTLDEF.TLB'} = 1; 4694 } elsif ($Config{vms_cc_type} eq 'vaxc') { 4695EOPATCH 4696 } 4697 } 4698} 4699 4700sub patch_t { 4701 if ($^O eq 'darwin') { 4702 # This has # $x = `$^X -le "print 'hi there'"`; 4703 # and it needs to pass for the automated validation self-test: 4704 edit_file('t/base/term.t', sub { 4705 my $code = shift; 4706 $code =~ s/`(\$\^X )/`$aggressive_apple_security$1/; 4707 return $code; 4708 }); 4709 } 4710} 4711 4712sub apply_fixups { 4713 my $fixups = shift; 4714 return unless $fixups; 4715 foreach my $file (@$fixups) { 4716 my $fh = open_or_die($file); 4717 my $line = <$fh>; 4718 close_or_die($fh); 4719 if ($line =~ /^#!perl\b/) { 4720 system $^X, $file 4721 and die_255("$^X $file failed: \$!=$!, \$?=$?"); 4722 } elsif ($line =~ /^#!(\/\S+)/) { 4723 system $file 4724 and die_255("$file failed: \$!=$!, \$?=$?"); 4725 } else { 4726 if (my ($target, $action, $pattern) 4727 = $line =~ m#^(\S+) ([=!])~ /(.*)/#) { 4728 if (length $pattern) { 4729 next unless -f $target; 4730 if ($action eq '=') { 4731 next unless extract_from_file($target, $pattern); 4732 } else { 4733 next if extract_from_file($target, $pattern); 4734 } 4735 } else { 4736 # Avoid the special case meaning of the empty pattern, 4737 # and instead use this to simply test for the file being 4738 # present or absent 4739 if ($action eq '=') { 4740 next unless -f $target; 4741 } else { 4742 next if -f $target; 4743 } 4744 } 4745 } 4746 system_or_die("patch -p1 <$file"); 4747 } 4748 } 4749} 4750 4751# ex: set ts=8 sts=4 sw=4 et: 4752