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