1#!/usr/bin/perl -w 2use strict; 3 4use Getopt::Long qw(:config bundling no_auto_abbrev); 5use Pod::Usage; 6use Config; 7 8my @targets 9 = qw(none config.sh config.h miniperl lib/Config.pm Fcntl perl test_prep); 10 11my %options = 12 ( 13 'expect-pass' => 1, 14 clean => 1, # mostly for debugging this 15 ); 16 17# We accept #!./miniperl and #!./perl 18# We don't accept #!miniperl and #!perl as their intent is ambiguous 19my $run_with_our_perl = qr{\A#!(\./(?:mini)?perl)\b}; 20 21my $linux64 = `uname -sm` eq "Linux x86_64\n" ? '64' : ''; 22 23my @paths; 24 25if ($^O eq 'linux') { 26 # This is the search logic for a multi-arch library layout 27 # added to linux.sh in commits 40f026236b9959b7 and dcffd848632af2c7. 28 my $gcc = -x '/usr/bin/gcc' ? '/usr/bin/gcc' : 'gcc'; 29 30 foreach (`$gcc -print-search-dirs`) { 31 next unless /^libraries: =(.*)/; 32 foreach (split ':', $1) { 33 next if m/gcc/; 34 next unless -d $_; 35 s!/$!!; 36 push @paths, $_; 37 } 38 } 39 push @paths, map {$_ . $linux64} qw(/usr/local/lib /lib /usr/lib) 40 if $linux64; 41} 42 43my %defines = 44 ( 45 usedevel => '', 46 optimize => '-g', 47 ld => 'cc', 48 (@paths ? (libpth => \@paths) : ()), 49 ); 50 51# Needed for the 'ignore_versioned_solibs' emulation below. 52push @paths, qw(/usr/local/lib /lib /usr/lib) 53 unless $linux64; 54 55unless(GetOptions(\%options, 56 'target=s', 'make=s', 'jobs|j=i', 'expect-pass=i', 57 'expect-fail' => sub { $options{'expect-pass'} = 0; }, 58 'clean!', 'one-liner|e=s@', 'c', 'l', 'w', 'match=s', 59 'no-match=s' => sub { 60 $options{match} = $_[1]; 61 $options{'expect-pass'} = 0; 62 }, 63 'force-manifest', 'force-regen', 'setpgrp!', 'timeout=i', 64 'test-build', 'validate', 65 'all-fixups', 'early-fixup=s@', 'late-fixup=s@', 'valgrind', 66 'check-args', 'check-shebang!', 'usage|help|?', 'gold=s', 67 'A=s@', 68 'D=s@' => sub { 69 my (undef, $val) = @_; 70 if ($val =~ /\A([^=]+)=(.*)/s) { 71 $defines{$1} = length $2 ? $2 : "\0"; 72 } else { 73 $defines{$val} = ''; 74 } 75 }, 76 'U=s@' => sub { 77 $defines{$_[1]} = undef; 78 }, 79 )) { 80 pod2usage(exitval => 255, verbose => 1); 81} 82 83my ($target, $match) = @options{qw(target match)}; 84 85@ARGV = ('sh', '-c', 'cd t && ./perl TEST base/*.t') 86 if $options{validate} && !@ARGV; 87 88pod2usage(exitval => 0, verbose => 2) if $options{usage}; 89 90# This needs to be done before the next arguments check, as it's populating 91# @ARGV 92if (defined $target && $target =~ /\.t\z/) { 93 # t/TEST don't have a reliable way to run the test script under valgrind 94 # The $ENV{VALGRIND} code was only added after v5.8.0, and is more 95 # geared to logging than to exiting on failure if errors are found. 96 # I guess one could fudge things by replacing the symlink t/perl with a 97 # wrapper script which invokes valgrind, but leave doing that until 98 # someone needs it. (If that's you, then patches welcome.) 99 foreach (qw(valgrind match validate test-build one-liner)) { 100 die_255("$0: Test-case targets can't be run with --$_") 101 if $options{$_}; 102 } 103 die_255("$0: Test-case targets can't be combined with an explict test") 104 if @ARGV; 105 106 # Needing this unless is a smell suggesting that this implementation of 107 # test-case targets is not really in the right place. 108 unless ($options{'check-args'}) { 109 # The top level sanity tests refuse to start or end a test run at a 110 # revision which skips, hence this test ensures reasonable sanity at 111 # automatically picking a suitable start point for both normal operation 112 # and --expect-fail 113 skip("Test case $target is not a readable file") 114 unless -f $target && -r _; 115 } 116 117 # t/TEST runs from and takes pathnames relative to t/, so need to strip 118 # out a leading t, or add ../ otherwise 119 unless ($target =~ s!\At/!!) { 120 $target = "../$target"; 121 } 122 @ARGV = ('sh', '-c', "cd t && ./perl TEST " . quotemeta $target); 123 $target = 'test_prep'; 124} 125 126pod2usage(exitval => 255, verbose => 1) 127 unless @ARGV || $match || $options{'test-build'} || defined $options{'one-liner'}; 128pod2usage(exitval => 255, verbose => 1) 129 if !$options{'one-liner'} && ($options{l} || $options{w}); 130 131check_shebang($ARGV[0]) 132 if $options{'check-shebang'} && @ARGV && !$options{match}; 133 134exit 0 if $options{'check-args'}; 135 136=head1 NAME 137 138bisect.pl - use git bisect to pinpoint changes 139 140=head1 SYNOPSIS 141 142 # When did this become an error? 143 .../Porting/bisect.pl -e 'my $a := 2;' 144 # When did this stop being an error? 145 .../Porting/bisect.pl --expect-fail -e '1 // 2' 146 # When did this test start failing? 147 .../Porting/bisect.pl --target t/op/sort.t 148 # When were all lines matching this pattern removed from all files? 149 .../Porting/bisect.pl --match '\b(?:PL_)hash_seed_set\b' 150 # When was some line matching this pattern added to some file? 151 .../Porting/bisect.pl --expect-fail --match '\buseithreads\b' 152 # When did this test program stop exiting 0? 153 .../Porting/bisect.pl -- ./perl -Ilib ../test_prog.pl 154 # When did this first become valid syntax? 155 .../Porting/bisect.pl --target=miniperl --end=v5.10.0 \ 156 --expect-fail -e 'my $a := 2;' 157 # What was the last revision to build with these options? 158 .../Porting/bisect.pl --test-build -Dd_dosuid 159 # When did this test program start generating errors from valgrind? 160 .../Porting/bisect.pl --valgrind ../test_prog.pl 161 162=head1 DESCRIPTION 163 164Together F<bisect.pl> and F<bisect-runner.pl> attempt to automate the use 165of C<git bisect> as much as possible. With one command (and no other files) 166it's easy to find out 167 168=over 4 169 170=item * 171 172Which commit caused this example code to break? 173 174=item * 175 176Which commit caused this example code to start working? 177 178=item * 179 180Which commit added the first file to match this regex? 181 182=item * 183 184Which commit removed the last file to match this regex? 185 186=back 187 188usually without needing to know which versions of perl to use as start and 189end revisions. 190 191By default F<bisect.pl> will process all options, then use the rest of the 192command line as arguments to list C<system> to run a test case. By default, 193the test case should pass (exit with 0) on earlier perls, and fail (exit 194non-zero) on I<blead>. F<bisect.pl> will use F<bisect-runner.pl> to find the 195earliest stable perl version on which the test case passes, check that it 196fails on blead, and then use F<bisect-runner.pl> with C<git bisect run> to 197find the commit which caused the failure. 198 199Many of perl's own test scripts exit 0 even if their TAP reports test 200failures, and some need particular setup (such as running from the right 201directory, or adding C<-T> to the command line). Hence if you want to bisect 202a test script, you can specify it with the I<--target> option, and it will 203be invoked using F<t/TEST> which performs all the setup, and exits non-zero 204if the TAP reports failures. This works for any file ending C<.t>, so you can 205use it with a file outside of the working checkout, for example to test a 206particular version of a test script, as a path inside the repository will 207(of course) be testing the version of the script checked out for the current 208revision, which may be too early to have the test you are interested in. 209 210Because the test case is the complete argument to C<system>, it is easy to 211run something other than the F<perl> built, if necessary. If you need to run 212the perl built, you'll probably need to invoke it as C<./perl -Ilib ...>. 213As a special case, if the first argument of the test case is a readable file 214(whether executable or not), matching C<qr{\A#!./(?:mini)?perl\b}> then it 215will have C<./perl> <-Ilib> (or C<./miniperl>) prepended to it. 216 217You need a clean checkout to run a bisect. You can use the checkout 218containing F<Porting/bisect.pl> if you wish - in this case 219F<Porting/bisect.pl> will copy F<Porting/bisect-runner.pl> to a temporary 220file generated by C<File::Temp::tempfile()>. If doing this, beware that when 221the bisect ends (or you abort it) then your checkout is no longer at 222C<blead>, so you will need to C<git checkout blead> before restarting, to 223get the current version of F<Porting/bisect.pl> again. It's often easier 224either to copy F<Porting/bisect.pl> and F<Porting/bisect-runner.pl> to 225another directory (I<e.g.> F<~/bin>, if you have one), or to create a second 226git repository for running bisect. To create a second local repository, if 227your working checkout is called F<perl>, a simple solution is to make a 228local clone, and run from that. I<i.e.>: 229 230 cd .. 231 git clone perl perl2 232 cd perl2 233 ../perl/Porting/bisect.pl ... 234 235By default, F<bisect-runner.pl> will automatically disable the build of 236L<DB_File> for commits earlier than ccb44e3bf3be2c30, as it's not practical 237to patch DB_File 1.70 and earlier to build with current Berkeley DB headers. 238(ccb44e3bf3be2c30 was in September 1999, between 5.005_62 and 5.005_63.) 239If your F<db.h> is old enough you can override this with C<-Unoextensions>. 240 241=head1 OPTIONS 242 243=over 4 244 245=item * 246 247--start I<commit-ish> 248 249Earliest revision to test, as a I<commit-ish> (a tag, commit or anything 250else C<git> understands as a revision). If not specified, F<bisect.pl> will 251search stable .0 perl releases until it finds one where the test case 252passes. The default is to search from 5.002 to the most recent tagged stable 253release (v5.18.0 at the time of writing). If F<bisect.pl> detects that the 254checkout is on a case insensitive file system, it will search from 5.005 to 255the most recent tagged stable release. Only .0 stable releases are used 256because these are the only stable releases that are parents of blead, and 257hence suitable for a bisect run. 258 259=item * 260 261--end I<commit-ish> 262 263Most recent revision to test, as a I<commit-ish>. If not specified, defaults 264to I<blead>. 265 266=item * 267 268--target I<target> 269 270F<Makefile> target (or equivalent) needed, to run the test case. If specified, 271this should be one of 272 273=over 4 274 275=item * 276 277I<none> 278 279Don't build anything - just run the user test case against a clean checkout. 280Using this gives a couple of features that a plain C<git bisect run> can't 281offer - automatic start revision detection, and test case C<--timeout>. 282 283=item * 284 285I<config.sh> 286 287Just run F<./Configure> 288 289=item * 290 291I<config.h> 292 293Run the various F<*.SH> files to generate F<Makefile>, F<config.h>, I<etc>. 294 295=item * 296 297I<miniperl> 298 299Build F<miniperl>. 300 301=item * 302 303I<lib/Config.pm> 304 305Use F<miniperl> to build F<lib/Config.pm> 306 307=item * 308 309I<Fcntl> 310 311Build F<lib/auto/Fcntl/Fnctl.so> (strictly, C<.$Config{so}>). As L<Fcntl> 312is simple XS module present since 5.000, this provides a fast test of 313whether XS modules can be built. Note, XS modules are built by F<miniperl>, 314hence this target will not build F<perl>. 315 316=item * 317 318I<perl> 319 320Build F<perl>. This also builds pure-Perl modules in F<cpan>, F<dist> and 321F<ext>. XS modules (such as L<Fcntl>) are not built. 322 323=item * 324 325I<test_prep> 326 327Build everything needed to run the tests. This is the default if we're 328running test code, but is time consuming, as it means building all 329XS modules. For older F<Makefile>s, the previous name of C<test-prep> 330is automatically substituted. For very old F<Makefile>s, C<make test> is 331run, as there is no target provided to just get things ready, and for 5.004 332and earlier the tests run very quickly. 333 334=item * 335 336A file ending C<.t> 337 338Build everything needed to run the tests, and then run this test script using 339F<t/TEST>. This is actually implemented internally by using the target 340I<test_prep>, and setting the test case to "sh", "-c", "cd t && ./TEST ..." 341 342=back 343 344=item * 345 346--one-liner 'code to run' 347 348=item * 349 350-e 'code to run' 351 352Example code to run, just like you'd use with C<perl -e>. 353 354This prepends C<./perl -Ilib -e 'code to run'> to the test case given, 355or F<./miniperl> if I<target> is C<miniperl>. 356 357(Usually you'll use C<-e> instead of providing a test case in the 358non-option arguments to F<bisect.pl>. You can repeat C<-e> on the command 359line, just like you can with C<perl>) 360 361C<-E> intentionally isn't supported, as it's an error in 5.8.0 and earlier, 362which interferes with detecting errors in the example code itself. 363 364=item * 365 366-c 367 368Add C<-c> to the command line, to cause perl to exit after syntax checking. 369 370=item * 371 372-l 373 374Add C<-l> to the command line with C<-e> 375 376This will automatically append a newline to every output line of your testcase. 377Note that you can't specify an argument to F<perl>'s C<-l> with this, as it's 378not feasible to emulate F<perl>'s somewhat quirky switch parsing with 379L<Getopt::Long>. If you need the full flexibility of C<-l>, you need to write 380a full test case, instead of using C<bisect.pl>'s C<-e> shortcut. 381 382=item * 383 384-w 385 386Add C<-w> to the command line with C<-e> 387 388It's not valid to pass C<-c>, C<-l> or C<-w> to C<bisect.pl> unless you are 389also using C<-e> 390 391=item * 392 393--expect-fail 394 395The test case should fail for the I<start> revision, and pass for the I<end> 396revision. The bisect run will find the first commit where it passes. 397 398=item * 399 400-D I<config_arg=value> 401 402=item * 403 404-U I<config_arg> 405 406=item * 407 408-A I<config_arg=value> 409 410Arguments (C<-A>, C<-D>, C<-U>) to pass to F<Configure>. For example, 411 412 -Dnoextensions=Encode 413 -Uusedevel 414 -Accflags=-DNO_MATHOMS 415 416Repeated C<-A> arguments are passed 417through as is. C<-D> and C<-U> are processed in order, and override 418previous settings for the same parameter. F<bisect-runner.pl> emulates 419C<-Dnoextensions> when F<Configure> itself does not provide it, as it's 420often very useful to be able to disable some XS extensions. 421 422=item * 423 424--make I<make-prog> 425 426The C<make> command to use. If this not set, F<make> is used. If this is 427set, it also adds a C<-Dmake=...> else some recursive make invocations 428in extensions may fail. Typically one would use this as C<--make gmake> 429to use F<gmake> in place of the system F<make>. 430 431=item * 432 433--jobs I<jobs> 434 435=item * 436 437-j I<jobs> 438 439Number of C<make> jobs to run in parallel. A value of 0 suppresses 440parallelism. If F</proc/cpuinfo> exists and can be parsed, or F</sbin/sysctl> 441exists and reports C<hw.ncpu>, or F</usr/bin/getconf> exists and reports 442C<_NPROCESSORS_ONLN> defaults to 1 + I<number of CPUs>. On HP-UX with the 443system make defaults to 0, otherwise defaults to 2. 444 445=item * 446 447--match pattern 448 449=item * 450 451--no-match pattern 452 453Instead of running a test program to determine I<pass> or I<fail>, 454C<--match> will pass if the given regex matches, and hence search for the 455commit that removes the last matching file. C<--no-match> inverts the test, 456to search for the first commit that adds files that match. 457 458The remaining command line arguments are treated as glob patterns for files 459to match against. If none are specified, then they default as follows: 460 461=over 4 462 463=item * 464 465If no I<target> is specified, the match is against all files in the 466repository (which is fast). 467 468=item * 469 470If a I<target> is specified, that target is built, and the match is against 471only the built files. 472 473=back 474 475Treating the command line arguments as glob patterns should not cause 476problems, as the perl distribution has never shipped or built files with 477names that contain characters which are globbing metacharacters. 478 479Anything which is not a readable file is ignored, instead of generating an 480error. (If you want an error, run C<grep> or C<ack> as a test case). This 481permits one to easily search in a file that changed its name. For example: 482 483 .../Porting/bisect.pl --match 'Pod.*Functions' 'pod/buildtoc*' 484 485C<--no-match ...> is implemented as C<--expect-fail --match ...> 486 487=item * 488 489--valgrind 490 491Run the test program under C<valgrind>. If you need to test for memory 492errors when parsing invalid programs, the default parser fail exit code of 493255 will always override C<valgrind>, so try putting the test case invalid 494code inside a I<string> C<eval>, so that the perl interpreter will exit with 0. 495(Be sure to check the output of $@, to avoid missing mistakes such as 496unintended C<eval> failures due to incorrect C<@INC>) 497 498Specifically, this option prepends C<valgrind> C<--error-exitcode=124> to 499the command line that runs the testcase, to cause valgrind to exit non-zero 500if it detects errors, with the assumption that the test program itself 501always exits with zero. If you require more flexibility than this, either 502specify your C<valgrind> invocation explicitly as part of the test case, or 503use a wrapper script to control the command line or massage the exit codes. 504 505=item * 506 507--test-build 508 509Test that the build completes, without running any test case. 510 511By default, if the build for the desired I<target> fails to complete, 512F<bisect-runner.pl> reports a I<skip> back to C<git bisect>, the assumption 513being that one wants to find a commit which changed state "builds && passes" 514to "builds && fails". If instead one is interested in which commit broke the 515build (possibly for particular F<Configure> options), use I<--test-build> 516to treat a build failure as a failure, not a "skip". 517 518Often this option isn't as useful as it first seems, because I<any> build 519failure will be reported to C<git bisect> as a failure, not just the failure 520that you're interested in. Generally, to debug a particular problem, it's 521more useful to use a I<target> that builds properly at the point of interest, 522and then a test case that runs C<make>. For example: 523 524 .../Porting/bisect.pl --start=perl-5.000 --end=perl-5.002 \ 525 --expect-fail --force-manifest --target=miniperl make perl 526 527will find the first revision capable of building L<DynaLoader> and then 528F<perl>, without becoming confused by revisions where F<miniperl> won't 529even link. 530 531=item * 532 533--force-manifest 534 535By default, a build will "skip" if any files listed in F<MANIFEST> are not 536present. Usually this is useful, as it avoids false-failures. However, there 537are some long ranges of commits where listed files are missing, which can 538cause a bisect to abort because all that remain are skipped revisions. 539 540In these cases, particularly if the test case uses F<miniperl> and no modules, 541it may be more useful to force the build to continue, even if files 542F<MANIFEST> are missing. 543 544=item * 545 546--force-regen 547 548Run C<make regen_headers> before building F<miniperl>. This may fix a build 549that otherwise would skip because the generated headers at that revision 550are stale. It's not the default because it conceals this error in the true 551state of such revisions. 552 553=item * 554 555--expect-pass [0|1] 556 557C<--expect-pass=0> is equivalent to C<--expect-fail>. I<1> is the default. 558 559=item * 560 561--timeout I<seconds> 562 563Run the testcase with the given timeout. If this is exceeded, kill it (and 564by default all its children), and treat it as a failure. 565 566=item * 567 568--setpgrp 569 570Run the testcase in its own process group. Specifically, call C<setpgrp 0, 0> 571just before C<exec>-ing the user testcase. The default is not to set the 572process group, unless a timeout is used. 573 574=item * 575 576--all-fixups 577 578F<bisect-runner.pl> will minimally patch various files on a platform and 579version dependent basis to get the build to complete. Normally it defers 580doing this as long as possible - C<.SH> files aren't patched until after 581F<Configure> is run, and C<C> and C<XS> code isn't patched until after 582F<miniperl> is built. If C<--all-fixups> is specified, all the fixups are 583done before running C<Configure>. In rare cases adding this may cause a 584bisect to abort, because an inapplicable patch or other fixup is attempted 585for a revision which would usually have already I<skip>ed. If this happens, 586please report it as a bug, giving the OS and problem revision. 587 588=item * 589 590--early-fixup file 591 592=item * 593 594--late-fixup file 595 596Specify a file containing a patch or other fixup for the source code. The 597action to take depends on the first line of the fixup file 598 599=over 4 600 601=item * 602 603C<#!perl> 604 605If the first line starts C<#!perl> then the file is run using C<$^X> 606 607=item * 608 609C<#!/absolute/path> 610 611If a shebang line is present the file is executed using C<system> 612 613=item * 614 615C<I<filename> =~ /I<pattern>/> 616 617=item * 618 619C<I<filename> !~ /I<pattern>/> 620 621If I<filename> does not exist then the fixup file's contents are ignored. 622Otherwise, for C<=~>, if it contains a line matching I<pattern>, then the 623file is fed to C<patch -p1> on standard input. For C<=~>, the patch is 624applied if no lines match the pattern. 625 626As the empty pattern in Perl is a special case (it matches the most recent 627sucessful match) which is not useful here, an the treatment of empty pattern 628is special-cased. C<I<filename> =~ //> applies the patch if filename is 629present. C<I<filename> !~ //> applies the patch if filename missing. This 630makes it easy to unconditionally apply patches to files, and to use a patch 631as a way of creating a new file. 632 633=item * 634 635Otherwise, the file is assumed to be a patch, and always applied. 636 637=back 638 639I<early-fixup>s are applied before F<./Configure> is run. I<late-fixup>s are 640applied just after F<./Configure> is run. 641 642These options can be specified more than once. I<file> is actually expanded 643as a glob pattern. Globs that do not match are errors, as are missing files. 644 645=item * 646 647--no-clean 648 649Tell F<bisect-runner.pl> not to clean up after the build. This allows one 650to use F<bisect-runner.pl> to build the current particular perl revision for 651interactive testing, or for debugging F<bisect-runner.pl>. 652 653Passing this to F<bisect.pl> will likely cause the bisect to fail badly. 654 655=item * 656 657--validate 658 659Test that all stable (.0) revisions can be built. By default, attempts to 660build I<blead>, then tagged stable releases in reverse order down to 661I<perl-5.002> (or I<perl5.005> on a case insensitive file system). Stops at 662the first failure, without cleaning the checkout. Use I<--start> to specify 663the earliest revision to test, I<--end> to specify the most recent. Useful 664for validating a new OS/CPU/compiler combination. For example 665 666 ../perl/Porting/bisect.pl --validate -le 'print "Hello from $]"' 667 668If no testcase is specified, the default is to use F<t/TEST> to run 669F<t/base/*.t> 670 671=item * 672 673--check-args 674 675Validate the options and arguments, and exit silently if they are valid. 676 677=item * 678 679--check-shebang 680 681Validate that the test case isn't an executable file with a 682C<#!/usr/bin/perl> line (or similar). As F<bisect-runner.pl> does B<not> 683automatically prepend C<./perl> to the test case, a I<#!> line specifying an 684external F<perl> binary will cause the test case to always run with I<that> 685F<perl>, not the F<perl> built by the bisect runner. Likely this is not what 686you wanted. If your test case is actually a wrapper script to run other 687commands, you should run it with an explicit interpreter, to be clear. For 688example, instead of C<../perl/Porting/bisect.pl ~/test/testcase.pl> you'd 689run C<../perl/Porting/bisect.pl /usr/bin/perl ~/test/testcase.pl> 690 691=item * 692 693--gold 694 695Revision to use when checking out known-good recent versions of files, 696such as F<makedepend.SH>. F<bisect-runner.pl> defaults this to I<blead>, 697but F<bisect.pl> will default it to the most recent stable release. 698 699=item * 700 701--usage 702 703=item * 704 705--help 706 707=item * 708 709-? 710 711Display the usage information and exit. 712 713=back 714 715=cut 716 717# Ensure we always exit with 255, to cause git bisect to abort. 718sub croak_255 { 719 my $message = join '', @_; 720 if ($message =~ /\n\z/) { 721 print STDERR $message; 722 } else { 723 my (undef, $file, $line) = caller 1; 724 print STDERR "@_ at $file line $line\n"; 725 } 726 exit 255; 727} 728 729sub die_255 { 730 croak_255(@_); 731} 732 733die_255("$0: Can't build $target") 734 if defined $target && !grep {@targets} $target; 735 736foreach my $phase (qw(early late)) { 737 next unless $options{"$phase-fixup"}; 738 my $bail_out; 739 require File::Glob; 740 my @expanded; 741 foreach my $glob (@{$options{"$phase-fixup"}}) { 742 my @got = File::Glob::bsd_glob($glob); 743 push @expanded, @got ? @got : $glob; 744 } 745 @expanded = sort @expanded; 746 $options{"$phase-fixup"} = \@expanded; 747 foreach (@expanded) { 748 unless (-f $_) { 749 print STDERR "$phase-fixup '$_' is not a readable file\n"; 750 ++$bail_out; 751 } 752 } 753 exit 255 if $bail_out; 754} 755 756unless (exists $defines{cc}) { 757 # If it fails, the heuristic of 63f9ec3008baf7d6 is noisy, and hence 758 # confusing. 759 # FIXME - really it should be replaced with a proper test of 760 # "can we build something?" and a helpful diagnostic if we can't. 761 # For now, simply move it here. 762 $defines{cc} = (`ccache -V`, $?) ? 'cc' : 'ccache cc'; 763} 764 765my $j = $options{jobs} ? "-j$options{jobs}" : ''; 766 767if (exists $options{make}) { 768 if (!exists $defines{make}) { 769 $defines{make} = $options{make}; 770 } 771} else { 772 $options{make} = 'make'; 773} 774 775# Sadly, however hard we try, I don't think that it will be possible to build 776# modules in ext/ on x86_64 Linux before commit e1666bf5602ae794 on 1999/12/29, 777# which updated to MakeMaker 3.7, which changed from using a hard coded ld 778# in the Makefile to $(LD). On x86_64 Linux the "linker" is gcc. 779 780sub open_or_die { 781 my $file = shift; 782 my $mode = @_ ? shift : '<'; 783 open my $fh, $mode, $file or croak_255("Can't open $file: $!"); 784 ${*$fh{SCALAR}} = $file; 785 return $fh; 786} 787 788sub close_or_die { 789 my $fh = shift; 790 return if close $fh; 791 croak_255("Can't close: $!") unless ref $fh eq 'GLOB'; 792 croak_255("Can't close ${*$fh{SCALAR}}: $!"); 793} 794 795sub system_or_die { 796 my $command = '</dev/null ' . shift; 797 system($command) and croak_255("'$command' failed, \$!=$!, \$?=$?"); 798} 799 800sub run_with_options { 801 my $options = shift; 802 my $name = $options->{name}; 803 $name = "@_" unless defined $name; 804 805 my $setgrp = $options->{setpgrp}; 806 if ($options->{timeout}) { 807 # Unless you explicitly disabled it on the commandline, set it: 808 $setgrp = 1 unless defined $setgrp; 809 } 810 my $pid = fork; 811 die_255("Can't fork: $!") unless defined $pid; 812 if (!$pid) { 813 if (exists $options->{stdin}) { 814 open STDIN, '<', $options->{stdin} 815 or die "Can't open STDIN from $options->{stdin}: $!"; 816 } 817 if ($setgrp) { 818 setpgrp 0, 0 819 or die "Can't setpgrp 0, 0: $!"; 820 } 821 { exec @_ }; 822 die_255("Failed to start $name: $!"); 823 } 824 my $start; 825 if ($options->{timeout}) { 826 require Errno; 827 require POSIX; 828 die_255("No POSIX::WNOHANG") 829 unless &POSIX::WNOHANG; 830 $start = time; 831 $SIG{ALRM} = sub { 832 my $victim = $setgrp ? -$pid : $pid; 833 my $delay = 1; 834 kill 'TERM', $victim; 835 waitpid(-1, &POSIX::WNOHANG); 836 while (kill 0, $victim) { 837 sleep $delay; 838 waitpid(-1, &POSIX::WNOHANG); 839 $delay *= 2; 840 if ($delay > 8) { 841 if (kill 'KILL', $victim) { 842 print STDERR "$0: Had to kill 'KILL', $victim\n" 843 } elsif (! $!{ESRCH}) { 844 print STDERR "$0: kill 'KILL', $victim failed: $!\n"; 845 } 846 last; 847 } 848 } 849 report_and_exit(0, 'No timeout', 'Timeout', "when running $name"); 850 }; 851 alarm $options->{timeout}; 852 } 853 waitpid $pid, 0 854 or die_255("wait for $name, pid $pid failed: $!"); 855 alarm 0; 856 if ($options->{timeout}) { 857 my $elapsed = time - $start; 858 if ($elapsed / $options->{timeout} > 0.8) { 859 print STDERR "$0: Beware, took $elapsed seconds of $options->{timeout} permitted to run $name\n"; 860 } 861 } 862 return $?; 863} 864 865sub extract_from_file { 866 my ($file, $rx, $default) = @_; 867 my $fh = open_or_die($file); 868 while (<$fh>) { 869 my @got = $_ =~ $rx; 870 return wantarray ? @got : $got[0] 871 if @got; 872 } 873 return $default if defined $default; 874 return; 875} 876 877sub edit_file { 878 my ($file, $munger) = @_; 879 local $/; 880 my $fh = open_or_die($file); 881 my $orig = <$fh>; 882 die_255("Can't read $file: $!") unless defined $orig && close $fh; 883 my $new = $munger->($orig); 884 return if $new eq $orig; 885 $fh = open_or_die($file, '>'); 886 print $fh $new or die_255("Can't print to $file: $!"); 887 close_or_die($fh); 888} 889 890# AIX supplies a pre-historic patch program, which certainly predates Linux 891# and is probably older than NT. It can't cope with unified diffs. Meanwhile, 892# it's hard enough to get git diff to output context diffs, let alone git show, 893# and nearly all the patches embedded here are unified. So it seems that the 894# path of least resistance is to convert unified diffs to context diffs: 895 896sub process_hunk { 897 my ($from_out, $to_out, $has_from, $has_to, $delete, $add) = @_; 898 ++$$has_from if $delete; 899 ++$$has_to if $add; 900 901 if ($delete && $add) { 902 $$from_out .= "! $_\n" foreach @$delete; 903 $$to_out .= "! $_\n" foreach @$add; 904 } elsif ($delete) { 905 $$from_out .= "- $_\n" foreach @$delete; 906 } elsif ($add) { 907 $$to_out .= "+ $_\n" foreach @$add; 908 } 909} 910 911# This isn't quite general purpose, as it can't cope with 912# '\ No newline at end of file' 913sub ud2cd { 914 my $diff_in = shift; 915 my $diff_out = ''; 916 917 # Stuff before the diff 918 while ($diff_in =~ s/\A(?!\*\*\* )(?!--- )([^\n]*\n?)//ms && length $1) { 919 $diff_out .= $1; 920 } 921 922 if (!length $diff_in) { 923 die_255("That didn't seem to be a diff"); 924 } 925 926 if ($diff_in =~ /\A\*\*\* /ms) { 927 warn "Seems to be a context diff already\n"; 928 return $diff_out . $diff_in; 929 } 930 931 # Loop for files 932 FILE: while (1) { 933 if ($diff_in =~ s/\A((?:diff |index )[^\n]+\n)//ms) { 934 $diff_out .= $1; 935 next; 936 } 937 if ($diff_in !~ /\A--- /ms) { 938 # Stuff after the diff; 939 return $diff_out . $diff_in; 940 } 941 $diff_in =~ s/\A([^\n]+\n?)//ms; 942 my $line = $1; 943 die_255("Can't parse '$line'") unless $line =~ s/\A--- /*** /ms; 944 $diff_out .= $line; 945 $diff_in =~ s/\A([^\n]+\n?)//ms; 946 $line = $1; 947 die_255("Can't parse '$line'") unless $line =~ s/\A\+\+\+ /--- /ms; 948 $diff_out .= $line; 949 950 # Loop for hunks 951 while (1) { 952 next FILE 953 unless $diff_in =~ s/\A\@\@ (-([0-9]+),([0-9]+) \+([0-9]+),([0-9]+)) \@\@[^\n]*\n?//; 954 my ($hunk, $from_start, $from_count, $to_start, $to_count) 955 = ($1, $2, $3, $4, $5); 956 my $from_end = $from_start + $from_count - 1; 957 my $to_end = $to_start + $to_count - 1; 958 my ($from_out, $to_out, $has_from, $has_to, $add, $delete); 959 while (length $diff_in && ($from_count || $to_count)) { 960 die_255("Confused in $hunk") 961 unless $diff_in =~ s/\A([^\n]*)\n//ms; 962 my $line = $1; 963 $line = ' ' unless length $line; 964 if ($line =~ /^ .*/) { 965 process_hunk(\$from_out, \$to_out, \$has_from, \$has_to, 966 $delete, $add); 967 undef $delete; 968 undef $add; 969 $from_out .= " $line\n"; 970 $to_out .= " $line\n"; 971 --$from_count; 972 --$to_count; 973 } elsif ($line =~ /^-(.*)/) { 974 push @$delete, $1; 975 --$from_count; 976 } elsif ($line =~ /^\+(.*)/) { 977 push @$add, $1; 978 --$to_count; 979 } else { 980 die_255("Can't parse '$line' as part of hunk $hunk"); 981 } 982 } 983 process_hunk(\$from_out, \$to_out, \$has_from, \$has_to, 984 $delete, $add); 985 die_255("No lines in hunk $hunk") 986 unless length $from_out || length $to_out; 987 die_255("No changes in hunk $hunk") 988 unless $has_from || $has_to; 989 $diff_out .= "***************\n"; 990 $diff_out .= "*** $from_start,$from_end ****\n"; 991 $diff_out .= $from_out if $has_from; 992 $diff_out .= "--- $to_start,$to_end ----\n"; 993 $diff_out .= $to_out if $has_to; 994 } 995 } 996} 997 998{ 999 my $use_context; 1000 1001 sub placate_patch_prog { 1002 my $patch = shift; 1003 1004 if (!defined $use_context) { 1005 my $version = `patch -v 2>&1`; 1006 die_255("Can't run `patch -v`, \$?=$?, bailing out") 1007 unless defined $version; 1008 if ($version =~ /Free Software Foundation/) { 1009 $use_context = 0; 1010 } elsif ($version =~ /Header: patch\.c,v.*\blwall\b/) { 1011 # The system patch is older than Linux, and probably older than 1012 # Windows NT. 1013 $use_context = 1; 1014 } elsif ($version =~ /Header: patch\.c,v.*\babhinav\b/) { 1015 # Thank you HP. No, we have no idea *which* version this is: 1016 # $Header: patch.c,v 76.1.1.2.1.3 2001/12/03 12:24:52 abhinav Exp $ 1017 $use_context = 1; 1018 } else { 1019 # Don't know. 1020 $use_context = 0; 1021 } 1022 } 1023 1024 return $use_context ? ud2cd($patch) : $patch; 1025 } 1026} 1027 1028sub apply_patch { 1029 my ($patch, $what, $files) = @_; 1030 $what = 'patch' unless defined $what; 1031 unless (defined $files) { 1032 $patch =~ m!^--- [ab]/(\S+)\n\+\+\+ [ba]/\1!sm; 1033 $files = " $1"; 1034 } 1035 my $patch_to_use = placate_patch_prog($patch); 1036 open my $fh, '|-', 'patch', '-p1' or die_255("Can't run patch: $!"); 1037 print $fh $patch_to_use; 1038 return if close $fh; 1039 print STDERR "Patch is <<'EOPATCH'\n${patch}EOPATCH\n"; 1040 print STDERR "\nConverted to a context diff <<'EOCONTEXT'\n${patch_to_use}EOCONTEXT\n" 1041 if $patch_to_use ne $patch; 1042 die_255("Can't $what$files: $?, $!"); 1043} 1044 1045sub apply_commit { 1046 my ($commit, @files) = @_; 1047 my $patch = `git show $commit @files`; 1048 if (!defined $patch) { 1049 die_255("Can't get commit $commit for @files: $?") if @files; 1050 die_255("Can't get commit $commit: $?"); 1051 } 1052 apply_patch($patch, "patch $commit", @files ? " for @files" : ''); 1053} 1054 1055sub revert_commit { 1056 my ($commit, @files) = @_; 1057 my $patch = `git show -R $commit @files`; 1058 if (!defined $patch) { 1059 die_255("Can't get revert commit $commit for @files: $?") if @files; 1060 die_255("Can't get revert commit $commit: $?"); 1061 } 1062 apply_patch($patch, "revert $commit", @files ? " for @files" : ''); 1063} 1064 1065sub checkout_file { 1066 my ($file, $commit) = @_; 1067 $commit ||= $options{gold} || 'blead'; 1068 system "git show $commit:$file > $file </dev/null" 1069 and die_255("Could not extract $file at revision $commit"); 1070} 1071 1072sub check_shebang { 1073 my $file = shift; 1074 return unless -e $file; 1075 my $fh = open_or_die($file); 1076 my $line = <$fh>; 1077 return if $line =~ $run_with_our_perl; 1078 if (!-x $file) { 1079 die_255("$file is not executable. 1080system($file, ...) is always going to fail. 1081 1082Bailing out"); 1083 } 1084 return unless $line =~ m{\A#!(/\S+/perl\S*)\s}; 1085 die_255("$file will always be run by $1 1086It won't be tested by the ./perl we build. 1087If you intended to run it with that perl binary, please change your 1088test case to 1089 1090 $1 @ARGV 1091 1092If you intended to test it with the ./perl we build, please change your 1093test case to 1094 1095 ./perl -Ilib @ARGV 1096 1097[You may also need to add -- before ./perl to prevent that -Ilib as being 1098parsed as an argument to bisect.pl] 1099 1100Bailing out"); 1101} 1102 1103sub clean { 1104 if ($options{clean}) { 1105 # Needed, because files that are build products in this checked out 1106 # version might be in git in the next desired version. 1107 system 'git clean -qdxf </dev/null'; 1108 # Needed, because at some revisions the build alters checked out files. 1109 # (eg pod/perlapi.pod). Also undoes any changes to makedepend.SH 1110 system 'git reset --hard HEAD </dev/null'; 1111 } 1112} 1113 1114sub skip { 1115 my $reason = shift; 1116 clean(); 1117 warn "skipping - $reason"; 1118 exit 125; 1119} 1120 1121sub report_and_exit { 1122 my ($good, $pass, $fail, $desc) = @_; 1123 1124 clean(); 1125 1126 my $got = ($options{'expect-pass'} ? $good : !$good) ? 'good' : 'bad'; 1127 if ($good) { 1128 print "$got - $pass $desc\n"; 1129 } else { 1130 print "$got - $fail $desc\n"; 1131 } 1132 1133 exit($got eq 'bad'); 1134} 1135 1136sub run_report_and_exit { 1137 my $ret = run_with_options({setprgp => $options{setpgrp}, 1138 timeout => $options{timeout}, 1139 }, @_); 1140 report_and_exit(!$ret, 'zero exit from', 'non-zero exit from', "@_"); 1141} 1142 1143sub match_and_exit { 1144 my ($target, @globs) = @_; 1145 my $matches = 0; 1146 my $re = qr/$match/; 1147 my @files; 1148 1149 if (@globs) { 1150 require File::Glob; 1151 foreach (sort map { File::Glob::bsd_glob($_)} @globs) { 1152 if (!-f $_ || !-r _) { 1153 warn "Skipping matching '$_' as it is not a readable file\n"; 1154 } else { 1155 push @files, $_; 1156 } 1157 } 1158 } else { 1159 local $/ = "\0"; 1160 @files = defined $target ? `git ls-files -o -z`: `git ls-files -z`; 1161 chomp @files; 1162 } 1163 1164 foreach my $file (@files) { 1165 my $fh = open_or_die($file); 1166 while (<$fh>) { 1167 if ($_ =~ $re) { 1168 ++$matches; 1169 if (tr/\t\r\n -~\200-\377//c) { 1170 print "Binary file $file matches\n"; 1171 } else { 1172 $_ .= "\n" unless /\n\z/; 1173 print "$file: $_"; 1174 } 1175 } 1176 } 1177 close_or_die($fh); 1178 } 1179 report_and_exit($matches, 1180 $matches == 1 ? '1 match for' : "$matches matches for", 1181 'no matches for', $match); 1182} 1183 1184# Not going to assume that system perl is yet new enough to have autodie 1185system_or_die('git clean -dxf'); 1186 1187if (!defined $target) { 1188 match_and_exit(undef, @ARGV) if $match; 1189 $target = 'test_prep'; 1190} elsif ($target eq 'none') { 1191 match_and_exit(undef, @ARGV) if $match; 1192 run_report_and_exit(@ARGV); 1193} 1194 1195skip('no Configure - is this the //depot/perlext/Compiler branch?') 1196 unless -f 'Configure'; 1197 1198my $case_insensitive; 1199{ 1200 my ($dev_C, $ino_C) = stat 'Configure'; 1201 die_255("Could not stat Configure: $!") unless defined $dev_C; 1202 my ($dev_c, $ino_c) = stat 'configure'; 1203 ++$case_insensitive 1204 if defined $dev_c && $dev_C == $dev_c && $ino_C == $ino_c; 1205} 1206 1207# This changes to PERL_VERSION in 4d8076ea25903dcb in 1999 1208my $major 1209 = extract_from_file('patchlevel.h', 1210 qr/^#define\s+(?:PERL_VERSION|PATCHLEVEL)\s+(\d+)\s/, 1211 0); 1212 1213my $unfixable_db_file; 1214 1215if ($major < 10 1216 && !extract_from_file('ext/DB_File/DB_File.xs', 1217 qr!^#else /\* Berkeley DB Version > 2 \*/$!)) { 1218 # This DB_File.xs is really too old to patch up. 1219 # Skip DB_File, unless we're invoked with an explicit -Unoextensions 1220 if (!exists $defines{noextensions}) { 1221 $defines{noextensions} = 'DB_File'; 1222 } elsif (defined $defines{noextensions}) { 1223 $defines{noextensions} .= ' DB_File'; 1224 } 1225 ++$unfixable_db_file; 1226} 1227 1228patch_Configure(); 1229patch_hints(); 1230if ($options{'all-fixups'}) { 1231 patch_SH(); 1232 patch_C(); 1233 patch_ext(); 1234} 1235apply_fixups($options{'early-fixup'}); 1236 1237# if Encode is not needed for the test, you can speed up the bisect by 1238# excluding it from the runs with -Dnoextensions=Encode 1239# ccache is an easy win. Remove it if it causes problems. 1240# Commit 1cfa4ec74d4933da adds ignore_versioned_solibs to Configure, and sets it 1241# to true in hints/linux.sh 1242# On dromedary, from that point on, Configure (by default) fails to find any 1243# libraries, because it scans /usr/local/lib /lib /usr/lib, which only contain 1244# versioned libraries. Without -lm, the build fails. 1245# Telling /usr/local/lib64 /lib64 /usr/lib64 works from that commit onwards, 1246# until commit faae14e6e968e1c0 adds it to the hints. 1247# However, prior to 1cfa4ec74d4933da telling Configure the truth doesn't work, 1248# because it will spot versioned libraries, pass them to the compiler, and then 1249# bail out pretty early on. Configure won't let us override libswanted, but it 1250# will let us override the entire libs list. 1251 1252foreach (@{$options{A}}) { 1253 push @paths, $1 if /^libpth=(.*)/s; 1254} 1255 1256unless (extract_from_file('Configure', 'ignore_versioned_solibs')) { 1257 # Before 1cfa4ec74d4933da, so force the libs list. 1258 1259 my @libs; 1260 # This is the current libswanted list from Configure, less the libs removed 1261 # by current hints/linux.sh 1262 foreach my $lib (qw(sfio socket inet nsl nm ndbm gdbm dbm db malloc dl 1263 ld sun m crypt sec util c cposix posix ucb BSD)) { 1264 foreach my $dir (@paths) { 1265 # Note the wonderful consistency of dot-or-not in the config vars: 1266 next unless -f "$dir/lib$lib.$Config{dlext}" 1267 || -f "$dir/lib$lib$Config{lib_ext}"; 1268 push @libs, "-l$lib"; 1269 last; 1270 } 1271 } 1272 $defines{libs} = \@libs unless exists $defines{libs}; 1273} 1274 1275$defines{usenm} = undef 1276 if $major < 2 && !exists $defines{usenm}; 1277 1278my ($missing, $created_dirs); 1279($missing, $created_dirs) = force_manifest() 1280 if $options{'force-manifest'}; 1281 1282my @ARGS = '-dEs'; 1283foreach my $key (sort keys %defines) { 1284 my $val = $defines{$key}; 1285 if (ref $val) { 1286 push @ARGS, "-D$key=@$val"; 1287 } elsif (!defined $val) { 1288 push @ARGS, "-U$key"; 1289 } elsif (!length $val) { 1290 push @ARGS, "-D$key"; 1291 } else { 1292 $val = "" if $val eq "\0"; 1293 push @ARGS, "-D$key=$val"; 1294 } 1295} 1296push @ARGS, map {"-A$_"} @{$options{A}}; 1297 1298# If a file in MANIFEST is missing, Configure asks if you want to 1299# continue (the default being 'n'). With stdin closed or /dev/null, 1300# it exits immediately and the check for config.sh below will skip. 1301# Without redirecting stdin, the commands called will attempt to read from 1302# stdin (and thus effectively hang) 1303run_with_options({stdin => '/dev/null', name => 'Configure'}, 1304 './Configure', @ARGS); 1305 1306patch_SH() unless $options{'all-fixups'}; 1307apply_fixups($options{'late-fixup'}); 1308 1309if (-f 'config.sh') { 1310 # Emulate noextensions if Configure doesn't support it. 1311 fake_noextensions() 1312 if $major < 10 && $defines{noextensions}; 1313 system_or_die('./Configure -S'); 1314} 1315 1316if ($target =~ /config\.s?h/) { 1317 match_and_exit($target, @ARGV) if $match && -f $target; 1318 report_and_exit(-f $target, 'could build', 'could not build', $target) 1319 if $options{'test-build'}; 1320 1321 skip("could not build $target") unless -f $target; 1322 1323 run_report_and_exit(@ARGV); 1324} elsif (!-f 'config.sh') { 1325 # Skip if something went wrong with Configure 1326 1327 skip('could not build config.sh'); 1328} 1329 1330force_manifest_cleanup($missing, $created_dirs) 1331 if $missing; 1332 1333if($options{'force-regen'} 1334 && extract_from_file('Makefile', qr/\bregen_headers\b/)) { 1335 # regen_headers was added in e50aee73b3d4c555, patch.1m for perl5.001 1336 # It's not worth faking it for earlier revisions. 1337 system_or_die('make regen_headers'); 1338} 1339 1340unless ($options{'all-fixups'}) { 1341 patch_C(); 1342 patch_ext(); 1343} 1344 1345# Parallel build for miniperl is safe 1346system "$options{make} $j miniperl </dev/null"; 1347 1348# This is the file we expect make to create 1349my $expected_file = $target =~ /^test/ ? 't/perl' 1350 : $target eq 'Fcntl' ? "lib/auto/Fcntl/Fcntl.$Config{so}" 1351 : $target; 1352# This is the target we tell make to build in order to get $expected_file 1353my $real_target = $target eq 'Fcntl' ? $expected_file : $target; 1354 1355if ($target ne 'miniperl') { 1356 # Nearly all parallel build issues fixed by 5.10.0. Untrustworthy before that. 1357 $j = '' if $major < 10; 1358 1359 if ($real_target eq 'test_prep') { 1360 if ($major < 8) { 1361 # test-prep was added in 5.004_01, 3e3baf6d63945cb6. 1362 # renamed to test_prep in 2001 in 5fe84fd29acaf55c. 1363 # earlier than that, just make test. It will be fast enough. 1364 $real_target = extract_from_file('Makefile.SH', 1365 qr/^(test[-_]prep):/, 1366 'test'); 1367 } 1368 } 1369 1370 system "$options{make} $j $real_target </dev/null"; 1371} 1372 1373my $expected_file_found = $expected_file =~ /perl$/ 1374 ? -x $expected_file : -r $expected_file; 1375 1376if ($expected_file_found && $expected_file eq 't/perl') { 1377 # Check that it isn't actually pointing to ../miniperl, which will happen 1378 # if the sanity check ./miniperl -Ilib -MExporter -e '<?>' fails, and 1379 # Makefile tries to run minitest. 1380 1381 # Of course, helpfully sometimes it's called ../perl, other times .././perl 1382 # and who knows if that list is exhaustive... 1383 my ($dev0, $ino0) = stat 't/perl'; 1384 my ($dev1, $ino1) = stat 'perl'; 1385 unless (defined $dev0 && defined $dev1 && $dev0 == $dev1 && $ino0 == $ino1) { 1386 undef $expected_file_found; 1387 my $link = readlink $expected_file; 1388 warn "'t/perl' => '$link', not 'perl'"; 1389 die_255("Could not realink t/perl: $!") unless defined $link; 1390 } 1391} 1392 1393if ($options{'test-build'}) { 1394 report_and_exit($expected_file_found, 'could build', 'could not build', 1395 $real_target); 1396} elsif (!$expected_file_found) { 1397 skip("could not build $real_target"); 1398} 1399 1400match_and_exit($real_target, @ARGV) if $match; 1401 1402if (defined $options{'one-liner'}) { 1403 my $exe = $target =~ /^(?:perl$|test)/ ? 'perl' : 'miniperl'; 1404 unshift @ARGV, map {('-e', $_)} @{$options{'one-liner'}}; 1405 foreach (qw(c l w)) { 1406 unshift @ARGV, "-$_" if $options{$_}; 1407 } 1408 unshift @ARGV, "./$exe", '-Ilib'; 1409} 1410 1411if (-f $ARGV[0]) { 1412 my $fh = open_or_die($ARGV[0]); 1413 my $line = <$fh>; 1414 unshift @ARGV, $1, '-Ilib' 1415 if $line =~ $run_with_our_perl; 1416} 1417 1418if ($options{valgrind}) { 1419 # Turns out to be too confusing to use an optional argument with the path 1420 # of the valgrind binary, as if --valgrind takes an optional argument, 1421 # then specifying it as the last option eats the first part of the testcase. 1422 # ie this: .../bisect.pl --valgrind testcase 1423 # is treated as --valgrind=testcase and as there is no test case given, 1424 # it's an invalid commandline, bailing out with the usage message. 1425 1426 # Currently, the test script can't signal a skip with 125, so anything 1427 # non-zero would do. But to keep that option open in future, use 124 1428 unshift @ARGV, 'valgrind', '--error-exitcode=124'; 1429} 1430 1431# This is what we came here to run: 1432 1433if (exists $Config{ldlibpthname}) { 1434 require Cwd; 1435 my $varname = $Config{ldlibpthname}; 1436 my $cwd = Cwd::getcwd(); 1437 if (defined $ENV{$varname}) { 1438 $ENV{$varname} = $cwd . $Config{path_sep} . $ENV{$varname}; 1439 } else { 1440 $ENV{$varname} = $cwd; 1441 } 1442} 1443 1444run_report_and_exit(@ARGV); 1445 1446############################################################################ 1447# 1448# Patching, editing and faking routines only below here. 1449# 1450############################################################################ 1451 1452sub fake_noextensions { 1453 edit_file('config.sh', sub { 1454 my @lines = split /\n/, shift; 1455 my @ext = split /\s+/, $defines{noextensions}; 1456 foreach (@lines) { 1457 next unless /^extensions=/ || /^dynamic_ext/; 1458 foreach my $ext (@ext) { 1459 s/\b$ext( )?\b/$1/; 1460 } 1461 } 1462 return join "\n", @lines; 1463 }); 1464} 1465 1466sub force_manifest { 1467 my (@missing, @created_dirs); 1468 my $fh = open_or_die('MANIFEST'); 1469 while (<$fh>) { 1470 next unless /^(\S+)/; 1471 # -d is special case needed (at least) between 27332437a2ed1941 and 1472 # bf3d9ec563d25054^ inclusive, as manifest contains ext/Thread/Thread 1473 push @missing, $1 1474 unless -f $1 || -d $1; 1475 } 1476 close_or_die($fh); 1477 1478 foreach my $pathname (@missing) { 1479 my @parts = split '/', $pathname; 1480 my $leaf = pop @parts; 1481 my $path = '.'; 1482 while (@parts) { 1483 $path .= '/' . shift @parts; 1484 next if -d $path; 1485 mkdir $path, 0700 or die_255("Can't create $path: $!"); 1486 unshift @created_dirs, $path; 1487 } 1488 $fh = open_or_die($pathname, '>'); 1489 close_or_die($fh); 1490 chmod 0, $pathname or die_255("Can't chmod 0 $pathname: $!"); 1491 } 1492 return \@missing, \@created_dirs; 1493} 1494 1495sub force_manifest_cleanup { 1496 my ($missing, $created_dirs) = @_; 1497 # This is probably way too paranoid: 1498 my @errors; 1499 require Fcntl; 1500 foreach my $file (@$missing) { 1501 my (undef, undef, $mode, undef, undef, undef, undef, $size) 1502 = stat $file; 1503 if (!defined $mode) { 1504 push @errors, "Added file $file has been deleted by Configure"; 1505 next; 1506 } 1507 if (Fcntl::S_IMODE($mode) != 0) { 1508 push @errors, 1509 sprintf 'Added file %s had mode changed by Configure to %03o', 1510 $file, $mode; 1511 } 1512 if ($size != 0) { 1513 push @errors, 1514 "Added file $file had sized changed by Configure to $size"; 1515 } 1516 unlink $file or die_255("Can't unlink $file: $!"); 1517 } 1518 foreach my $dir (@$created_dirs) { 1519 rmdir $dir or die_255("Can't rmdir $dir: $!"); 1520 } 1521 skip("@errors") 1522 if @errors; 1523} 1524 1525sub patch_Configure { 1526 if ($major < 1) { 1527 if (extract_from_file('Configure', 1528 qr/^\t\t\*=\*\) echo "\$1" >> \$optdef;;$/)) { 1529 # This is " Spaces now allowed in -D command line options.", 1530 # part of commit ecfc54246c2a6f42 1531 apply_patch(<<'EOPATCH'); 1532diff --git a/Configure b/Configure 1533index 3d3b38d..78ffe16 100755 1534--- a/Configure 1535+++ b/Configure 1536@@ -652,7 +777,8 @@ while test $# -gt 0; do 1537 echo "$me: use '-U symbol=', not '-D symbol='." >&2 1538 echo "$me: ignoring -D $1" >&2 1539 ;; 1540- *=*) echo "$1" >> $optdef;; 1541+ *=*) echo "$1" | \ 1542+ sed -e "s/'/'\"'\"'/g" -e "s/=\(.*\)/='\1'/" >> $optdef;; 1543 *) echo "$1='define'" >> $optdef;; 1544 esac 1545 shift 1546EOPATCH 1547 } 1548 1549 if (extract_from_file('Configure', qr/^if \$contains 'd_namlen' \$xinc\b/)) { 1550 # Configure's original simple "grep" for d_namlen falls foul of the 1551 # approach taken by the glibc headers: 1552 # #ifdef _DIRENT_HAVE_D_NAMLEN 1553 # # define _D_EXACT_NAMLEN(d) ((d)->d_namlen) 1554 # 1555 # where _DIRENT_HAVE_D_NAMLEN is not defined on Linux. 1556 # This is also part of commit ecfc54246c2a6f42 1557 apply_patch(<<'EOPATCH'); 1558diff --git a/Configure b/Configure 1559index 3d3b38d..78ffe16 100755 1560--- a/Configure 1561+++ b/Configure 1562@@ -3935,7 +4045,8 @@ $rm -f try.c 1563 1564 : see if the directory entry stores field length 1565 echo " " 1566-if $contains 'd_namlen' $xinc >/dev/null 2>&1; then 1567+$cppstdin $cppflags $cppminus < "$xinc" > try.c 1568+if $contains 'd_namlen' try.c >/dev/null 2>&1; then 1569 echo "Good, your directory entry keeps length information in d_namlen." >&4 1570 val="$define" 1571 else 1572EOPATCH 1573 } 1574 } 1575 1576 if ($major < 2 1577 && !extract_from_file('Configure', 1578 qr/Try to guess additional flags to pick up local libraries/)) { 1579 my $mips = extract_from_file('Configure', 1580 qr!(''\) if (?:\./)?mips; then)!); 1581 # This is part of perl-5.001n. It's needed, to add -L/usr/local/lib to 1582 # the ld flags if libraries are found there. It shifts the code to set 1583 # up libpth earlier, and then adds the code to add libpth entries to 1584 # ldflags 1585 # mips was changed to ./mips in ecfc54246c2a6f42, perl5.000 patch.0g 1586 apply_patch(sprintf <<'EOPATCH', $mips); 1587diff --git a/Configure b/Configure 1588index 53649d5..0635a6e 100755 1589--- a/Configure 1590+++ b/Configure 1591@@ -2749,6 +2749,52 @@ EOM 1592 ;; 1593 esac 1594 1595+: Set private lib path 1596+case "$plibpth" in 1597+'') if ./mips; then 1598+ plibpth="$incpath/usr/lib /usr/local/lib /usr/ccs/lib" 1599+ fi;; 1600+esac 1601+case "$libpth" in 1602+' ') dlist='';; 1603+'') dlist="$plibpth $glibpth";; 1604+*) dlist="$libpth";; 1605+esac 1606+ 1607+: Now check and see which directories actually exist, avoiding duplicates 1608+libpth='' 1609+for xxx in $dlist 1610+do 1611+ if $test -d $xxx; then 1612+ case " $libpth " in 1613+ *" $xxx "*) ;; 1614+ *) libpth="$libpth $xxx";; 1615+ esac 1616+ fi 1617+done 1618+$cat <<'EOM' 1619+ 1620+Some systems have incompatible or broken versions of libraries. Among 1621+the directories listed in the question below, please remove any you 1622+know not to be holding relevant libraries, and add any that are needed. 1623+Say "none" for none. 1624+ 1625+EOM 1626+case "$libpth" in 1627+'') dflt='none';; 1628+*) 1629+ set X $libpth 1630+ shift 1631+ dflt=${1+"$@"} 1632+ ;; 1633+esac 1634+rp="Directories to use for library searches?" 1635+. ./myread 1636+case "$ans" in 1637+none) libpth=' ';; 1638+*) libpth="$ans";; 1639+esac 1640+ 1641 : flags used in final linking phase 1642 case "$ldflags" in 1643 '') if ./venix; then 1644@@ -2765,6 +2811,23 @@ case "$ldflags" in 1645 ;; 1646 *) dflt="$ldflags";; 1647 esac 1648+ 1649+: Possible local library directories to search. 1650+loclibpth="/usr/local/lib /opt/local/lib /usr/gnu/lib" 1651+loclibpth="$loclibpth /opt/gnu/lib /usr/GNU/lib /opt/GNU/lib" 1652+ 1653+: Try to guess additional flags to pick up local libraries. 1654+for thislibdir in $libpth; do 1655+ case " $loclibpth " in 1656+ *" $thislibdir "*) 1657+ case "$dflt " in 1658+ "-L$thislibdir ") ;; 1659+ *) dflt="$dflt -L$thislibdir" ;; 1660+ esac 1661+ ;; 1662+ esac 1663+done 1664+ 1665 echo " " 1666 rp="Any additional ld flags (NOT including libraries)?" 1667 . ./myread 1668@@ -2828,52 +2891,6 @@ n) echo "OK, that should do.";; 1669 esac 1670 $rm -f try try.* core 1671 1672-: Set private lib path 1673-case "$plibpth" in 1674-%s 1675- plibpth="$incpath/usr/lib /usr/local/lib /usr/ccs/lib" 1676- fi;; 1677-esac 1678-case "$libpth" in 1679-' ') dlist='';; 1680-'') dlist="$plibpth $glibpth";; 1681-*) dlist="$libpth";; 1682-esac 1683- 1684-: Now check and see which directories actually exist, avoiding duplicates 1685-libpth='' 1686-for xxx in $dlist 1687-do 1688- if $test -d $xxx; then 1689- case " $libpth " in 1690- *" $xxx "*) ;; 1691- *) libpth="$libpth $xxx";; 1692- esac 1693- fi 1694-done 1695-$cat <<'EOM' 1696- 1697-Some systems have incompatible or broken versions of libraries. Among 1698-the directories listed in the question below, please remove any you 1699-know not to be holding relevant libraries, and add any that are needed. 1700-Say "none" for none. 1701- 1702-EOM 1703-case "$libpth" in 1704-'') dflt='none';; 1705-*) 1706- set X $libpth 1707- shift 1708- dflt=${1+"$@"} 1709- ;; 1710-esac 1711-rp="Directories to use for library searches?" 1712-. ./myread 1713-case "$ans" in 1714-none) libpth=' ';; 1715-*) libpth="$ans";; 1716-esac 1717- 1718 : compute shared library extension 1719 case "$so" in 1720 '') 1721EOPATCH 1722 } 1723 1724 if ($major == 4 && extract_from_file('Configure', qr/^d_gethbynam=/)) { 1725 # Fixes a bug introduced in 4599a1dedd47b916 1726 apply_commit('3cbc818d1d0ac470'); 1727 } 1728 1729 if ($major == 4 && extract_from_file('Configure', 1730 qr/gethbadd_addr_type=`echo \$gethbadd_addr_type/)) { 1731 # Fixes a bug introduced in 3fd537d4b944bc7a 1732 apply_commit('6ff9219da6cf8cfd'); 1733 } 1734 1735 if ($major == 4 && extract_from_file('Configure', 1736 qr/^pthreads_created_joinable=/)) { 1737 # Fix for bug introduced in 52e1cb5ebf5e5a8c 1738 # Part of commit ce637636a41b2fef 1739 edit_file('Configure', sub { 1740 my $code = shift; 1741 $code =~ s{^pthreads_created_joinable=''} 1742 {d_pthreads_created_joinable=''}ms 1743 or die_255("Substitution failed"); 1744 $code =~ s{^pthreads_created_joinable='\$pthreads_created_joinable'} 1745 {d_pthreads_created_joinable='\$d_pthreads_created_joinable'}ms 1746 or die_255("Substitution failed"); 1747 return $code; 1748 }); 1749 } 1750 1751 if ($major < 5 && extract_from_file('Configure', 1752 qr!if \$cc \$ccflags try\.c -o try >/dev/null 2>&1; then!)) { 1753 # Analogous to the more general fix of dfe9444ca7881e71 1754 # Without this flags such as -m64 may not be passed to this compile, 1755 # which results in a byteorder of '1234' instead of '12345678', which 1756 # can then cause crashes. 1757 1758 if (extract_from_file('Configure', qr/xxx_prompt=y/)) { 1759 # 8e07c86ebc651fe9 or later 1760 # ("This is my patch patch.1n for perl5.001.") 1761 apply_patch(<<'EOPATCH'); 1762diff --git a/Configure b/Configure 1763index 62249dd..c5c384e 100755 1764--- a/Configure 1765+++ b/Configure 1766@@ -8247,7 +8247,7 @@ main() 1767 } 1768 EOCP 1769 xxx_prompt=y 1770- if $cc $ccflags try.c -o try >/dev/null 2>&1 && ./try > /dev/null; then 1771+ if $cc $ccflags $ldflags try.c -o try >/dev/null 2>&1 && ./try > /dev/null; then 1772 dflt=`./try` 1773 case "$dflt" in 1774 [1-4][1-4][1-4][1-4]|12345678|87654321) 1775EOPATCH 1776 } else { 1777 apply_patch(<<'EOPATCH'); 1778diff --git a/Configure b/Configure 1779index 53649d5..f1cd64a 100755 1780--- a/Configure 1781+++ b/Configure 1782@@ -6362,7 +6362,7 @@ main() 1783 printf("\n"); 1784 } 1785 EOCP 1786- if $cc $ccflags try.c -o try >/dev/null 2>&1 ; then 1787+ if $cc $ccflags $ldflags try.c -o try >/dev/null 2>&1 ; then 1788 dflt=`./try` 1789 case "$dflt" in 1790 ????|????????) echo "(The test program ran ok.)";; 1791EOPATCH 1792 } 1793 } 1794 1795 if ($major < 6 && !extract_from_file('Configure', 1796 qr!^\t-A\)$!)) { 1797 # This adds the -A option to Configure, which is incredibly useful 1798 # Effectively this is commits 02e93a22d20fc9a5, 5f83a3e9d818c3ad, 1799 # bde6b06b2c493fef, f7c3111703e46e0c and 2 lines of trailing whitespace 1800 # removed by 613d6c3e99b9decc, but applied at slightly different 1801 # locations to ensure a clean patch back to 5.000 1802 # Note, if considering patching to the intermediate revisions to fix 1803 # bugs in -A handling, f7c3111703e46e0c is from 2002, and hence 1804 # $major == 8 1805 1806 # To add to the fun, early patches add -K and -O options, and it's not 1807 # trivial to get patch to put the C<. ./posthint.sh> in the right place 1808 edit_file('Configure', sub { 1809 my $code = shift; 1810 $code =~ s/(optstr = ")([^"]+";\s*# getopt-style specification)/$1A:$2/ 1811 or die_255("Substitution failed"); 1812 $code =~ s!^(: who configured the system)! 1813touch posthint.sh 1814. ./posthint.sh 1815 1816$1!ms 1817 or die_255("Substitution failed"); 1818 return $code; 1819 }); 1820 apply_patch(<<'EOPATCH'); 1821diff --git a/Configure b/Configure 1822index 4b55fa6..60c3c64 100755 1823--- a/Configure 1824+++ b/Configure 1825@@ -1150,6 +1150,7 @@ set X `for arg in "$@"; do echo "X$arg"; done | 1826 eval "set $*" 1827 shift 1828 rm -f options.awk 1829+rm -f posthint.sh 1830 1831 : set up default values 1832 fastread='' 1833@@ -1172,6 +1173,56 @@ while test $# -gt 0; do 1834 case "$1" in 1835 -d) shift; fastread=yes;; 1836 -e) shift; alldone=cont;; 1837+ -A) 1838+ shift 1839+ xxx='' 1840+ yyy="$1" 1841+ zzz='' 1842+ uuu=undef 1843+ case "$yyy" in 1844+ *=*) zzz=`echo "$yyy"|sed 's!=.*!!'` 1845+ case "$zzz" in 1846+ *:*) zzz='' ;; 1847+ *) xxx=append 1848+ zzz=" "`echo "$yyy"|sed 's!^[^=]*=!!'` 1849+ yyy=`echo "$yyy"|sed 's!=.*!!'` ;; 1850+ esac 1851+ ;; 1852+ esac 1853+ case "$xxx" in 1854+ '') case "$yyy" in 1855+ *:*) xxx=`echo "$yyy"|sed 's!:.*!!'` 1856+ yyy=`echo "$yyy"|sed 's!^[^:]*:!!'` 1857+ zzz=`echo "$yyy"|sed 's!^[^=]*=!!'` 1858+ yyy=`echo "$yyy"|sed 's!=.*!!'` ;; 1859+ *) xxx=`echo "$yyy"|sed 's!:.*!!'` 1860+ yyy=`echo "$yyy"|sed 's!^[^:]*:!!'` ;; 1861+ esac 1862+ ;; 1863+ esac 1864+ case "$xxx" in 1865+ append) 1866+ echo "$yyy=\"\${$yyy}$zzz\"" >> posthint.sh ;; 1867+ clear) 1868+ echo "$yyy=''" >> posthint.sh ;; 1869+ define) 1870+ case "$zzz" in 1871+ '') zzz=define ;; 1872+ esac 1873+ echo "$yyy='$zzz'" >> posthint.sh ;; 1874+ eval) 1875+ echo "eval \"$yyy=$zzz\"" >> posthint.sh ;; 1876+ prepend) 1877+ echo "$yyy=\"$zzz\${$yyy}\"" >> posthint.sh ;; 1878+ undef) 1879+ case "$zzz" in 1880+ '') zzz="$uuu" ;; 1881+ esac 1882+ echo "$yyy=$zzz" >> posthint.sh ;; 1883+ *) echo "$me: unknown -A command '$xxx', ignoring -A $1" >&2 ;; 1884+ esac 1885+ shift 1886+ ;; 1887 -f) 1888 shift 1889 cd .. 1890EOPATCH 1891 } 1892 1893 if ($major < 8 && $^O eq 'aix') { 1894 edit_file('Configure', sub { 1895 my $code = shift; 1896 # Replicate commit a8c676c69574838b 1897 # Whitespace allowed at the ends of /lib/syscalls.exp lines 1898 # and half of commit c6912327ae30e6de 1899 # AIX syscalls.exp scan: the syscall might be marked 32, 3264, or 64 1900 $code =~ s{(\bsed\b.*\bsyscall)(?:\[0-9\]\*)?(\$.*/lib/syscalls\.exp)} 1901 {$1 . "[0-9]*[ \t]*" . $2}e; 1902 return $code; 1903 }); 1904 } 1905 1906 if ($major < 8 && !extract_from_file('Configure', 1907 qr/^\t\tif test ! -t 0; then$/)) { 1908 # Before dfe9444ca7881e71, Configure would refuse to run if stdin was 1909 # not a tty. With that commit, the tty requirement was dropped for -de 1910 # and -dE 1911 # Commit aaeb8e512e8e9e14 dropped the tty requirement for -S 1912 # For those older versions, it's probably easiest if we simply remove 1913 # the sanity test. 1914 edit_file('Configure', sub { 1915 my $code = shift; 1916 $code =~ s/test ! -t 0/test Perl = rules/; 1917 return $code; 1918 }); 1919 } 1920 1921 if ($major == 8 || $major == 9) { 1922 # Fix symbol detection to that of commit 373dfab3839ca168 if it's any 1923 # intermediate version 5129fff43c4fe08c or later, as the intermediate 1924 # versions don't work correctly on (at least) Sparc Linux. 1925 # 5129fff43c4fe08c adds the first mention of mistrustnm. 1926 # 373dfab3839ca168 removes the last mention of lc="" 1927 edit_file('Configure', sub { 1928 my $code = shift; 1929 return $code 1930 if $code !~ /\btc="";/; # 373dfab3839ca168 or later 1931 return $code 1932 if $code !~ /\bmistrustnm\b/; # before 5129fff43c4fe08c 1933 my $fixed = <<'EOC'; 1934 1935: is a C symbol defined? 1936csym='tlook=$1; 1937case "$3" in 1938-v) tf=libc.tmp; tdc="";; 1939-a) tf=libc.tmp; tdc="[]";; 1940*) tlook="^$1\$"; tf=libc.list; tdc="()";; 1941esac; 1942tx=yes; 1943case "$reuseval-$4" in 1944true-) ;; 1945true-*) tx=no; eval "tval=\$$4"; case "$tval" in "") tx=yes;; esac;; 1946esac; 1947case "$tx" in 1948yes) 1949 tval=false; 1950 if $test "$runnm" = true; then 1951 if $contains $tlook $tf >/dev/null 2>&1; then 1952 tval=true; 1953 elif $test "$mistrustnm" = compile -o "$mistrustnm" = run; then 1954 echo "void *(*(p()))$tdc { extern void *$1$tdc; return &$1; } int main() { if(p()) return(0); else return(1); }"> try.c; 1955 $cc -o try $optimize $ccflags $ldflags try.c >/dev/null 2>&1 $libs && tval=true; 1956 $test "$mistrustnm" = run -a -x try && { $run ./try$_exe >/dev/null 2>&1 || tval=false; }; 1957 $rm -f try$_exe try.c core core.* try.core; 1958 fi; 1959 else 1960 echo "void *(*(p()))$tdc { extern void *$1$tdc; return &$1; } int main() { if(p()) return(0); else return(1); }"> try.c; 1961 $cc -o try $optimize $ccflags $ldflags try.c $libs >/dev/null 2>&1 && tval=true; 1962 $rm -f try$_exe try.c; 1963 fi; 1964 ;; 1965*) 1966 case "$tval" in 1967 $define) tval=true;; 1968 *) tval=false;; 1969 esac; 1970 ;; 1971esac; 1972eval "$2=$tval"' 1973 1974EOC 1975 $code =~ s/\n: is a C symbol defined\?\n.*?\neval "\$2=\$tval"'\n\n/$fixed/sm 1976 or die_255("substitution failed"); 1977 return $code; 1978 }); 1979 } 1980 1981 if ($major < 10 1982 && extract_from_file('Configure', qr/^set malloc\.h i_malloc$/)) { 1983 # This is commit 01d07975f7ef0e7d, trimmed, with $compile inlined as 1984 # prior to bd9b35c97ad661cc Configure had the malloc.h test before the 1985 # definition of $compile. 1986 apply_patch(<<'EOPATCH'); 1987diff --git a/Configure b/Configure 1988index 3d2e8b9..6ce7766 100755 1989--- a/Configure 1990+++ b/Configure 1991@@ -6743,5 +6743,22 @@ set d_dosuid 1992 1993 : see if this is a malloc.h system 1994-set malloc.h i_malloc 1995-eval $inhdr 1996+: we want a real compile instead of Inhdr because some systems have a 1997+: malloc.h that just gives a compile error saying to use stdlib.h instead 1998+echo " " 1999+$cat >try.c <<EOCP 2000+#include <stdlib.h> 2001+#include <malloc.h> 2002+int main () { return 0; } 2003+EOCP 2004+set try 2005+if $cc $optimize $ccflags $ldflags -o try $* try.c $libs > /dev/null 2>&1; then 2006+ echo "<malloc.h> found." >&4 2007+ val="$define" 2008+else 2009+ echo "<malloc.h> NOT found." >&4 2010+ val="$undef" 2011+fi 2012+$rm -f try.c try 2013+set i_malloc 2014+eval $setvar 2015 2016EOPATCH 2017 } 2018} 2019 2020sub patch_hints { 2021 if ($^O eq 'freebsd') { 2022 # There are rather too many version-specific FreeBSD hints fixes to 2023 # patch individually. Also, more than once the FreeBSD hints file has 2024 # been written in what turned out to be a rather non-future-proof style, 2025 # with case statements treating the most recent version as the 2026 # exception, instead of treating previous versions' behaviour explicitly 2027 # and changing the default to cater for the current behaviour. (As 2028 # strangely, future versions inherit the current behaviour.) 2029 checkout_file('hints/freebsd.sh'); 2030 } elsif ($^O eq 'darwin') { 2031 if ($major < 8) { 2032 # We can't build on darwin without some of the data in the hints 2033 # file. Probably less surprising to use the earliest version of 2034 # hints/darwin.sh and then edit in place just below, than use 2035 # blead's version, as that would create a discontinuity at 2036 # f556e5b971932902 - before it, hints bugs would be "fixed", after 2037 # it they'd resurface. This way, we should give the illusion of 2038 # monotonic bug fixing. 2039 my $faking_it; 2040 if (!-f 'hints/darwin.sh') { 2041 checkout_file('hints/darwin.sh', 'f556e5b971932902'); 2042 ++$faking_it; 2043 } 2044 2045 edit_file('hints/darwin.sh', sub { 2046 my $code = shift; 2047 # Part of commit 8f4f83badb7d1ba9, which mostly undoes 2048 # commit 0511a818910f476c. 2049 $code =~ s/^cppflags='-traditional-cpp';$/cppflags="\${cppflags} -no-cpp-precomp"/m; 2050 # commit 14c11978e9b52e08/803bb6cc74d36a3f 2051 # Without this, code in libperl.bundle links against op.o 2052 # in preference to opmini.o on the linker command line, 2053 # and hence miniperl tries to use File::Glob instead of 2054 # csh 2055 $code =~ s/^(lddlflags=)/ldflags="\${ldflags} -flat_namespace"\n$1/m; 2056 # f556e5b971932902 also patches Makefile.SH with some 2057 # special case code to deal with useshrplib for darwin. 2058 # Given that post 5.8.0 the darwin hints default was 2059 # changed to false, and it would be very complex to splice 2060 # in that code in various versions of Makefile.SH back 2061 # to 5.002, lets just turn it off. 2062 $code =~ s/^useshrplib='true'/useshrplib='false'/m 2063 if $faking_it; 2064 2065 # Part of commit d235852b65d51c44 2066 # Don't do this on a case sensitive HFS+ partition, as it 2067 # breaks the build for 5.003 and earlier. 2068 if ($case_insensitive 2069 && $code !~ /^firstmakefile=GNUmakefile/) { 2070 $code .= "\nfirstmakefile=GNUmakefile;\n"; 2071 } 2072 2073 return $code; 2074 }); 2075 } 2076 } elsif ($^O eq 'netbsd') { 2077 if ($major < 6) { 2078 # These are part of commit 099685bc64c7dbce 2079 edit_file('hints/netbsd.sh', sub { 2080 my $code = shift; 2081 my $fixed = <<'EOC'; 2082case "$osvers" in 20830.9|0.8*) 2084 usedl="$undef" 2085 ;; 2086*) 2087 if [ -f /usr/libexec/ld.elf_so ]; then 2088 d_dlopen=$define 2089 d_dlerror=$define 2090 ccdlflags="-Wl,-E -Wl,-R${PREFIX}/lib $ccdlflags" 2091 cccdlflags="-DPIC -fPIC $cccdlflags" 2092 lddlflags="--whole-archive -shared $lddlflags" 2093 elif [ "`uname -m`" = "pmax" ]; then 2094# NetBSD 1.3 and 1.3.1 on pmax shipped an 'old' ld.so, which will not work. 2095 d_dlopen=$undef 2096 elif [ -f /usr/libexec/ld.so ]; then 2097 d_dlopen=$define 2098 d_dlerror=$define 2099 ccdlflags="-Wl,-R${PREFIX}/lib $ccdlflags" 2100# we use -fPIC here because -fpic is *NOT* enough for some of the 2101# extensions like Tk on some netbsd platforms (the sparc is one) 2102 cccdlflags="-DPIC -fPIC $cccdlflags" 2103 lddlflags="-Bforcearchive -Bshareable $lddlflags" 2104 else 2105 d_dlopen=$undef 2106 fi 2107 ;; 2108esac 2109EOC 2110 $code =~ s/^case "\$osvers" in\n0\.9\|0\.8.*?^esac\n/$fixed/ms; 2111 return $code; 2112 }); 2113 } 2114 } elsif ($^O eq 'openbsd') { 2115 if ($major < 8) { 2116 checkout_file('hints/openbsd.sh', '43051805d53a3e4c') 2117 unless -f 'hints/openbsd.sh'; 2118 my $which = extract_from_file('hints/openbsd.sh', 2119 qr/# from (2\.8|3\.1) onwards/, 2120 ''); 2121 if ($which eq '') { 2122 my $was = extract_from_file('hints/openbsd.sh', 2123 qr/(lddlflags="(?:-Bforcearchive )?-Bshareable)/); 2124 # This is commit 154d43cbcf57271c and parts of 5c75dbfa77b0949c 2125 # and 29b5585702e5e025 2126 apply_patch(sprintf <<'EOPATCH', $was); 2127diff --git a/hints/openbsd.sh b/hints/openbsd.sh 2128index a7d8bf2..5b79709 100644 2129--- a/hints/openbsd.sh 2130+++ b/hints/openbsd.sh 2131@@ -37,7 +37,25 @@ OpenBSD.alpha|OpenBSD.mips|OpenBSD.powerpc|OpenBSD.vax) 2132 # we use -fPIC here because -fpic is *NOT* enough for some of the 2133 # extensions like Tk on some OpenBSD platforms (ie: sparc) 2134 cccdlflags="-DPIC -fPIC $cccdlflags" 2135- %s $lddlflags" 2136+ case "$osvers" in 2137+ [01].*|2.[0-7]|2.[0-7].*) 2138+ lddlflags="-Bshareable $lddlflags" 2139+ ;; 2140+ 2.[8-9]|3.0) 2141+ ld=${cc:-cc} 2142+ lddlflags="-shared -fPIC $lddlflags" 2143+ ;; 2144+ *) # from 3.1 onwards 2145+ ld=${cc:-cc} 2146+ lddlflags="-shared -fPIC $lddlflags" 2147+ libswanted=`echo $libswanted | sed 's/ dl / /'` 2148+ ;; 2149+ esac 2150+ 2151+ # We need to force ld to export symbols on ELF platforms. 2152+ # Without this, dlopen() is crippled. 2153+ ELF=`${cc:-cc} -dM -E - </dev/null | grep __ELF__` 2154+ test -n "$ELF" && ldflags="-Wl,-E $ldflags" 2155 ;; 2156 esac 2157 2158EOPATCH 2159 } elsif ($which eq '2.8') { 2160 # This is parts of 5c75dbfa77b0949c and 29b5585702e5e025, and 2161 # possibly eb9cd59d45ad2908 2162 my $was = extract_from_file('hints/openbsd.sh', 2163 qr/lddlflags="(-shared(?: -fPIC)?) \$lddlflags"/); 2164 2165 apply_patch(sprintf <<'EOPATCH', $was); 2166--- a/hints/openbsd.sh 2011-10-21 17:25:20.000000000 +0200 2167+++ b/hints/openbsd.sh 2011-10-21 16:58:43.000000000 +0200 2168@@ -44,11 +44,21 @@ 2169 [01].*|2.[0-7]|2.[0-7].*) 2170 lddlflags="-Bshareable $lddlflags" 2171 ;; 2172- *) # from 2.8 onwards 2173+ 2.[8-9]|3.0) 2174 ld=${cc:-cc} 2175- lddlflags="%s $lddlflags" 2176+ lddlflags="-shared -fPIC $lddlflags" 2177+ ;; 2178+ *) # from 3.1 onwards 2179+ ld=${cc:-cc} 2180+ lddlflags="-shared -fPIC $lddlflags" 2181+ libswanted=`echo $libswanted | sed 's/ dl / /'` 2182 ;; 2183 esac 2184+ 2185+ # We need to force ld to export symbols on ELF platforms. 2186+ # Without this, dlopen() is crippled. 2187+ ELF=`${cc:-cc} -dM -E - </dev/null | grep __ELF__` 2188+ test -n "$ELF" && ldflags="-Wl,-E $ldflags" 2189 ;; 2190 esac 2191 2192EOPATCH 2193 } elsif ($which eq '3.1' 2194 && !extract_from_file('hints/openbsd.sh', 2195 qr/We need to force ld to export symbols on ELF platforms/)) { 2196 # This is part of 29b5585702e5e025 2197 apply_patch(<<'EOPATCH'); 2198diff --git a/hints/openbsd.sh b/hints/openbsd.sh 2199index c6b6bc9..4839d04 100644 2200--- a/hints/openbsd.sh 2201+++ b/hints/openbsd.sh 2202@@ -54,6 +54,11 @@ alpha-2.[0-8]|mips-*|vax-*|powerpc-2.[0-7]|m88k-*) 2203 libswanted=`echo $libswanted | sed 's/ dl / /'` 2204 ;; 2205 esac 2206+ 2207+ # We need to force ld to export symbols on ELF platforms. 2208+ # Without this, dlopen() is crippled. 2209+ ELF=`${cc:-cc} -dM -E - </dev/null | grep __ELF__` 2210+ test -n "$ELF" && ldflags="-Wl,-E $ldflags" 2211 ;; 2212 esac 2213 2214EOPATCH 2215 } 2216 } 2217 } elsif ($^O eq 'linux') { 2218 if ($major < 1) { 2219 # sparc linux seems to need the -Dbool=char -DHAS_BOOL part of 2220 # perl5.000 patch.0n: [address Configure and build issues] 2221 edit_file('hints/linux.sh', sub { 2222 my $code = shift; 2223 $code =~ s!-I/usr/include/bsd!-Dbool=char -DHAS_BOOL!g; 2224 return $code; 2225 }); 2226 } 2227 2228 if ($major <= 9) { 2229 if (`uname -sm` =~ qr/^Linux sparc/) { 2230 if (extract_from_file('hints/linux.sh', qr/sparc-linux/)) { 2231 # Be sure to use -fPIC not -fpic on Linux/SPARC 2232 apply_commit('f6527d0ef0c13ad4'); 2233 } elsif(!extract_from_file('hints/linux.sh', 2234 qr/^sparc-linux\)$/)) { 2235 my $fh = open_or_die('hints/linux.sh', '>>'); 2236 print $fh <<'EOT' or die_255($!); 2237 2238case "`uname -m`" in 2239sparc*) 2240 case "$cccdlflags" in 2241 *-fpic*) cccdlflags="`echo $cccdlflags|sed 's/-fpic/-fPIC/'`" ;; 2242 *) cccdlflags="$cccdlflags -fPIC" ;; 2243 esac 2244 ;; 2245esac 2246EOT 2247 close_or_die($fh); 2248 } 2249 } 2250 } 2251 } elsif ($^O eq 'solaris') { 2252 if (($major == 13 || $major == 14) 2253 && extract_from_file('hints/solaris_2.sh', qr/getconfldllflags/)) { 2254 apply_commit('c80bde4388070c45'); 2255 } 2256 } 2257} 2258 2259sub patch_SH { 2260 # Cwd.xs added in commit 0d2079faa739aaa9. Cwd.pm moved to ext/ 8 years 2261 # later in commit 403f501d5b37ebf0 2262 if ($major > 0 && <*/Cwd/Cwd.xs>) { 2263 if ($major < 10 2264 && !extract_from_file('Makefile.SH', qr/^extra_dep=''$/)) { 2265 # The Makefile.PL for Unicode::Normalize needs 2266 # lib/unicore/CombiningClass.pl. Even without a parallel build, we 2267 # need a dependency to ensure that it builds. This is a variant of 2268 # commit 9f3ef600c170f61e. Putting this for earlier versions gives 2269 # us a spot on which to hang the edits below 2270 apply_patch(<<'EOPATCH'); 2271diff --git a/Makefile.SH b/Makefile.SH 2272index f61d0db..6097954 100644 2273--- a/Makefile.SH 2274+++ b/Makefile.SH 2275@@ -155,10 +155,20 @@ esac 2276 2277 : Prepare dependency lists for Makefile. 2278 dynamic_list=' ' 2279+extra_dep='' 2280 for f in $dynamic_ext; do 2281 : the dependency named here will never exist 2282 base=`echo "$f" | sed 's/.*\///'` 2283- dynamic_list="$dynamic_list lib/auto/$f/$base.$dlext" 2284+ this_target="lib/auto/$f/$base.$dlext" 2285+ dynamic_list="$dynamic_list $this_target" 2286+ 2287+ : Parallel makes reveal that we have some interdependencies 2288+ case $f in 2289+ Math/BigInt/FastCalc) extra_dep="$extra_dep 2290+$this_target: lib/auto/List/Util/Util.$dlext" ;; 2291+ Unicode/Normalize) extra_dep="$extra_dep 2292+$this_target: lib/unicore/CombiningClass.pl" ;; 2293+ esac 2294 done 2295 2296 static_list=' ' 2297@@ -987,2 +997,9 @@ n_dummy $(nonxs_ext): miniperl$(EXE_EXT) preplibrary $(DYNALOADER) FORCE 2298 @$(LDLIBPTH) sh ext/util/make_ext nonxs $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL) 2299+!NO!SUBS! 2300+ 2301+$spitshell >>Makefile <<EOF 2302+$extra_dep 2303+EOF 2304+ 2305+$spitshell >>Makefile <<'!NO!SUBS!' 2306 2307EOPATCH 2308 } 2309 2310 if ($major == 15 && $^O !~ /^(linux|darwin|.*bsd)$/ 2311 && extract_from_file('Makefile.SH', qr/^V.* \?= /)) { 2312 # Remove the GNU-make-ism (which the BSD makes also support, but 2313 # most other makes choke on) 2314 apply_patch(<<'EOPATCH'); 2315diff --git a/Makefile.SH b/Makefile.SH 2316index 94952bd..13e9001 100755 2317--- a/Makefile.SH 2318+++ b/Makefile.SH 2319@@ -338,8 +338,8 @@ linux*|darwin) 2320 $spitshell >>$Makefile <<!GROK!THIS! 2321 # If you're going to use valgrind and it can't be invoked as plain valgrind 2322 # then you'll need to change this, or override it on the make command line. 2323-VALGRIND ?= valgrind 2324-VG_TEST ?= ./perl -e 1 2>/dev/null 2325+VALGRIND = valgrind 2326+VG_TEST = ./perl -e 1 2>/dev/null 2327 2328 !GROK!THIS! 2329 ;; 2330EOPATCH 2331 } 2332 2333 if ($major == 11) { 2334 if (extract_from_file('patchlevel.h', 2335 qr/^#include "unpushed\.h"/)) { 2336 # I had thought it easier to detect when building one of the 52 2337 # commits with the original method of incorporating the git 2338 # revision and drop parallel make flags. Commits shown by 2339 # git log 46807d8e809cc127^..dcff826f70bf3f64^ ^d4fb0a1f15d1a1c4 2340 # However, it's not actually possible to make miniperl for that 2341 # configuration as-is, because the file .patchnum is only made 2342 # as a side effect of target 'all' 2343 # I also don't think that it's "safe" to simply run 2344 # make_patchnum.sh before the build. We need the proper 2345 # dependency rules in the Makefile to *stop* it being run again 2346 # at the wrong time. 2347 # This range is important because contains the commit that 2348 # merges Schwern's y2038 work. 2349 apply_patch(<<'EOPATCH'); 2350diff --git a/Makefile.SH b/Makefile.SH 2351index 9ad8b6f..106e721 100644 2352--- a/Makefile.SH 2353+++ b/Makefile.SH 2354@@ -540,9 +544,14 @@ sperl.i: perl.c $(h) 2355 2356 .PHONY: all translators utilities make_patchnum 2357 2358-make_patchnum: 2359+make_patchnum: lib/Config_git.pl 2360+ 2361+lib/Config_git.pl: make_patchnum.sh 2362 sh $(shellflags) make_patchnum.sh 2363 2364+# .patchnum, unpushed.h and lib/Config_git.pl are built by make_patchnum.sh 2365+unpushed.h .patchnum: lib/Config_git.pl 2366+ 2367 # make sure that we recompile perl.c if .patchnum changes 2368 perl$(OBJ_EXT): .patchnum unpushed.h 2369 2370EOPATCH 2371 } elsif (-f '.gitignore' 2372 && extract_from_file('.gitignore', qr/^\.patchnum$/)) { 2373 # 8565263ab8a47cda to 46807d8e809cc127^ inclusive. 2374 edit_file('Makefile.SH', sub { 2375 my $code = shift; 2376 $code =~ s/^make_patchnum:\n/make_patchnum: .patchnum 2377 2378.sha1: .patchnum 2379 2380.patchnum: make_patchnum.sh 2381/m; 2382 return $code; 2383 }); 2384 } elsif (-f 'lib/.gitignore' 2385 && extract_from_file('lib/.gitignore', 2386 qr!^/Config_git.pl!) 2387 && !extract_from_file('Makefile.SH', 2388 qr/^uudmap\.h.*:bitcount.h$/)) { 2389 # Between commits and dcff826f70bf3f64 and 0f13ebd5d71f8177^ 2390 edit_file('Makefile.SH', sub { 2391 my $code = shift; 2392 # Bug introduced by 344af494c35a9f0f 2393 # fixed in 0f13ebd5d71f8177 2394 $code =~ s{^(pod/perlapi\.pod) (pod/perlintern\.pod): } 2395 {$1: $2\n\n$2: }m; 2396 # Bug introduced by efa50c51e3301a2c 2397 # fixed in 0f13ebd5d71f8177 2398 $code =~ s{^(uudmap\.h) (bitcount\.h): } 2399 {$1: $2\n\n$2: }m; 2400 2401 # The rats nest of getting git_version.h correct 2402 2403 if ($code =~ s{git_version\.h: stock_git_version\.h 2404\tcp stock_git_version\.h git_version\.h} 2405 {}m) { 2406 # before 486cd780047ff224 2407 2408 # We probably can't build between 2409 # 953f6acfa20ec275^ and 8565263ab8a47cda 2410 # inclusive, but all commits in that range 2411 # relate to getting make_patchnum.sh working, 2412 # so it is extremely unlikely to be an 2413 # interesting bisect target. They will skip. 2414 2415 # No, don't spawn a submake if 2416 # make_patchnum.sh or make_patchnum.pl fails 2417 $code =~ s{\|\| \$\(MAKE\) miniperl.*} 2418 {}m; 2419 $code =~ s{^\t(sh.*make_patchnum\.sh.*)} 2420 {\t-$1}m; 2421 2422 # Use an external perl to run make_patchnum.pl 2423 # because miniperl still depends on 2424 # git_version.h 2425 $code =~ s{^\t.*make_patchnum\.pl} 2426 {\t-$^X make_patchnum.pl}m; 2427 2428 2429 # "Truth in advertising" - running 2430 # make_patchnum generates 2 files. 2431 $code =~ s{^make_patchnum:.*}{ 2432make_patchnum: lib/Config_git.pl 2433 2434git_version.h: lib/Config_git.pl 2435 2436perlmini\$(OBJ_EXT): git_version.h 2437 2438lib/Config_git.pl:}m; 2439 } 2440 # Right, now we've corrected Makefile.SH to 2441 # correctly describe how lib/Config_git.pl and 2442 # git_version.h are made, we need to fix the rest 2443 2444 # This emulates commit 2b63e250843b907e 2445 # This might duplicate the rule stating that 2446 # git_version.h depends on lib/Config_git.pl 2447 # This is harmless. 2448 $code =~ s{^(?:lib/Config_git\.pl )?git_version\.h: (.* make_patchnum\.pl.*)} 2449 {git_version.h: lib/Config_git.pl 2450 2451lib/Config_git.pl: $1}m; 2452 2453 # This emulates commits 0f13ebd5d71f8177 and 2454 # and a04d4598adc57886. It ensures that 2455 # lib/Config_git.pl is built before configpm, 2456 # and that configpm is run exactly once. 2457 $code =~ s{^(\$\(.*?\) )?(\$\(CONFIGPOD\))(: .*? configpm Porting/Glossary)( lib/Config_git\.pl)?}{ 2458 # If present, other files depend on $(CONFIGPOD) 2459 ($1 ? "$1: $2\n\n" : '') 2460 # Then the rule we found 2461 . $2 . $3 2462 # Add dependency if not there 2463 . ($4 ? $4 : ' lib/Config_git.pl') 2464 }me; 2465 2466 return $code; 2467 }); 2468 } 2469 } 2470 2471 if ($major < 14) { 2472 # Commits dc0655f797469c47 and d11a62fe01f2ecb2 2473 edit_file('Makefile.SH', sub { 2474 my $code = shift; 2475 foreach my $ext (qw(Encode SDBM_File)) { 2476 next if $code =~ /\b$ext\) extra_dep=/s; 2477 $code =~ s!(\) extra_dep="\$extra_dep 2478\$this_target: .*?" ;;) 2479( esac 2480)!$1 2481 $ext) extra_dep="\$extra_dep 2482\$this_target: lib/auto/Cwd/Cwd.\$dlext" ;; 2483$2!; 2484 } 2485 return $code; 2486 }); 2487 } 2488 } 2489 2490 if ($major == 7) { 2491 # Remove commits 9fec149bb652b6e9 and 5bab1179608f81d8, which add/amend 2492 # rules to automatically run regen scripts that rebuild C headers. These 2493 # cause problems because a git checkout doesn't preserve relative file 2494 # modification times, hence the regen scripts may fire. This will 2495 # obscure whether the repository had the correct generated headers 2496 # checked in. 2497 # Also, the dependency rules for running the scripts were not correct, 2498 # which could cause spurious re-builds on re-running make, and can cause 2499 # complete build failures for a parallel make. 2500 if (extract_from_file('Makefile.SH', 2501 qr/Writing it this way gives make a big hint to always run opcode\.pl before/)) { 2502 apply_commit('70c6e6715e8fec53'); 2503 } elsif (extract_from_file('Makefile.SH', 2504 qr/^opcode\.h opnames\.h pp_proto\.h pp\.sym: opcode\.pl$/)) { 2505 revert_commit('9fec149bb652b6e9'); 2506 } 2507 } 2508 2509 if ($^O eq 'aix' && $major >= 11 && $major <= 15 2510 && extract_from_file('makedef.pl', qr/^use Config/)) { 2511 edit_file('Makefile.SH', sub { 2512 # The AIX part of commit e6807d8ab22b761c 2513 # It's safe to substitute lib/Config.pm for config.sh 2514 # as lib/Config.pm depends on config.sh 2515 # If the tree is post e6807d8ab22b761c, the substitution 2516 # won't match, which is harmless. 2517 my $code = shift; 2518 $code =~ s{^(perl\.exp:.* )config\.sh(\b.*)} 2519 {$1 . '$(CONFIGPM)' . $2}me; 2520 return $code; 2521 }); 2522 } 2523 2524 # There was a bug in makedepend.SH which was fixed in version 96a8704c. 2525 # Symptom was './makedepend: 1: Syntax error: Unterminated quoted string' 2526 # Remove this if you're actually bisecting a problem related to 2527 # makedepend.SH 2528 # If you do this, you may need to add in code to correct the output of older 2529 # makedepends, which don't correctly filter newer gcc output such as 2530 # <built-in> 2531 checkout_file('makedepend.SH'); 2532 2533 if ($major < 4 && -f 'config.sh' 2534 && !extract_from_file('config.sh', qr/^trnl=/)) { 2535 # This seems to be necessary to avoid makedepend becoming confused, 2536 # and hanging on stdin. Seems that the code after 2537 # make shlist || ...here... is never run. 2538 edit_file('makedepend.SH', sub { 2539 my $code = shift; 2540 $code =~ s/^trnl='\$trnl'$/trnl='\\n'/m; 2541 return $code; 2542 }); 2543 } 2544} 2545 2546sub patch_C { 2547 # This is ordered by $major, as it's likely that different platforms may 2548 # well want to share code. 2549 2550 if ($major == 2 && extract_from_file('perl.c', qr/^\tfclose\(e_fp\);$/)) { 2551 # need to patch perl.c to avoid calling fclose() twice on e_fp when 2552 # using -e 2553 # This diff is part of commit ab821d7fdc14a438. The second close was 2554 # introduced with perl-5.002, commit a5f75d667838e8e7 2555 # Might want a6c477ed8d4864e6 too, for the corresponding change to 2556 # pp_ctl.c (likely without this, eval will have "fun") 2557 apply_patch(<<'EOPATCH'); 2558diff --git a/perl.c b/perl.c 2559index 03c4d48..3c814a2 100644 2560--- a/perl.c 2561+++ b/perl.c 2562@@ -252,6 +252,7 @@ setuid perl scripts securely.\n"); 2563 #ifndef VMS /* VMS doesn't have environ array */ 2564 origenviron = environ; 2565 #endif 2566+ e_tmpname = Nullch; 2567 2568 if (do_undump) { 2569 2570@@ -405,6 +406,7 @@ setuid perl scripts securely.\n"); 2571 if (e_fp) { 2572 if (Fflush(e_fp) || ferror(e_fp) || fclose(e_fp)) 2573 croak("Can't write to temp file for -e: %s", Strerror(errno)); 2574+ e_fp = Nullfp; 2575 argc++,argv--; 2576 scriptname = e_tmpname; 2577 } 2578@@ -470,10 +472,10 @@ setuid perl scripts securely.\n"); 2579 curcop->cop_line = 0; 2580 curstash = defstash; 2581 preprocess = FALSE; 2582- if (e_fp) { 2583- fclose(e_fp); 2584- e_fp = Nullfp; 2585+ if (e_tmpname) { 2586 (void)UNLINK(e_tmpname); 2587+ Safefree(e_tmpname); 2588+ e_tmpname = Nullch; 2589 } 2590 2591 /* now that script is parsed, we can modify record separator */ 2592@@ -1369,7 +1371,7 @@ SV *sv; 2593 scriptname = xfound; 2594 } 2595 2596- origfilename = savepv(e_fp ? "-e" : scriptname); 2597+ origfilename = savepv(e_tmpname ? "-e" : scriptname); 2598 curcop->cop_filegv = gv_fetchfile(origfilename); 2599 if (strEQ(origfilename,"-")) 2600 scriptname = ""; 2601 2602EOPATCH 2603 } 2604 2605 if ($major < 3 && $^O eq 'openbsd' 2606 && !extract_from_file('pp_sys.c', qr/BSD_GETPGRP/)) { 2607 # Part of commit c3293030fd1b7489 2608 apply_patch(<<'EOPATCH'); 2609diff --git a/pp_sys.c b/pp_sys.c 2610index 4608a2a..f0c9d1d 100644 2611--- a/pp_sys.c 2612+++ b/pp_sys.c 2613@@ -2903,8 +2903,8 @@ PP(pp_getpgrp) 2614 pid = 0; 2615 else 2616 pid = SvIVx(POPs); 2617-#ifdef USE_BSDPGRP 2618- value = (I32)getpgrp(pid); 2619+#ifdef BSD_GETPGRP 2620+ value = (I32)BSD_GETPGRP(pid); 2621 #else 2622 if (pid != 0) 2623 DIE("POSIX getpgrp can't take an argument"); 2624@@ -2933,8 +2933,8 @@ PP(pp_setpgrp) 2625 } 2626 2627 TAINT_PROPER("setpgrp"); 2628-#ifdef USE_BSDPGRP 2629- SETi( setpgrp(pid, pgrp) >= 0 ); 2630+#ifdef BSD_SETPGRP 2631+ SETi( BSD_SETPGRP(pid, pgrp) >= 0 ); 2632 #else 2633 if ((pgrp != 0) || (pid != 0)) { 2634 DIE("POSIX setpgrp can't take an argument"); 2635EOPATCH 2636 } 2637 2638 if ($major < 4 && $^O eq 'openbsd') { 2639 my $bad; 2640 # Need changes from commit a6e633defa583ad5. 2641 # Commits c07a80fdfe3926b5 and f82b3d4130164d5f changed the same part 2642 # of perl.h 2643 2644 if (extract_from_file('perl.h', 2645 qr/^#ifdef HAS_GETPGRP2$/)) { 2646 $bad = <<'EOBAD'; 2647*************** 2648*** 57,71 **** 2649 #define TAINT_PROPER(s) if (tainting) taint_proper(no_security, s) 2650 #define TAINT_ENV() if (tainting) taint_env() 2651 2652! #ifdef HAS_GETPGRP2 2653! # ifndef HAS_GETPGRP 2654! # define HAS_GETPGRP 2655! # endif 2656! #endif 2657! 2658! #ifdef HAS_SETPGRP2 2659! # ifndef HAS_SETPGRP 2660! # define HAS_SETPGRP 2661! # endif 2662 #endif 2663 2664EOBAD 2665 } elsif (extract_from_file('perl.h', 2666 qr/Gack, you have one but not both of getpgrp2/)) { 2667 $bad = <<'EOBAD'; 2668*************** 2669*** 56,76 **** 2670 #define TAINT_PROPER(s) if (tainting) taint_proper(no_security, s) 2671 #define TAINT_ENV() if (tainting) taint_env() 2672 2673! #if defined(HAS_GETPGRP2) && defined(HAS_SETPGRP2) 2674! # define getpgrp getpgrp2 2675! # define setpgrp setpgrp2 2676! # ifndef HAS_GETPGRP 2677! # define HAS_GETPGRP 2678! # endif 2679! # ifndef HAS_SETPGRP 2680! # define HAS_SETPGRP 2681! # endif 2682! # ifndef USE_BSDPGRP 2683! # define USE_BSDPGRP 2684! # endif 2685! #else 2686! # if defined(HAS_GETPGRP2) || defined(HAS_SETPGRP2) 2687! #include "Gack, you have one but not both of getpgrp2() and setpgrp2()." 2688! # endif 2689 #endif 2690 2691EOBAD 2692 } elsif (extract_from_file('perl.h', 2693 qr/^#ifdef USE_BSDPGRP$/)) { 2694 $bad = <<'EOBAD' 2695*************** 2696*** 91,116 **** 2697 #define TAINT_PROPER(s) if (tainting) taint_proper(no_security, s) 2698 #define TAINT_ENV() if (tainting) taint_env() 2699 2700! #ifdef USE_BSDPGRP 2701! # ifdef HAS_GETPGRP 2702! # define BSD_GETPGRP(pid) getpgrp((pid)) 2703! # endif 2704! # ifdef HAS_SETPGRP 2705! # define BSD_SETPGRP(pid, pgrp) setpgrp((pid), (pgrp)) 2706! # endif 2707! #else 2708! # ifdef HAS_GETPGRP2 2709! # define BSD_GETPGRP(pid) getpgrp2((pid)) 2710! # ifndef HAS_GETPGRP 2711! # define HAS_GETPGRP 2712! # endif 2713! # endif 2714! # ifdef HAS_SETPGRP2 2715! # define BSD_SETPGRP(pid, pgrp) setpgrp2((pid), (pgrp)) 2716! # ifndef HAS_SETPGRP 2717! # define HAS_SETPGRP 2718! # endif 2719! # endif 2720 #endif 2721 2722 #ifndef _TYPES_ /* If types.h defines this it's easy. */ 2723EOBAD 2724 } 2725 if ($bad) { 2726 apply_patch(<<"EOPATCH"); 2727*** a/perl.h 2011-10-21 09:46:12.000000000 +0200 2728--- b/perl.h 2011-10-21 09:46:12.000000000 +0200 2729$bad--- 91,144 ---- 2730 #define TAINT_PROPER(s) if (tainting) taint_proper(no_security, s) 2731 #define TAINT_ENV() if (tainting) taint_env() 2732 2733! /* XXX All process group stuff is handled in pp_sys.c. Should these 2734! defines move there? If so, I could simplify this a lot. --AD 9/96. 2735! */ 2736! /* Process group stuff changed from traditional BSD to POSIX. 2737! perlfunc.pod documents the traditional BSD-style syntax, so we'll 2738! try to preserve that, if possible. 2739! */ 2740! #ifdef HAS_SETPGID 2741! # define BSD_SETPGRP(pid, pgrp) setpgid((pid), (pgrp)) 2742! #else 2743! # if defined(HAS_SETPGRP) && defined(USE_BSD_SETPGRP) 2744! # define BSD_SETPGRP(pid, pgrp) setpgrp((pid), (pgrp)) 2745! # else 2746! # ifdef HAS_SETPGRP2 /* DG/UX */ 2747! # define BSD_SETPGRP(pid, pgrp) setpgrp2((pid), (pgrp)) 2748! # endif 2749! # endif 2750! #endif 2751! #if defined(BSD_SETPGRP) && !defined(HAS_SETPGRP) 2752! # define HAS_SETPGRP /* Well, effectively it does . . . */ 2753! #endif 2754! 2755! /* getpgid isn't POSIX, but at least Solaris and Linux have it, and it makes 2756! our life easier :-) so we'll try it. 2757! */ 2758! #ifdef HAS_GETPGID 2759! # define BSD_GETPGRP(pid) getpgid((pid)) 2760! #else 2761! # if defined(HAS_GETPGRP) && defined(USE_BSD_GETPGRP) 2762! # define BSD_GETPGRP(pid) getpgrp((pid)) 2763! # else 2764! # ifdef HAS_GETPGRP2 /* DG/UX */ 2765! # define BSD_GETPGRP(pid) getpgrp2((pid)) 2766! # endif 2767! # endif 2768! #endif 2769! #if defined(BSD_GETPGRP) && !defined(HAS_GETPGRP) 2770! # define HAS_GETPGRP /* Well, effectively it does . . . */ 2771! #endif 2772! 2773! /* These are not exact synonyms, since setpgrp() and getpgrp() may 2774! have different behaviors, but perl.h used to define USE_BSDPGRP 2775! (prior to 5.003_05) so some extension might depend on it. 2776! */ 2777! #if defined(USE_BSD_SETPGRP) || defined(USE_BSD_GETPGRP) 2778! # ifndef USE_BSDPGRP 2779! # define USE_BSDPGRP 2780! # endif 2781 #endif 2782 2783 #ifndef _TYPES_ /* If types.h defines this it's easy. */ 2784EOPATCH 2785 } 2786 } 2787 2788 if ($major < 4 && $^O eq 'hpux' 2789 && extract_from_file('sv.c', qr/i = _filbuf\(/)) { 2790 apply_patch(<<'EOPATCH'); 2791diff --git a/sv.c b/sv.c 2792index a1f1d60..0a806f1 100644 2793--- a/sv.c 2794+++ b/sv.c 2795@@ -2641,7 +2641,7 @@ I32 append; 2796 2797 FILE_cnt(fp) = cnt; /* deregisterize cnt and ptr */ 2798 FILE_ptr(fp) = ptr; 2799- i = _filbuf(fp); /* get more characters */ 2800+ i = __filbuf(fp); /* get more characters */ 2801 cnt = FILE_cnt(fp); 2802 ptr = FILE_ptr(fp); /* reregisterize cnt and ptr */ 2803 2804 2805EOPATCH 2806 } 2807 2808 if ($major == 4 && extract_from_file('scope.c', qr/\(SV\*\)SSPOPINT/)) { 2809 # [PATCH] 5.004_04 +MAINT_TRIAL_1 broken when sizeof(int) != sizeof(void) 2810 # Fixes a bug introduced in 161b7d1635bc830b 2811 apply_commit('9002cb76ec83ef7f'); 2812 } 2813 2814 if ($major == 4 && extract_from_file('av.c', qr/AvARRAY\(av\) = 0;/)) { 2815 # Fixes a bug introduced in 1393e20655efb4bc 2816 apply_commit('e1c148c28bf3335b', 'av.c'); 2817 } 2818 2819 if ($major == 4) { 2820 my $rest = extract_from_file('perl.c', qr/delimcpy(.*)/); 2821 if (defined $rest and $rest !~ /,$/) { 2822 # delimcpy added in fc36a67e8855d031, perl.c refactored to use it. 2823 # bug introduced in 2a92aaa05aa1acbf, fixed in 8490252049bf42d3 2824 # code then moved to util.c in commit 491527d0220de34e 2825 apply_patch(<<'EOPATCH'); 2826diff --git a/perl.c b/perl.c 2827index 4eb69e3..54bbb00 100644 2828--- a/perl.c 2829+++ b/perl.c 2830@@ -1735,7 +1735,7 @@ SV *sv; 2831 if (len < sizeof tokenbuf) 2832 tokenbuf[len] = '\0'; 2833 #else /* ! (atarist || DOSISH) */ 2834- s = delimcpy(tokenbuf, tokenbuf + sizeof tokenbuf, s, bufend 2835+ s = delimcpy(tokenbuf, tokenbuf + sizeof tokenbuf, s, bufend, 2836 ':', 2837 &len); 2838 #endif /* ! (atarist || DOSISH) */ 2839EOPATCH 2840 } 2841 } 2842 2843 if ($major == 4 && $^O eq 'linux') { 2844 # Whilst this is fixed properly in f0784f6a4c3e45e1 which provides the 2845 # Configure probe, it's easier to back out the problematic changes made 2846 # in these previous commits. 2847 2848 # In maint-5.004, the simplest addition is to "correct" the file to 2849 # use the same pre-processor macros as blead had used. Whilst commit 2850 # 9b599b2a63d2324d (reverted below) is described as 2851 # [win32] merge change#887 from maintbranch 2852 # it uses __sun__ and __svr4__ instead of the __sun and __SVR4 of the 2853 # maint branch commit 6cdf74fe31f049dc 2854 2855 edit_file('doio.c', sub { 2856 my $code = shift; 2857 $code =~ s{defined\(__sun\) && defined\(__SVR4\)} 2858 {defined(__sun__) && defined(__svr4__)}g; 2859 return $code; 2860 }); 2861 2862 if (extract_from_file('doio.c', 2863 qr!^/\* XXX REALLY need metaconfig test \*/$!)) { 2864 revert_commit('4682965a1447ea44', 'doio.c'); 2865 } 2866 if (my $token = extract_from_file('doio.c', 2867 qr!^#if (defined\(__sun(?:__)?\)) && defined\(__svr4__\) /\* XXX Need metaconfig test \*/$!)) { 2868 my $patch = `git show -R 9b599b2a63d2324d doio.c`; 2869 $patch =~ s/defined\(__sun__\)/$token/g; 2870 apply_patch($patch); 2871 } 2872 if (extract_from_file('doio.c', 2873 qr!^/\* linux \(and Solaris2\?\) uses :$!)) { 2874 revert_commit('8490252049bf42d3', 'doio.c'); 2875 } 2876 if (extract_from_file('doio.c', 2877 qr/^ unsemds.buf = &semds;$/)) { 2878 revert_commit('8e591e46b4c6543e'); 2879 } 2880 if (extract_from_file('doio.c', 2881 qr!^#ifdef __linux__ /\* XXX Need metaconfig test \*/$!)) { 2882 # Reverts part of commit 3e3baf6d63945cb6 2883 apply_patch(<<'EOPATCH'); 2884diff --git b/doio.c a/doio.c 2885index 62b7de9..0d57425 100644 2886--- b/doio.c 2887+++ a/doio.c 2888@@ -1333,9 +1331,6 @@ SV **sp; 2889 char *a; 2890 I32 id, n, cmd, infosize, getinfo; 2891 I32 ret = -1; 2892-#ifdef __linux__ /* XXX Need metaconfig test */ 2893- union semun unsemds; 2894-#endif 2895 2896 id = SvIVx(*++mark); 2897 n = (optype == OP_SEMCTL) ? SvIVx(*++mark) : 0; 2898@@ -1364,29 +1359,11 @@ SV **sp; 2899 infosize = sizeof(struct semid_ds); 2900 else if (cmd == GETALL || cmd == SETALL) 2901 { 2902-#ifdef __linux__ /* XXX Need metaconfig test */ 2903-/* linux uses : 2904- int semctl (int semid, int semnun, int cmd, union semun arg) 2905- 2906- union semun { 2907- int val; 2908- struct semid_ds *buf; 2909- ushort *array; 2910- }; 2911-*/ 2912- union semun semds; 2913- if (semctl(id, 0, IPC_STAT, semds) == -1) 2914-#else 2915 struct semid_ds semds; 2916 if (semctl(id, 0, IPC_STAT, &semds) == -1) 2917-#endif 2918 return -1; 2919 getinfo = (cmd == GETALL); 2920-#ifdef __linux__ /* XXX Need metaconfig test */ 2921- infosize = semds.buf->sem_nsems * sizeof(short); 2922-#else 2923 infosize = semds.sem_nsems * sizeof(short); 2924-#endif 2925 /* "short" is technically wrong but much more portable 2926 than guessing about u_?short(_t)? */ 2927 } 2928@@ -1429,12 +1406,7 @@ SV **sp; 2929 #endif 2930 #ifdef HAS_SEM 2931 case OP_SEMCTL: 2932-#ifdef __linux__ /* XXX Need metaconfig test */ 2933- unsemds.buf = (struct semid_ds *)a; 2934- ret = semctl(id, n, cmd, unsemds); 2935-#else 2936 ret = semctl(id, n, cmd, (struct semid_ds *)a); 2937-#endif 2938 break; 2939 #endif 2940 #ifdef HAS_SHM 2941EOPATCH 2942 } 2943 # Incorrect prototype added as part of 8ac853655d9b7447, fixed as part 2944 # of commit dc45a647708b6c54, with at least one intermediate 2945 # modification. Correct prototype for gethostbyaddr has socklen_t 2946 # second. Linux has uint32_t first for getnetbyaddr. 2947 # Easiest just to remove, instead of attempting more complex patching. 2948 # Something similar may be needed on other platforms. 2949 edit_file('pp_sys.c', sub { 2950 my $code = shift; 2951 $code =~ s/^ struct hostent \*(?:PerlSock_)?gethostbyaddr\([^)]+\);$//m; 2952 $code =~ s/^ struct netent \*getnetbyaddr\([^)]+\);$//m; 2953 return $code; 2954 }); 2955 } 2956 2957 if ($major < 5 && $^O eq 'aix' 2958 && !extract_from_file('pp_sys.c', 2959 qr/defined\(HOST_NOT_FOUND\) && !defined\(h_errno\)/)) { 2960 # part of commit dc45a647708b6c54 2961 # Andy Dougherty's configuration patches (Config_63-01 up to 04). 2962 apply_patch(<<'EOPATCH') 2963diff --git a/pp_sys.c b/pp_sys.c 2964index c2fcb6f..efa39fb 100644 2965--- a/pp_sys.c 2966+++ b/pp_sys.c 2967@@ -54,7 +54,7 @@ extern "C" int syscall(unsigned long,...); 2968 #endif 2969 #endif 2970 2971-#ifdef HOST_NOT_FOUND 2972+#if defined(HOST_NOT_FOUND) && !defined(h_errno) 2973 extern int h_errno; 2974 #endif 2975 2976EOPATCH 2977 } 2978 2979 if ($major == 5 2980 && `git rev-parse HEAD` eq "22c35a8c2392967a5ba6b5370695be464bd7012c\n") { 2981 # Commit 22c35a8c2392967a is significant, 2982 # "phase 1 of somewhat major rearrangement of PERL_OBJECT stuff" 2983 # but doesn't build due to 2 simple errors. blead in this broken state 2984 # was merged to the cfgperl branch, and then these were immediately 2985 # corrected there. cfgperl (with the fixes) was merged back to blead. 2986 # The resultant rather twisty maze of commits looks like this: 2987 2988=begin comment 2989 2990* | | commit 137225782c183172f360c827424b9b9f8adbef0e 2991|\ \ \ Merge: 22c35a8 2a8ee23 2992| |/ / Author: Gurusamy Sarathy <gsar@cpan.org> 2993| | | Date: Fri Oct 30 17:38:36 1998 +0000 2994| | | 2995| | | integrate cfgperl tweaks into mainline 2996| | | 2997| | | p4raw-id: //depot/perl@2144 2998| | | 2999| * | commit 2a8ee23279873759693fa83eca279355db2b665c 3000| | | Author: Jarkko Hietaniemi <jhi@iki.fi> 3001| | | Date: Fri Oct 30 13:27:39 1998 +0000 3002| | | 3003| | | There can be multiple yacc/bison errors. 3004| | | 3005| | | p4raw-id: //depot/cfgperl@2143 3006| | | 3007| * | commit 93fb2ac393172fc3e2c14edb20b718309198abbc 3008| | | Author: Jarkko Hietaniemi <jhi@iki.fi> 3009| | | Date: Fri Oct 30 13:18:43 1998 +0000 3010| | | 3011| | | README.posix-bc update. 3012| | | 3013| | | p4raw-id: //depot/cfgperl@2142 3014| | | 3015| * | commit 4ec43091e8e6657cb260b5e563df30aaa154effe 3016| | | Author: Jarkko Hietaniemi <jhi@iki.fi> 3017| | | Date: Fri Oct 30 09:12:59 1998 +0000 3018| | | 3019| | | #2133 fallout. 3020| | | 3021| | | p4raw-id: //depot/cfgperl@2141 3022| | | 3023| * | commit 134ca994cfefe0f613d43505a885e4fc2100b05c 3024| |\ \ Merge: 7093112 22c35a8 3025| |/ / Author: Jarkko Hietaniemi <jhi@iki.fi> 3026|/| | Date: Fri Oct 30 08:43:18 1998 +0000 3027| | | 3028| | | Integrate from mainperl. 3029| | | 3030| | | p4raw-id: //depot/cfgperl@2140 3031| | | 3032* | | commit 22c35a8c2392967a5ba6b5370695be464bd7012c 3033| | | Author: Gurusamy Sarathy <gsar@cpan.org> 3034| | | Date: Fri Oct 30 02:51:39 1998 +0000 3035| | | 3036| | | phase 1 of somewhat major rearrangement of PERL_OBJECT stuff 3037| | | (objpp.h is gone, embed.pl now does some of that); objXSUB.h 3038| | | should soon be automated also; the global variables that 3039| | | escaped the PL_foo conversion are now reined in; renamed 3040| | | MAGIC in regcomp.h to REG_MAGIC to avoid collision with the 3041| | | type of same name; duplicated lists of pp_things in various 3042| | | places is now gone; result has only been tested on win32 3043| | | 3044| | | p4raw-id: //depot/perl@2133 3045 3046=end comment 3047 3048=cut 3049 3050 # and completely confuses git bisect (and at least me), causing it to 3051 # the bisect run to confidently return the wrong answer, an unrelated 3052 # commit on the cfgperl branch. 3053 3054 apply_commit('4ec43091e8e6657c'); 3055 } 3056 3057 if ($major == 5 3058 && extract_from_file('pp_sys.c', qr/PERL_EFF_ACCESS_R_OK/) 3059 && !extract_from_file('pp_sys.c', qr/XXX Configure test needed for eaccess/)) { 3060 # Between 5ff3f7a4e03a6b10 and c955f1177b2e311d^ 3061 # This is the meat of commit c955f1177b2e311d (without the other 3062 # indenting changes that would cause a conflict). 3063 # Without this 538 revisions won't build on (at least) Linux 3064 apply_patch(<<'EOPATCH'); 3065diff --git a/pp_sys.c b/pp_sys.c 3066index d60c8dc..867dee4 100644 3067--- a/pp_sys.c 3068+++ b/pp_sys.c 3069@@ -198,9 +198,18 @@ static char zero_but_true[ZBTLEN + 1] = "0 but true"; 3070 # if defined(I_SYS_SECURITY) 3071 # include <sys/security.h> 3072 # endif 3073-# define PERL_EFF_ACCESS_R_OK(p) (eaccess((p), R_OK, ACC_SELF)) 3074-# define PERL_EFF_ACCESS_W_OK(p) (eaccess((p), W_OK, ACC_SELF)) 3075-# define PERL_EFF_ACCESS_X_OK(p) (eaccess((p), X_OK, ACC_SELF)) 3076+ /* XXX Configure test needed for eaccess */ 3077+# ifdef ACC_SELF 3078+ /* HP SecureWare */ 3079+# define PERL_EFF_ACCESS_R_OK(p) (eaccess((p), R_OK, ACC_SELF)) 3080+# define PERL_EFF_ACCESS_W_OK(p) (eaccess((p), W_OK, ACC_SELF)) 3081+# define PERL_EFF_ACCESS_X_OK(p) (eaccess((p), X_OK, ACC_SELF)) 3082+# else 3083+ /* SCO */ 3084+# define PERL_EFF_ACCESS_R_OK(p) (eaccess((p), R_OK)) 3085+# define PERL_EFF_ACCESS_W_OK(p) (eaccess((p), W_OK)) 3086+# define PERL_EFF_ACCESS_X_OK(p) (eaccess((p), X_OK)) 3087+# endif 3088 #endif 3089 3090 #if !defined(PERL_EFF_ACCESS_R_OK) && defined(HAS_ACCESSX) && defined(ACC_SELF) 3091EOPATCH 3092 } 3093 3094 if ($major == 5 3095 && extract_from_file('mg.c', qr/If we're still on top of the stack, pop us off/) 3096 && !extract_from_file('mg.c', qr/PL_savestack_ix -= popval/)) { 3097 # Fix up commit 455ece5e082708b1: 3098 # SSNEW() API for allocating memory on the savestack 3099 # Message-Id: <tqemtae338.fsf@puma.genscan.com> 3100 # Subject: [PATCH 5.005_51] (was: why SAVEDESTRUCTOR()...) 3101 apply_commit('3c8a44569607336e', 'mg.c'); 3102 } 3103 3104 if ($major == 5) { 3105 if (extract_from_file('doop.c', qr/croak\(no_modify\);/) 3106 && extract_from_file('doop.c', qr/croak\(PL_no_modify\);/)) { 3107 # Whilst the log suggests that this would only fix 5 commits, in 3108 # practice this area of history is a complete tarpit, and git bisect 3109 # gets very confused by the skips in the middle of the back and 3110 # forth merging between //depot/perl and //depot/cfgperl 3111 apply_commit('6393042b638dafd3'); 3112 } 3113 3114 # One error "fixed" with another: 3115 if (extract_from_file('pp_ctl.c', 3116 qr/\Qstatic void *docatch_body _((void *o));\E/)) { 3117 apply_commit('5b51e982882955fe'); 3118 } 3119 # Which is then fixed by this: 3120 if (extract_from_file('pp_ctl.c', 3121 qr/\Qstatic void *docatch_body _((valist\E/)) { 3122 apply_commit('47aa779ee4c1a50e'); 3123 } 3124 3125 if (extract_from_file('thrdvar.h', qr/PERLVARI\(Tprotect/) 3126 && !extract_from_file('embedvar.h', qr/PL_protect/)) { 3127 # Commit 312caa8e97f1c7ee didn't update embedvar.h 3128 apply_commit('e0284a306d2de082', 'embedvar.h'); 3129 } 3130 } 3131 3132 if ($major == 5 3133 && extract_from_file('sv.c', 3134 qr/PerlDir_close\(IoDIRP\((?:\(IO\*\))?sv\)\);/) 3135 && !(extract_from_file('toke.c', 3136 qr/\QIoDIRP(FILTER_DATA(AvFILLp(PL_rsfp_filters))) = NULL\E/) 3137 || extract_from_file('toke.c', 3138 qr/\QIoDIRP(datasv) = (DIR*)NULL;\E/))) { 3139 # Commit 93578b34124e8a3b, //depot/perl@3298 3140 # close directory handles properly when localized, 3141 # tweaked slightly by commit 1236053a2c722e2b, 3142 # add test case for change#3298 3143 # 3144 # The fix is the last part of: 3145 # 3146 # various fixes for clean build and test on win32; configpm broken, 3147 # needed to open myconfig.SH rather than myconfig; sundry adjustments 3148 # to bytecode stuff; tweaks to DYNAMIC_ENV_FETCH code to make it 3149 # work under win32; getenv_sv() changed to getenv_len() since SVs 3150 # aren't visible in the lower echelons; remove bogus exports from 3151 # config.sym; PERL_OBJECT-ness for C++ exception support; null out 3152 # IoDIRP in filter_del() or sv_free() will attempt to close it 3153 # 3154 # The changed code is modified subsequently by commit e0c198038146b7a4 3155 apply_commit('a6c403648ecd5cc7', 'toke.c'); 3156 } 3157 3158 if ($major < 6 && $^O eq 'netbsd' 3159 && !extract_from_file('unixish.h', 3160 qr/defined\(NSIG\).*defined\(__NetBSD__\)/)) { 3161 apply_patch(<<'EOPATCH') 3162diff --git a/unixish.h b/unixish.h 3163index 2a6cbcd..eab2de1 100644 3164--- a/unixish.h 3165+++ b/unixish.h 3166@@ -89,7 +89,7 @@ 3167 */ 3168 /* #define ALTERNATE_SHEBANG "#!" / **/ 3169 3170-#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) 3171+#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) || defined(__NetBSD__) 3172 # include <signal.h> 3173 #endif 3174 3175EOPATCH 3176 } 3177 3178 if ($major == 7 && $^O eq 'aix' && 3179 extract_from_file('ext/List/Util/Util.xs', qr/PUSHBLOCK/) 3180 && !extract_from_file('makedef.pl', qr/^Perl_cxinc/)) { 3181 # Need this to get List::Utils 1.03 and later to compile. 3182 # 1.03 also expects to call Perl_pp_rand. Commit d3632a54487acc5f 3183 # fixes this (for the unthreaded case), but it's not until 1.05, 3184 # two days later, that this is fixed properly. 3185 apply_commit('cbb96eed3f175499'); 3186 } 3187 3188 if (($major >= 7 || $major <= 9) && $^O eq 'openbsd' 3189 && `uname -m` eq "sparc64\n" 3190 # added in 2000 by commit cb434fcc98ac25f5: 3191 && extract_from_file('regexec.c', 3192 qr!/\* No need to save/restore up to this paren \*/!) 3193 # re-indented in 2006 by commit 95b2444054382532: 3194 && extract_from_file('regexec.c', qr/^\t\tCURCUR cc;$/)) { 3195 # Need to work around a bug in (at least) OpenBSD's 4.6's sparc64 # 3196 # compiler ["gcc (GCC) 3.3.5 (propolice)"]. Between commits 3197 # 3ec562b0bffb8b8b (2002) and 1a4fad37125bac3e^ (2005) the darling thing 3198 # fails to compile any code for the statement cc.oldcc = PL_regcc; 3199 # 3200 # If you refactor the code to "fix" that, or force the issue using set 3201 # in the debugger, the stack smashing detection code fires on return 3202 # from S_regmatch(). Turns out that the compiler doesn't allocate any 3203 # (or at least enough) space for cc. 3204 # 3205 # Restore the "uninitialised" value for cc before function exit, and the 3206 # stack smashing code is placated. "Fix" 3ec562b0bffb8b8b (which 3207 # changes the size of auto variables used elsewhere in S_regmatch), and 3208 # the crash is visible back to bc517b45fdfb539b (which also changes 3209 # buffer sizes). "Unfix" 1a4fad37125bac3e and the crash is visible until 3210 # 5b47454deb66294b. Problem goes away if you compile with -O, or hack 3211 # the code as below. 3212 # 3213 # Hence this turns out to be a bug in (old) gcc. Not a security bug we 3214 # still need to fix. 3215 apply_patch(<<'EOPATCH'); 3216diff --git a/regexec.c b/regexec.c 3217index 900b491..6251a0b 100644 3218--- a/regexec.c 3219+++ b/regexec.c 3220@@ -2958,7 +2958,11 @@ S_regmatch(pTHX_ regnode *prog) 3221 I,I 3222 *******************************************************************/ 3223 case CURLYX: { 3224- CURCUR cc; 3225+ union { 3226+ CURCUR hack_cc; 3227+ char hack_buff[sizeof(CURCUR) + 1]; 3228+ } hack; 3229+#define cc hack.hack_cc 3230 CHECKPOINT cp = PL_savestack_ix; 3231 /* No need to save/restore up to this paren */ 3232 I32 parenfloor = scan->flags; 3233@@ -2983,6 +2987,7 @@ S_regmatch(pTHX_ regnode *prog) 3234 n = regmatch(PREVOPER(next)); /* start on the WHILEM */ 3235 regcpblow(cp); 3236 PL_regcc = cc.oldcc; 3237+#undef cc 3238 saySAME(n); 3239 } 3240 /* NOT REACHED */ 3241EOPATCH 3242} 3243 3244 if ($major < 8 && $^O eq 'openbsd' 3245 && !extract_from_file('perl.h', qr/include <unistd\.h>/)) { 3246 # This is part of commit 3f270f98f9305540, applied at a slightly 3247 # different location in perl.h, where the context is stable back to 3248 # 5.000 3249 apply_patch(<<'EOPATCH'); 3250diff --git a/perl.h b/perl.h 3251index 9418b52..b8b1a7c 100644 3252--- a/perl.h 3253+++ b/perl.h 3254@@ -496,6 +496,10 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER)); 3255 # include <sys/param.h> 3256 #endif 3257 3258+/* If this causes problems, set i_unistd=undef in the hint file. */ 3259+#ifdef I_UNISTD 3260+# include <unistd.h> 3261+#endif 3262 3263 /* Use all the "standard" definitions? */ 3264 #if defined(STANDARD_C) && defined(I_STDLIB) 3265EOPATCH 3266 } 3267} 3268 3269sub patch_ext { 3270 if (-f 'ext/POSIX/Makefile.PL' 3271 && extract_from_file('ext/POSIX/Makefile.PL', 3272 qr/Explicitly avoid including/)) { 3273 # commit 6695a346c41138df, which effectively reverts 170888cff5e2ffb7 3274 3275 # PERL5LIB is populated by make_ext.pl with paths to the modules we need 3276 # to run, don't override this with "../../lib" since that may not have 3277 # been populated yet in a parallel build. 3278 apply_commit('6695a346c41138df'); 3279 } 3280 3281 if (-f 'ext/Hash/Util/Makefile.PL' 3282 && extract_from_file('ext/Hash/Util/Makefile.PL', 3283 qr/\bDIR\b.*'FieldHash'/)) { 3284 # ext/Hash/Util/Makefile.PL should not recurse to FieldHash's Makefile.PL 3285 # *nix, VMS and Win32 all know how to (and have to) call the latter directly. 3286 # As is, targets in ext/Hash/Util/FieldHash get called twice, which may result 3287 # in race conditions, and certainly messes up make clean; make distclean; 3288 apply_commit('550428fe486b1888'); 3289 } 3290 3291 if ($major < 8 && $^O eq 'darwin' && !-f 'ext/DynaLoader/dl_dyld.xs') { 3292 checkout_file('ext/DynaLoader/dl_dyld.xs', 'f556e5b971932902'); 3293 apply_patch(<<'EOPATCH'); 3294diff -u a/ext/DynaLoader/dl_dyld.xs~ a/ext/DynaLoader/dl_dyld.xs 3295--- a/ext/DynaLoader/dl_dyld.xs~ 2011-10-11 21:41:27.000000000 +0100 3296+++ b/ext/DynaLoader/dl_dyld.xs 2011-10-11 21:42:20.000000000 +0100 3297@@ -41,6 +41,35 @@ 3298 #include "perl.h" 3299 #include "XSUB.h" 3300 3301+#ifndef pTHX 3302+# define pTHX void 3303+# define pTHX_ 3304+#endif 3305+#ifndef aTHX 3306+# define aTHX 3307+# define aTHX_ 3308+#endif 3309+#ifndef dTHX 3310+# define dTHXa(a) extern int Perl___notused(void) 3311+# define dTHX extern int Perl___notused(void) 3312+#endif 3313+ 3314+#ifndef Perl_form_nocontext 3315+# define Perl_form_nocontext form 3316+#endif 3317+ 3318+#ifndef Perl_warn_nocontext 3319+# define Perl_warn_nocontext warn 3320+#endif 3321+ 3322+#ifndef PTR2IV 3323+# define PTR2IV(p) (IV)(p) 3324+#endif 3325+ 3326+#ifndef get_av 3327+# define get_av perl_get_av 3328+#endif 3329+ 3330 #define DL_LOADONCEONLY 3331 3332 #include "dlutils.c" /* SaveError() etc */ 3333@@ -185,7 +191,7 @@ 3334 CODE: 3335 DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags)); 3336 if (flags & 0x01) 3337- Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename); 3338+ Perl_warn_nocontext("Can't make loaded symbols global on this platform while loading %s",filename); 3339 RETVAL = dlopen(filename, mode) ; 3340 DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", RETVAL)); 3341 ST(0) = sv_newmortal() ; 3342EOPATCH 3343 if ($major < 4 && !extract_from_file('util.c', qr/^form/m)) { 3344 apply_patch(<<'EOPATCH'); 3345diff -u a/ext/DynaLoader/dl_dyld.xs~ a/ext/DynaLoader/dl_dyld.xs 3346--- a/ext/DynaLoader/dl_dyld.xs~ 2011-10-11 21:56:25.000000000 +0100 3347+++ b/ext/DynaLoader/dl_dyld.xs 2011-10-11 22:00:00.000000000 +0100 3348@@ -60,6 +60,18 @@ 3349 # define get_av perl_get_av 3350 #endif 3351 3352+static char * 3353+form(char *pat, ...) 3354+{ 3355+ char *retval; 3356+ va_list args; 3357+ va_start(args, pat); 3358+ vasprintf(&retval, pat, &args); 3359+ va_end(args); 3360+ SAVEFREEPV(retval); 3361+ return retval; 3362+} 3363+ 3364 #define DL_LOADONCEONLY 3365 3366 #include "dlutils.c" /* SaveError() etc */ 3367EOPATCH 3368 } 3369 } 3370 3371 if ($major < 10) { 3372 if ($unfixable_db_file) { 3373 # Nothing we can do. 3374 } elsif (!extract_from_file('ext/DB_File/DB_File.xs', 3375 qr/^#ifdef AT_LEAST_DB_4_1$/)) { 3376 # This line is changed by commit 3245f0580c13b3ab 3377 my $line = extract_from_file('ext/DB_File/DB_File.xs', 3378 qr/^( status = \(?RETVAL->dbp->open\)?\(RETVAL->dbp, name, NULL, RETVAL->type, $)/); 3379 apply_patch(<<"EOPATCH"); 3380diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs 3381index 489ba96..fba8ded 100644 3382--- a/ext/DB_File/DB_File.xs 3383+++ b/ext/DB_File/DB_File.xs 3384\@\@ -183,4 +187,8 \@\@ 3385 #endif 3386 3387+#if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 1) 3388+# define AT_LEAST_DB_4_1 3389+#endif 3390+ 3391 /* map version 2 features & constants onto their version 1 equivalent */ 3392 3393\@\@ -1334,7 +1419,12 \@\@ SV * sv ; 3394 #endif 3395 3396+#ifdef AT_LEAST_DB_4_1 3397+ status = (RETVAL->dbp->open)(RETVAL->dbp, NULL, name, NULL, RETVAL->type, 3398+ Flags, mode) ; 3399+#else 3400 $line 3401 Flags, mode) ; 3402+#endif 3403 /* printf("open returned %d %s\\n", status, db_strerror(status)) ; */ 3404 3405EOPATCH 3406 } 3407 } 3408 3409 if ($major < 10 and -f 'ext/IPC/SysV/SysV.xs') { 3410 edit_file('ext/IPC/SysV/SysV.xs', sub { 3411 my $xs = shift; 3412 my $fixed = <<'EOFIX'; 3413 3414#include <sys/types.h> 3415#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM) 3416#ifndef HAS_SEM 3417# include <sys/ipc.h> 3418#endif 3419# ifdef HAS_MSG 3420# include <sys/msg.h> 3421# endif 3422# ifdef HAS_SHM 3423# if defined(PERL_SCO) || defined(PERL_ISC) 3424# include <sys/sysmacros.h> /* SHMLBA */ 3425# endif 3426# include <sys/shm.h> 3427# ifndef HAS_SHMAT_PROTOTYPE 3428 extern Shmat_t shmat (int, char *, int); 3429# endif 3430# if defined(HAS_SYSCONF) && defined(_SC_PAGESIZE) 3431# undef SHMLBA /* not static: determined at boot time */ 3432# define SHMLBA sysconf(_SC_PAGESIZE) 3433# elif defined(HAS_GETPAGESIZE) 3434# undef SHMLBA /* not static: determined at boot time */ 3435# define SHMLBA getpagesize() 3436# endif 3437# endif 3438#endif 3439EOFIX 3440 $xs =~ s! 3441#include <sys/types\.h> 3442.* 3443(#ifdef newCONSTSUB|/\* Required)!$fixed$1!ms; 3444 return $xs; 3445 }); 3446 } 3447} 3448 3449sub apply_fixups { 3450 my $fixups = shift; 3451 return unless $fixups; 3452 foreach my $file (@$fixups) { 3453 my $fh = open_or_die($file); 3454 my $line = <$fh>; 3455 close_or_die($fh); 3456 if ($line =~ /^#!perl\b/) { 3457 system $^X, $file 3458 and die_255("$^X $file failed: \$!=$!, \$?=$?"); 3459 } elsif ($line =~ /^#!(\/\S+)/) { 3460 system $file 3461 and die_255("$file failed: \$!=$!, \$?=$?"); 3462 } else { 3463 if (my ($target, $action, $pattern) 3464 = $line =~ m#^(\S+) ([=!])~ /(.*)/#) { 3465 if (length $pattern) { 3466 next unless -f $target; 3467 if ($action eq '=') { 3468 next unless extract_from_file($target, $pattern); 3469 } else { 3470 next if extract_from_file($target, $pattern); 3471 } 3472 } else { 3473 # Avoid the special case meaning of the empty pattern, 3474 # and instead use this to simply test for the file being 3475 # present or absent 3476 if ($action eq '=') { 3477 next unless -f $target; 3478 } else { 3479 next if -f $target; 3480 } 3481 } 3482 } 3483 system_or_die("patch -p1 <$file"); 3484 } 3485 } 3486} 3487 3488# Local variables: 3489# cperl-indent-level: 4 3490# indent-tabs-mode: nil 3491# End: 3492# 3493# ex: set ts=8 sts=4 sw=4 et: 3494