This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
In bisect-runner.pl, remove "faking it" code from the main flow.
[perl5.git] / Porting / bisect-runner.pl
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 use Carp;
8
9 my @targets
10     = qw(config.sh config.h miniperl lib/Config.pm Fcntl perl test_prep);
11
12 my $cpus;
13 if (open my $fh, '<', '/proc/cpuinfo') {
14     while (<$fh>) {
15         ++$cpus if /^processor\s+:\s+\d+$/;
16     }
17 } elsif (-x '/sbin/sysctl') {
18     $cpus = 1 + $1 if `/sbin/sysctl hw.ncpu` =~ /^hw\.ncpu: (\d+)$/;
19 } elsif (-x '/usr/bin/getconf') {
20     $cpus = 1 + $1 if `/usr/bin/getconf _NPROCESSORS_ONLN` =~ /^(\d+)$/;
21 }
22
23 my %options =
24     (
25      jobs => defined $cpus ? $cpus + 1 : 2,
26      'expect-pass' => 1,
27      clean => 1, # mostly for debugging this
28     );
29
30 my $linux64 = `uname -sm` eq "Linux x86_64\n" ? '64' : '';
31
32 my @paths;
33
34 if ($^O eq 'linux') {
35     # This is the search logic for a multi-arch library layout
36     # added to linux.sh in commits 40f026236b9959b7 and dcffd848632af2c7.
37     my $gcc = -x '/usr/bin/gcc' ? '/usr/bin/gcc' : 'gcc';
38
39     foreach (`$gcc -print-search-dirs`) {
40         next unless /^libraries: =(.*)/;
41         foreach (split ':', $1) {
42             next if m/gcc/;
43             next unless -d $_;
44             s!/$!!;
45             push @paths, $_;
46         }
47     }
48 }
49
50 push @paths, map {$_ . $linux64} qw(/usr/local/lib /lib /usr/lib);
51
52 my %defines =
53     (
54      usedevel => '',
55      optimize => '-g',
56      cc => 'ccache cc',
57      ld => 'cc',
58      ($linux64 ? (libpth => \@paths) : ()),
59     );
60
61 unless(GetOptions(\%options,
62                   'target=s', 'jobs|j=i', 'expect-pass=i',
63                   'expect-fail' => sub { $options{'expect-pass'} = 0; },
64                   'clean!', 'one-liner|e=s', 'match=s', 'force-manifest',
65                   'test-build', 'check-args', 'A=s@', 'usage|help|?',
66                   'D=s@' => sub {
67                       my (undef, $val) = @_;
68                       if ($val =~ /\A([^=]+)=(.*)/s) {
69                           $defines{$1} = length $2 ? $2 : "\0";
70                       } else {
71                           $defines{$val} = '';
72                       }
73                   },
74                   'U=s@' => sub {
75                       $defines{$_[1]} = undef;
76                   },
77                  )) {
78     pod2usage(exitval => 255, verbose => 1);
79 }
80
81 my ($target, $j, $match) = @options{qw(target jobs match)};
82
83 pod2usage(exitval => 255, verbose => 1) if $options{usage};
84 pod2usage(exitval => 255, verbose => 1)
85     unless @ARGV || $match || $options{'test-build'} || defined $options{'one-liner'};
86
87 exit 0 if $options{'check-args'};
88
89 =head1 NAME
90
91 bisect.pl - use git bisect to pinpoint changes
92
93 =head1 SYNOPSIS
94
95     # When did this become an error?
96     .../Porting/bisect.pl -e 'my $a := 2;'
97     # When did this stop being an error?
98     .../Porting/bisect.pl --expect-fail -e '1 // 2'
99     # When did this stop matching?
100     .../Porting/bisect.pl --match '\b(?:PL_)hash_seed_set\b'
101     # When did this start matching?
102     .../Porting/bisect.pl --expect-fail --match '\buseithreads\b'
103     # When did this test program stop working?
104     .../Porting/bisect.pl -- ./perl -Ilib ../test_prog.pl
105     # When did this first become valid syntax?
106     .../Porting/bisect.pl --target=miniperl --end=v5.10.0 \
107          --expect-fail -e 'my $a := 2;'
108     # What was the last revision to build with these options?
109     .../Porting/bisect.pl --test-build -Dd_dosuid
110
111 =head1 DESCRIPTION
112
113 Together F<bisect.pl> and F<bisect-runner.pl> attempt to automate the use
114 of C<git bisect> as much as possible. With one command (and no other files)
115 it's easy to find out
116
117 =over 4
118
119 =item *
120
121 Which commit caused this example code to break?
122
123 =item *
124
125 Which commit caused this example code to start working?
126
127 =item *
128
129 Which commit added the first to match this regex?
130
131 =item *
132
133 Which commit removed the last to match this regex?
134
135 =back
136
137 usually without needing to know which versions of perl to use as start and
138 end revisions.
139
140 By default F<bisect.pl> will process all options, then use the rest of the
141 command line as arguments to list C<system> to run a test case. By default,
142 the test case should pass (exit with 0) on earlier perls, and fail (exit
143 non-zero) on I<blead>. F<bisect.pl> will use F<bisect-runner.pl> to find the
144 earliest stable perl version on which the test case passes, check that it
145 fails on blead, and then use F<bisect-runner.pl> with C<git bisect run> to
146 find the commit which caused the failure.
147
148 Because the test case is the complete argument to C<system>, it is easy to
149 run something other than the F<perl> built, if necessary. If you need to run
150 the perl built, you'll probably need to invoke it as C<./perl -Ilib ...>
151
152 You need a clean checkout to run a bisect, and you can't use the checkout
153 which contains F<Porting/bisect.pl> (because C<git bisect>) will check out
154 a revision before F<Porting/bisect-runner.pl> was added, which
155 C<git bisect run> needs). If your working checkout is called F<perl>, the
156 simplest solution is to make a local clone, and run from that. I<i.e.>:
157
158     cd ..
159     git clone perl perl2
160     cd perl2
161     ../perl/Porting/bisect.pl ...
162
163 By default, F<bisect-runner.pl> will automatically disable the build of
164 L<DB_File> for commits earlier than ccb44e3bf3be2c30, as it's not practical
165 to patch DB_File 1.70 and earlier to build with current Berkeley DB headers.
166 (ccb44e3bf3be2c30 was in September 1999, between 5.005_62 and 5.005_63.)
167 If your F<db.h> is old enough you can override this with C<-Unoextensions>.
168
169 =head1 OPTIONS
170
171 =over 4
172
173 =item *
174
175 --start I<commit-ish>
176
177 Earliest revision to test, as a I<commit-ish> (a tag, commit or anything
178 else C<git> understands as a revision). If not specified, F<bisect.pl> will
179 search stable perl releases from 5.002 to 5.14.0 until it finds one where
180 the test case passes.
181
182 =item *
183
184 --end I<commit-ish>
185
186 Most recent revision to test, as a I<commit-ish>. If not specified, defaults
187 to I<blead>.
188
189 =item *
190
191 --target I<target>
192
193 F<Makefile> target (or equivalent) needed, to run the test case. If specified,
194 this should be one of
195
196 =over 4
197
198 =item *
199
200 I<config.sh>
201
202 Just run F<./Configure>
203
204 =item *
205
206 I<config.h>
207
208 Run the various F<*.SH> files to generate F<Makefile>, F<config.h>, I<etc>.
209
210 =item *
211
212 I<miniperl>
213
214 Build F<miniperl>.
215
216 =item *
217
218 I<lib/Config.pm>
219
220 Use F<miniperl> to build F<lib/Config.pm>
221
222 =item *
223
224 I<Fcntl>
225
226 Build F<lib/auto/Fcntl/Fnctl.so> (strictly, C<.$Config{so}>). As L<Fcntl>
227 is simple XS module present since 5.000, this provides a fast test of
228 whether XS modules can be built. Note, XS modules are built by F<miniperl>,
229 hence this target will not build F<perl>.
230
231 =item *
232
233 I<perl>
234
235 Build F<perl>. This also builds pure-Perl modules in F<cpan>, F<dist> and
236 F<ext>. XS modules (such as L<Fcntl>) are not built.
237
238 =item *
239
240 I<test_prep>
241
242 Build everything needed to run the tests. This is the default if we're
243 running test code, but is time consuming, as it means building all
244 XS modules. For older F<Makefile>s, the previous name of C<test-prep>
245 is automatically substituted. For very old F<Makefile>s, C<make test> is
246 run, as there is no target provided to just get things ready, and for 5.004
247 and earlier the tests run very quickly.
248
249 =back
250
251 =item *
252
253 --one-liner 'code to run'
254
255 =item *
256
257 -e 'code to run'
258
259 Example code to run, just like you'd use with C<perl -e>.
260
261 This prepends C<./perl -Ilib -e 'code to run'> to the test case given,
262 or F<./miniperl> if I<target> is C<miniperl>.
263
264 (Usually you'll use C<-e> instead of providing a test case in the
265 non-option arguments to F<bisect.pl>)
266
267 C<-E> intentionally isn't supported, as it's an error in 5.8.0 and earlier,
268 which interferes with detecting errors in the example code itself.
269
270 =item *
271
272 --expect-fail
273
274 The test case should fail for the I<start> revision, and pass for the I<end>
275 revision. The bisect run will find the first commit where it passes.
276
277 =item *
278
279 -Dnoextensions=Encode
280
281 =item *
282
283 -Uusedevel
284
285 =item *
286
287 -Accflags=-DNO_MATHOMS
288
289 Arguments to pass to F<Configure>. Repeated C<-A> arguments are passed
290 through as is. C<-D> and C<-U> are processed in order, and override
291 previous settings for the same parameter. F<bisect-runner.pl> emulates
292 C<-Dnoextensions> when F<Configure> itself does not provide it, as it's
293 often very useful to be able to disable some XS extensions.
294
295 =item *
296
297 --jobs I<jobs>
298
299 =item *
300
301 -j I<jobs>
302
303 Number of C<make> jobs to run in parallel. If F</proc/cpuinfo> exists and
304 can be parsed, or F</sbin/sysctl> exists and reports C<hw.ncpu>, or
305 F</usr/bin/getconf> exists and reports C<_NPROCESSORS_ONLN> defaults to 1 +
306 I<number of CPUs>. Otherwise defaults to 2.
307
308 =item *
309
310 --match pattern
311
312 Instead of running a test program to determine I<pass> or I<fail>, pass
313 if the given regex matches, and hence search for the commit that removes
314 the last matching file.
315
316 If no I<target> is specified, the match is against all files in the
317 repository (which is fast). If a I<target> is specified, that target is
318 built, and the match is against only the built files. C<--expect-fail> can
319 be used with C<--match> to search for a commit that adds files that match.
320
321 =item *
322
323 --test-build
324
325 Test that the build completes, without running any test case.
326
327 By default, if the build for the desired I<target> fails to complete,
328 F<bisect-runner.pl> reports a I<skip> back to C<git bisect>, the assumption
329 being that one wants to find a commit which changed state "builds && passes"
330 to "builds && fails". If instead one is interested in which commit broke the
331 build (possibly for particular F<Configure> options), use I<--test-build>
332 to treat a build failure as a failure, not a "skip".
333
334 Often this option isn't as useful as it first seems, because I<any> build
335 failure will be reported to C<git bisect> as a failure, not just the failure
336 that you're interested in. Generally, to debug a particular problem, it's
337 more useful to use a I<target> that builds properly at the point of interest,
338 and then a test case that runs C<make>. For example:
339
340     .../Porting/bisect.pl --start=perl-5.000 --end=perl-5.002 \
341         --expect-fail --force-manifest --target=miniperl make perl
342
343 will find the first revision capable of building L<DynaLoader> and then
344 F<perl>, without becoming confused by revisions where F<miniperl> won't
345 even link.
346
347 =item *
348
349 --force-manifest
350
351 By default, a build will "skip" if any files listed in F<MANIFEST> are not
352 present. Usually this is useful, as it avoids false-failures. However, there
353 are some long ranges of commits where listed files are missing, which can
354 cause a bisect to abort because all that remain are skipped revisions.
355
356 In these cases, particularly if the test case uses F<miniperl> and no modules,
357 it may be more useful to force the build to continue, even if files
358 F<MANIFEST> are missing.
359
360 =item *
361
362 --expect-pass [0|1]
363
364 C<--expect-pass=0> is equivalent to C<--expect-fail>. I<1> is the default.
365
366 =item *
367
368 --no-clean
369
370 Tell F<bisect-runner.pl> not to clean up after the build. This allows one
371 to use F<bisect-runner.pl> to build the current particular perl revision for
372 interactive testing, or for debugging F<bisect-runner.pl>.
373
374 Passing this to F<bisect.pl> will likely cause the bisect to fail badly.
375
376 =item *
377
378 --validate
379
380 Test that all stable revisions can be built. Attempts to build I<blead>,
381 I<v5.14.0> .. I<perl-5.002>. Stops at the first failure, without cleaning
382 the checkout. Ignores I<--start> and I<--end>. Useful for validating a new
383 OS/CPU/compiler combination. For example
384
385     ../perl/Porting/bisect.pl --validate -e'print "Hello from $]\n"'
386
387 =item *
388
389 --check-args
390
391 Validate the options and arguments, and exit silently if they are valid.
392
393 =item *
394
395 --usage
396
397 =item *
398
399 --help
400
401 =item *
402
403 -?
404
405 Display the usage information and exit.
406
407 =back
408
409 =cut
410
411 die "$0: Can't build $target" if defined $target && !grep {@targets} $target;
412
413 $j = "-j$j" if $j =~ /\A\d+\z/;
414
415 # Sadly, however hard we try, I don't think that it will be possible to build
416 # modules in ext/ on x86_64 Linux before commit e1666bf5602ae794 on 1999/12/29,
417 # which updated to MakeMaker 3.7, which changed from using a hard coded ld
418 # in the Makefile to $(LD). On x86_64 Linux the "linker" is gcc.
419
420 sub open_or_die {
421     my $file = shift;
422     my $mode = @_ ? shift : '<';
423     open my $fh, $mode, $file or croak("Can't open $file: $!");
424     ${*$fh{SCALAR}} = $file;
425     return $fh;
426 }
427
428 sub close_or_die {
429     my $fh = shift;
430     return if close $fh;
431     croak("Can't close: $!") unless ref $fh eq 'GLOB';
432     croak("Can't close ${*$fh{SCALAR}}: $!");
433 }
434
435 sub extract_from_file {
436     my ($file, $rx, $default) = @_;
437     my $fh = open_or_die($file);
438     while (<$fh>) {
439         my @got = $_ =~ $rx;
440         return wantarray ? @got : $got[0]
441             if @got;
442     }
443     return $default if defined $default;
444     return;
445 }
446
447 sub edit_file {
448     my ($file, $munger) = @_;
449     local $/;
450     my $fh = open_or_die($file);
451     my $orig = <$fh>;
452     die "Can't read $file: $!" unless defined $orig && close $fh;
453     my $new = $munger->($orig);
454     return if $new eq $orig;
455     $fh = open_or_die($file, '>');
456     print $fh $new or die "Can't print to $file: $!";
457     close_or_die($fh);
458 }
459
460 sub apply_patch {
461     my $patch = shift;
462
463     my ($file) = $patch =~ qr!^--- a/(\S+)\n\+\+\+ b/\1!sm;
464     open my $fh, '|-', 'patch', '-p1' or die "Can't run patch: $!";
465     print $fh $patch;
466     return if close $fh;
467     print STDERR "Patch is <<'EOPATCH'\n${patch}EOPATCH\n";
468     die "Can't patch $file: $?, $!";
469 }
470
471 sub apply_commit {
472     my ($commit, @files) = @_;
473     return unless system "git show $commit @files | patch -p1";
474     die "Can't apply commit $commit to @files" if @files;
475     die "Can't apply commit $commit";
476 }
477
478 sub revert_commit {
479     my ($commit, @files) = @_;
480     return unless system "git show -R $commit @files | patch -p1";
481     die "Can't apply revert $commit from @files" if @files;
482     die "Can't apply revert $commit";
483 }
484
485 sub checkout_file {
486     my ($file, $commit) = @_;
487     $commit ||= 'blead';
488     system "git show $commit:$file > $file </dev/null"
489         and die "Could not extract $file at revision $commit";
490 }
491
492 sub clean {
493     if ($options{clean}) {
494         # Needed, because files that are build products in this checked out
495         # version might be in git in the next desired version.
496         system 'git clean -dxf </dev/null';
497         # Needed, because at some revisions the build alters checked out files.
498         # (eg pod/perlapi.pod). Also undoes any changes to makedepend.SH
499         system 'git reset --hard HEAD </dev/null';
500     }
501 }
502
503 sub skip {
504     my $reason = shift;
505     clean();
506     warn "skipping - $reason";
507     exit 125;
508 }
509
510 sub report_and_exit {
511     my ($ret, $pass, $fail, $desc) = @_;
512
513     clean();
514
515     my $got = ($options{'expect-pass'} ? !$ret : $ret) ? 'good' : 'bad';
516     if ($ret) {
517         print "$got - $fail $desc\n";
518     } else {
519         print "$got - $pass $desc\n";
520     }
521
522     exit($got eq 'bad');
523 }
524
525 sub match_and_exit {
526     my $target = shift;
527     my $matches = 0;
528     my $re = qr/$match/;
529     my @files;
530
531     {
532         local $/ = "\0";
533         @files = defined $target ? `git ls-files -o -z`: `git ls-files -z`;
534         chomp @files;
535     }
536
537     foreach my $file (@files) {
538         my $fh = open_or_die($file);
539         while (<$fh>) {
540             if ($_ =~ $re) {
541                 ++$matches;
542                 if (tr/\t\r\n -~\200-\377//c) {
543                     print "Binary file $file matches\n";
544                 } else {
545                     $_ .= "\n" unless /\n\z/;
546                     print "$file: $_";
547                 }
548             }
549         }
550         close_or_die($fh);
551     }
552     report_and_exit(!$matches,
553                     $matches == 1 ? '1 match for' : "$matches matches for",
554                     'no matches for', $match);
555 }
556
557 # Not going to assume that system perl is yet new enough to have autodie
558 system 'git clean -dxf </dev/null' and die;
559
560 if (!defined $target) {
561     match_and_exit() if $match;
562     $target = 'test_prep';
563 }
564
565 skip('no Configure - is this the //depot/perlext/Compiler branch?')
566     unless -f 'Configure';
567
568 # This changes to PERL_VERSION in 4d8076ea25903dcb in 1999
569 my $major
570     = extract_from_file('patchlevel.h',
571                         qr/^#define\s+(?:PERL_VERSION|PATCHLEVEL)\s+(\d+)\s/,
572                         0);
573
574 patch_Configure();
575 patch_hints();
576
577 # if Encode is not needed for the test, you can speed up the bisect by
578 # excluding it from the runs with -Dnoextensions=Encode
579 # ccache is an easy win. Remove it if it causes problems.
580 # Commit 1cfa4ec74d4933da adds ignore_versioned_solibs to Configure, and sets it
581 # to true in hints/linux.sh
582 # On dromedary, from that point on, Configure (by default) fails to find any
583 # libraries, because it scans /usr/local/lib /lib /usr/lib, which only contain
584 # versioned libraries. Without -lm, the build fails.
585 # Telling /usr/local/lib64 /lib64 /usr/lib64 works from that commit onwards,
586 # until commit faae14e6e968e1c0 adds it to the hints.
587 # However, prior to 1cfa4ec74d4933da telling Configure the truth doesn't work,
588 # because it will spot versioned libraries, pass them to the compiler, and then
589 # bail out pretty early on. Configure won't let us override libswanted, but it
590 # will let us override the entire libs list.
591
592 unless (extract_from_file('Configure', 'ignore_versioned_solibs')) {
593     # Before 1cfa4ec74d4933da, so force the libs list.
594
595     my @libs;
596     # This is the current libswanted list from Configure, less the libs removed
597     # by current hints/linux.sh
598     foreach my $lib (qw(sfio socket inet nsl nm ndbm gdbm dbm db malloc dl dld
599                         ld sun m crypt sec util c cposix posix ucb BSD)) {
600         foreach my $dir (@paths) {
601             next unless -f "$dir/lib$lib.so";
602             push @libs, "-l$lib";
603             last;
604         }
605     }
606     $defines{libs} = \@libs unless exists $defines{libs};
607 }
608
609 $defines{usenm} = undef
610     if $major < 2 && !exists $defines{usenm};
611
612 my ($missing, $created_dirs);
613 ($missing, $created_dirs) = force_manifest()
614     if $options{'force-manifest'};
615
616 my @ARGS = '-dEs';
617 foreach my $key (sort keys %defines) {
618     my $val = $defines{$key};
619     if (ref $val) {
620         push @ARGS, "-D$key=@$val";
621     } elsif (!defined $val) {
622         push @ARGS, "-U$key";
623     } elsif (!length $val) {
624         push @ARGS, "-D$key";
625     } else {
626         $val = "" if $val eq "\0";
627         push @ARGS, "-D$key=$val";
628     }
629 }
630 push @ARGS, map {"-A$_"} @{$options{A}};
631
632 # </dev/null because it seems that some earlier versions of Configure can
633 # call commands in a way that now has them reading from stdin (and hanging)
634 my $pid = fork;
635 die "Can't fork: $!" unless defined $pid;
636 if (!$pid) {
637     open STDIN, '<', '/dev/null';
638     # If a file in MANIFEST is missing, Configure asks if you want to
639     # continue (the default being 'n'). With stdin closed or /dev/null,
640     # it exits immediately and the check for config.sh below will skip.
641     exec './Configure', @ARGS;
642     die "Failed to start Configure: $!";
643 }
644 waitpid $pid, 0
645     or die "wait for Configure, pid $pid failed: $!";
646
647 patch_SH();
648
649 if (-f 'config.sh') {
650     # Emulate noextensions if Configure doesn't support it.
651     fake_noextensions()
652         if $major < 10 && $defines{noextensions};
653     system './Configure -S </dev/null' and die;
654 }
655
656 if ($target =~ /config\.s?h/) {
657     match_and_exit($target) if $match && -f $target;
658     report_and_exit(!-f $target, 'could build', 'could not build', $target)
659         if $options{'test-build'};
660
661     my $ret = system @ARGV;
662     report_and_exit($ret, 'zero exit from', 'non-zero exit from', "@ARGV");
663 } elsif (!-f 'config.sh') {
664     # Skip if something went wrong with Configure
665
666     skip('could not build config.sh');
667 }
668
669 force_manifest_cleanup($missing, $created_dirs)
670         if $missing;
671
672 patch_C();
673 patch_ext();
674
675 # Parallel build for miniperl is safe
676 system "make $j miniperl </dev/null";
677
678 my $expected = $target =~ /^test/ ? 't/perl'
679     : $target eq 'Fcntl' ? "lib/auto/Fcntl/Fcntl.$Config{so}"
680     : $target;
681 my $real_target = $target eq 'Fcntl' ? $expected : $target;
682
683 if ($target ne 'miniperl') {
684     # Nearly all parallel build issues fixed by 5.10.0. Untrustworthy before that.
685     $j = '' if $major < 10;
686
687     if ($real_target eq 'test_prep') {
688         if ($major < 8) {
689             # test-prep was added in 5.004_01, 3e3baf6d63945cb6.
690             # renamed to test_prep in 2001 in 5fe84fd29acaf55c.
691             # earlier than that, just make test. It will be fast enough.
692             $real_target = extract_from_file('Makefile.SH',
693                                              qr/^(test[-_]prep):/,
694                                              'test');
695         }
696     }
697
698     system "make $j $real_target </dev/null";
699 }
700
701 my $missing_target = $expected =~ /perl$/ ? !-x $expected : !-r $expected;
702
703 if ($options{'test-build'}) {
704     report_and_exit($missing_target, 'could build', 'could not build',
705                     $real_target);
706 } elsif ($missing_target) {
707     skip("could not build $real_target");
708 }
709
710 match_and_exit($real_target) if $match;
711
712 if (defined $options{'one-liner'}) {
713     my $exe = $target =~ /^(?:perl$|test)/ ? 'perl' : 'miniperl';
714     unshift @ARGV, "./$exe", '-Ilib', '-e', $options{'one-liner'};
715 }
716
717 # This is what we came here to run:
718
719 if (exists $Config{ldlibpthname}) {
720     require Cwd;
721     my $varname = $Config{ldlibpthname};
722     my $cwd = Cwd::getcwd();
723     if (defined $ENV{$varname}) {
724         $ENV{$varname} = $cwd . $Config{path_sep} . $ENV{$varname};
725     } else {
726         $ENV{$varname} = $cwd;
727     }
728 }
729
730 my $ret = system @ARGV;
731
732 report_and_exit($ret, 'zero exit from', 'non-zero exit from', "@ARGV");
733
734 ############################################################################
735 #
736 # Patching, editing and faking routines only below here.
737 #
738 ############################################################################
739
740 sub fake_noextensions {
741     edit_file('config.sh', sub {
742                   my @lines = split /\n/, shift;
743                   my @ext = split /\s+/, $defines{noextensions};
744                   foreach (@lines) {
745                       next unless /^extensions=/ || /^dynamic_ext/;
746                       foreach my $ext (@ext) {
747                           s/\b$ext( )?\b/$1/;
748                       }
749                   }
750                   return join "\n", @lines;
751               });
752 }
753
754 sub force_manifest {
755     my (@missing, @created_dirs);
756     my $fh = open_or_die('MANIFEST');
757     while (<$fh>) {
758         next unless /^(\S+)/;
759         # -d is special case needed (at least) between 27332437a2ed1941 and
760         # bf3d9ec563d25054^ inclusive, as manifest contains ext/Thread/Thread
761         push @missing, $1
762             unless -f $1 || -d $1;
763     }
764     close_or_die($fh);
765
766     foreach my $pathname (@missing) {
767         my @parts = split '/', $pathname;
768         my $leaf = pop @parts;
769         my $path = '.';
770         while (@parts) {
771             $path .= '/' . shift @parts;
772             next if -d $path;
773             mkdir $path, 0700 or die "Can't create $path: $!";
774             unshift @created_dirs, $path;
775         }
776         $fh = open_or_die($pathname, '>');
777         close_or_die($fh);
778         chmod 0, $pathname or die "Can't chmod 0 $pathname: $!";
779     }
780     return \@missing, \@created_dirs;
781 }
782
783 sub force_manifest_cleanup {
784     my ($missing, $created_dirs) = @_;
785     # This is probably way too paranoid:
786     my @errors;
787     require Fcntl;
788     foreach my $file (@$missing) {
789         my (undef, undef, $mode, undef, undef, undef, undef, $size)
790             = stat $file;
791         if (!defined $mode) {
792             push @errors, "Added file $file has been deleted by Configure";
793             next;
794         }
795         if (Fcntl::S_IMODE($mode) != 0) {
796             push @errors,
797                 sprintf 'Added file %s had mode changed by Configure to %03o',
798                     $file, $mode;
799         }
800         if ($size != 0) {
801             push @errors,
802                 "Added file $file had sized changed by Configure to $size";
803         }
804         unlink $file or die "Can't unlink $file: $!";
805     }
806     foreach my $dir (@$created_dirs) {
807         rmdir $dir or die "Can't rmdir $dir: $!";
808     }
809     skip("@errors")
810         if @errors;
811 }
812
813 sub patch_Configure {
814     if ($major < 1) {
815         if (extract_from_file('Configure',
816                               qr/^\t\t\*=\*\) echo "\$1" >> \$optdef;;$/)) {
817             # This is "        Spaces now allowed in -D command line options.",
818             # part of commit ecfc54246c2a6f42
819             apply_patch(<<'EOPATCH');
820 diff --git a/Configure b/Configure
821 index 3d3b38d..78ffe16 100755
822 --- a/Configure
823 +++ b/Configure
824 @@ -652,7 +777,8 @@ while test $# -gt 0; do
825                         echo "$me: use '-U symbol=', not '-D symbol='." >&2
826                         echo "$me: ignoring -D $1" >&2
827                         ;;
828 -               *=*) echo "$1" >> $optdef;;
829 +               *=*) echo "$1" | \
830 +                               sed -e "s/'/'\"'\"'/g" -e "s/=\(.*\)/='\1'/" >> $optdef;;
831                 *) echo "$1='define'" >> $optdef;;
832                 esac
833                 shift
834 EOPATCH
835         }
836
837         if (extract_from_file('Configure', qr/^if \$contains 'd_namlen' \$xinc\b/)) {
838             # Configure's original simple "grep" for d_namlen falls foul of the
839             # approach taken by the glibc headers:
840             # #ifdef _DIRENT_HAVE_D_NAMLEN
841             # # define _D_EXACT_NAMLEN(d) ((d)->d_namlen)
842             #
843             # where _DIRENT_HAVE_D_NAMLEN is not defined on Linux.
844             # This is also part of commit ecfc54246c2a6f42
845             apply_patch(<<'EOPATCH');
846 diff --git a/Configure b/Configure
847 index 3d3b38d..78ffe16 100755
848 --- a/Configure
849 +++ b/Configure
850 @@ -3935,7 +4045,8 @@ $rm -f try.c
851  
852  : see if the directory entry stores field length
853  echo " "
854 -if $contains 'd_namlen' $xinc >/dev/null 2>&1; then
855 +$cppstdin $cppflags $cppminus < "$xinc" > try.c
856 +if $contains 'd_namlen' try.c >/dev/null 2>&1; then
857         echo "Good, your directory entry keeps length information in d_namlen." >&4
858         val="$define"
859  else
860 EOPATCH
861         }
862     }
863
864     if ($major < 2
865         && !extract_from_file('Configure',
866                               qr/Try to guess additional flags to pick up local libraries/)) {
867         my $mips = extract_from_file('Configure',
868                                      qr!(''\) if (?:\./)?mips; then)!);
869         # This is part of perl-5.001n. It's needed, to add -L/usr/local/lib to
870         # theld flags if libraries are found there. It shifts the code to set up
871         # libpth earlier, and then adds the code to add libpth entries to
872         # ldflags
873         # mips was changed to ./mips in ecfc54246c2a6f42, perl5.000 patch.0g
874         apply_patch(sprintf <<'EOPATCH', $mips);
875 diff --git a/Configure b/Configure
876 index 53649d5..0635a6e 100755
877 --- a/Configure
878 +++ b/Configure
879 @@ -2749,6 +2749,52 @@ EOM
880         ;;
881  esac
882  
883 +: Set private lib path
884 +case "$plibpth" in
885 +'') if ./mips; then
886 +               plibpth="$incpath/usr/lib /usr/local/lib /usr/ccs/lib"
887 +       fi;;
888 +esac
889 +case "$libpth" in
890 +' ') dlist='';;
891 +'') dlist="$plibpth $glibpth";;
892 +*) dlist="$libpth";;
893 +esac
894 +
895 +: Now check and see which directories actually exist, avoiding duplicates
896 +libpth=''
897 +for xxx in $dlist
898 +do
899 +    if $test -d $xxx; then
900 +               case " $libpth " in
901 +               *" $xxx "*) ;;
902 +               *) libpth="$libpth $xxx";;
903 +               esac
904 +    fi
905 +done
906 +$cat <<'EOM'
907 +
908 +Some systems have incompatible or broken versions of libraries.  Among
909 +the directories listed in the question below, please remove any you
910 +know not to be holding relevant libraries, and add any that are needed.
911 +Say "none" for none.
912 +
913 +EOM
914 +case "$libpth" in
915 +'') dflt='none';;
916 +*)
917 +       set X $libpth
918 +       shift
919 +       dflt=${1+"$@"}
920 +       ;;
921 +esac
922 +rp="Directories to use for library searches?"
923 +. ./myread
924 +case "$ans" in
925 +none) libpth=' ';;
926 +*) libpth="$ans";;
927 +esac
928 +
929  : flags used in final linking phase
930  case "$ldflags" in
931  '') if ./venix; then
932 @@ -2765,6 +2811,23 @@ case "$ldflags" in
933         ;;
934  *) dflt="$ldflags";;
935  esac
936 +
937 +: Possible local library directories to search.
938 +loclibpth="/usr/local/lib /opt/local/lib /usr/gnu/lib"
939 +loclibpth="$loclibpth /opt/gnu/lib /usr/GNU/lib /opt/GNU/lib"
940 +
941 +: Try to guess additional flags to pick up local libraries.
942 +for thislibdir in $libpth; do
943 +       case " $loclibpth " in
944 +       *" $thislibdir "*)
945 +               case "$dflt " in 
946 +               "-L$thislibdir ") ;;
947 +               *)  dflt="$dflt -L$thislibdir" ;;
948 +               esac
949 +               ;;
950 +       esac
951 +done
952 +
953  echo " "
954  rp="Any additional ld flags (NOT including libraries)?"
955  . ./myread
956 @@ -2828,52 +2891,6 @@ n) echo "OK, that should do.";;
957  esac
958  $rm -f try try.* core
959  
960 -: Set private lib path
961 -case "$plibpth" in
962 -%s
963 -               plibpth="$incpath/usr/lib /usr/local/lib /usr/ccs/lib"
964 -       fi;;
965 -esac
966 -case "$libpth" in
967 -' ') dlist='';;
968 -'') dlist="$plibpth $glibpth";;
969 -*) dlist="$libpth";;
970 -esac
971 -
972 -: Now check and see which directories actually exist, avoiding duplicates
973 -libpth=''
974 -for xxx in $dlist
975 -do
976 -    if $test -d $xxx; then
977 -               case " $libpth " in
978 -               *" $xxx "*) ;;
979 -               *) libpth="$libpth $xxx";;
980 -               esac
981 -    fi
982 -done
983 -$cat <<'EOM'
984 -
985 -Some systems have incompatible or broken versions of libraries.  Among
986 -the directories listed in the question below, please remove any you
987 -know not to be holding relevant libraries, and add any that are needed.
988 -Say "none" for none.
989 -
990 -EOM
991 -case "$libpth" in
992 -'') dflt='none';;
993 -*)
994 -       set X $libpth
995 -       shift
996 -       dflt=${1+"$@"}
997 -       ;;
998 -esac
999 -rp="Directories to use for library searches?"
1000 -. ./myread
1001 -case "$ans" in
1002 -none) libpth=' ';;
1003 -*) libpth="$ans";;
1004 -esac
1005 -
1006  : compute shared library extension
1007  case "$so" in
1008  '')
1009 EOPATCH
1010     }
1011
1012     if ($major < 5 && extract_from_file('Configure',
1013                                         qr!if \$cc \$ccflags try\.c -o try >/dev/null 2>&1; then!)) {
1014         # Analogous to the more general fix of dfe9444ca7881e71
1015         # Without this flags such as -m64 may not be passed to this compile,
1016         # which results in a byteorder of '1234' instead of '12345678', which
1017         # can then cause crashes.
1018
1019         if (extract_from_file('Configure', qr/xxx_prompt=y/)) {
1020             # 8e07c86ebc651fe9 or later
1021             # ("This is my patch  patch.1n  for perl5.001.")
1022             apply_patch(<<'EOPATCH');
1023 diff --git a/Configure b/Configure
1024 index 62249dd..c5c384e 100755
1025 --- a/Configure
1026 +++ b/Configure
1027 @@ -8247,7 +8247,7 @@ main()
1028  }
1029  EOCP
1030         xxx_prompt=y
1031 -       if $cc $ccflags try.c -o try >/dev/null 2>&1 && ./try > /dev/null; then
1032 +       if $cc $ccflags $ldflags try.c -o try >/dev/null 2>&1 && ./try > /dev/null; then
1033                 dflt=`./try`
1034                 case "$dflt" in
1035                 [1-4][1-4][1-4][1-4]|12345678|87654321)
1036 EOPATCH
1037         } else {
1038             apply_patch(<<'EOPATCH');
1039 diff --git a/Configure b/Configure
1040 index 53649d5..f1cd64a 100755
1041 --- a/Configure
1042 +++ b/Configure
1043 @@ -6362,7 +6362,7 @@ main()
1044         printf("\n");
1045  }
1046  EOCP
1047 -       if $cc $ccflags try.c -o try >/dev/null 2>&1 ; then
1048 +       if $cc $ccflags $ldflags try.c -o try >/dev/null 2>&1 ; then
1049                 dflt=`./try`
1050                 case "$dflt" in
1051                 ????|????????) echo "(The test program ran ok.)";;
1052 EOPATCH
1053         }
1054     }
1055
1056     if ($major < 6 && !extract_from_file('Configure',
1057                                          qr!^\t-A\)$!)) {
1058         # This adds the -A option to Configure, which is incredibly useful
1059         # Effectively this is commits 02e93a22d20fc9a5, 5f83a3e9d818c3ad,
1060         # bde6b06b2c493fef, f7c3111703e46e0c and 2 lines of trailing whitespace
1061         # removed by 613d6c3e99b9decc, but applied at slightly different
1062         # locations to ensure a clean patch back to 5.000
1063         # Note, if considering patching to the intermediate revisions to fix
1064         # bugs in -A handling, f7c3111703e46e0c is from 2002, and hence
1065         # $major == 8
1066
1067         # To add to the fun, early patches add -K and -O options, and it's not
1068         # trivial to get patch to put the C<. ./posthint.sh> in the right place
1069         edit_file('Configure', sub {
1070                       my $code = shift;
1071                       $code =~ s/(optstr = ")([^"]+";\s*# getopt-style specification)/$1A:$2/
1072                           or die "Substitution failed";
1073                       $code =~ s!^(: who configured the system)!
1074 touch posthint.sh
1075 . ./posthint.sh
1076
1077 $1!ms
1078                           or die "Substitution failed";
1079                       return $code;
1080                   });
1081         apply_patch(<<'EOPATCH');
1082 diff --git a/Configure b/Configure
1083 index 4b55fa6..60c3c64 100755
1084 --- a/Configure
1085 +++ b/Configure
1086 @@ -1150,6 +1150,7 @@ set X `for arg in "$@"; do echo "X$arg"; done |
1087  eval "set $*"
1088  shift
1089  rm -f options.awk
1090 +rm -f posthint.sh
1091  
1092  : set up default values
1093  fastread=''
1094 @@ -1172,6 +1173,56 @@ while test $# -gt 0; do
1095         case "$1" in
1096         -d) shift; fastread=yes;;
1097         -e) shift; alldone=cont;;
1098 +       -A)
1099 +           shift
1100 +           xxx=''
1101 +           yyy="$1"
1102 +           zzz=''
1103 +           uuu=undef
1104 +           case "$yyy" in
1105 +            *=*) zzz=`echo "$yyy"|sed 's!=.*!!'`
1106 +                 case "$zzz" in
1107 +                 *:*) zzz='' ;;
1108 +                 *)   xxx=append
1109 +                      zzz=" "`echo "$yyy"|sed 's!^[^=]*=!!'`
1110 +                      yyy=`echo "$yyy"|sed 's!=.*!!'` ;;
1111 +                 esac
1112 +                 ;;
1113 +            esac
1114 +            case "$xxx" in
1115 +            '')  case "$yyy" in
1116 +                 *:*) xxx=`echo "$yyy"|sed 's!:.*!!'`
1117 +                      yyy=`echo "$yyy"|sed 's!^[^:]*:!!'`
1118 +                      zzz=`echo "$yyy"|sed 's!^[^=]*=!!'`
1119 +                      yyy=`echo "$yyy"|sed 's!=.*!!'` ;;
1120 +                 *)   xxx=`echo "$yyy"|sed 's!:.*!!'`
1121 +                      yyy=`echo "$yyy"|sed 's!^[^:]*:!!'` ;;
1122 +                 esac
1123 +                 ;;
1124 +            esac
1125 +           case "$xxx" in
1126 +           append)
1127 +               echo "$yyy=\"\${$yyy}$zzz\""    >> posthint.sh ;;
1128 +           clear)
1129 +               echo "$yyy=''"                  >> posthint.sh ;;
1130 +           define)
1131 +               case "$zzz" in
1132 +               '') zzz=define ;;
1133 +               esac
1134 +               echo "$yyy='$zzz'"              >> posthint.sh ;;
1135 +           eval)
1136 +               echo "eval \"$yyy=$zzz\""       >> posthint.sh ;;
1137 +           prepend)
1138 +               echo "$yyy=\"$zzz\${$yyy}\""    >> posthint.sh ;;
1139 +           undef)
1140 +               case "$zzz" in
1141 +               '') zzz="$uuu" ;;
1142 +               esac
1143 +               echo "$yyy=$zzz"                >> posthint.sh ;;
1144 +            *)  echo "$me: unknown -A command '$xxx', ignoring -A $1" >&2 ;;
1145 +           esac
1146 +           shift
1147 +           ;;
1148         -f)
1149                 shift
1150                 cd ..
1151 EOPATCH
1152     }
1153
1154     if ($major < 8 && !extract_from_file('Configure',
1155                                          qr/^\t\tif test ! -t 0; then$/)) {
1156         # Before dfe9444ca7881e71, Configure would refuse to run if stdin was
1157         # not a tty. With that commit, the tty requirement was dropped for -de
1158         # and -dE
1159         # Commit aaeb8e512e8e9e14 dropped the tty requirement for -S
1160         # For those older versions, it's probably easiest if we simply remove
1161         # the sanity test.
1162         edit_file('Configure', sub {
1163                       my $code = shift;
1164                       $code =~ s/test ! -t 0/test Perl = rules/;
1165                       return $code;
1166                   });
1167     }
1168
1169     if ($major == 8 || $major == 9) {
1170         # Fix symbol detection to that of commit 373dfab3839ca168 if it's any
1171         # intermediate version 5129fff43c4fe08c or later, as the intermediate
1172         # versions don't work correctly on (at least) Sparc Linux.
1173         # 5129fff43c4fe08c adds the first mention of mistrustnm.
1174         # 373dfab3839ca168 removes the last mention of lc=""
1175         edit_file('Configure', sub {
1176                       my $code = shift;
1177                       return $code
1178                           if $code !~ /\btc="";/; # 373dfab3839ca168 or later
1179                       return $code
1180                           if $code !~ /\bmistrustnm\b/; # before 5129fff43c4fe08c
1181                       my $fixed = <<'EOC';
1182
1183 : is a C symbol defined?
1184 csym='tlook=$1;
1185 case "$3" in
1186 -v) tf=libc.tmp; tdc="";;
1187 -a) tf=libc.tmp; tdc="[]";;
1188 *) tlook="^$1\$"; tf=libc.list; tdc="()";;
1189 esac;
1190 tx=yes;
1191 case "$reuseval-$4" in
1192 true-) ;;
1193 true-*) tx=no; eval "tval=\$$4"; case "$tval" in "") tx=yes;; esac;;
1194 esac;
1195 case "$tx" in
1196 yes)
1197         tval=false;
1198         if $test "$runnm" = true; then
1199                 if $contains $tlook $tf >/dev/null 2>&1; then
1200                         tval=true;
1201                 elif $test "$mistrustnm" = compile -o "$mistrustnm" = run; then
1202                         echo "void *(*(p()))$tdc { extern void *$1$tdc; return &$1; } int main() { if(p()) return(0); else return(1); }"> try.c;
1203                         $cc -o try $optimize $ccflags $ldflags try.c >/dev/null 2>&1 $libs && tval=true;
1204                         $test "$mistrustnm" = run -a -x try && { $run ./try$_exe >/dev/null 2>&1 || tval=false; };
1205                         $rm -f try$_exe try.c core core.* try.core;
1206                 fi;
1207         else
1208                 echo "void *(*(p()))$tdc { extern void *$1$tdc; return &$1; } int main() { if(p()) return(0); else return(1); }"> try.c;
1209                 $cc -o try $optimize $ccflags $ldflags try.c $libs >/dev/null 2>&1 && tval=true;
1210                 $rm -f try$_exe try.c;
1211         fi;
1212         ;;
1213 *)
1214         case "$tval" in
1215         $define) tval=true;;
1216         *) tval=false;;
1217         esac;
1218         ;;
1219 esac;
1220 eval "$2=$tval"'
1221
1222 EOC
1223                       $code =~ s/\n: is a C symbol defined\?\n.*?\neval "\$2=\$tval"'\n\n/$fixed/sm
1224                           or die "substitution failed";
1225                       return $code;
1226                   });
1227     }
1228
1229     if ($major < 10
1230         && extract_from_file('Configure', qr/^set malloc\.h i_malloc$/)) {
1231         # This is commit 01d07975f7ef0e7d, trimmed, with $compile inlined as
1232         # prior to bd9b35c97ad661cc Configure had the malloc.h test before the
1233         # definition of $compile.
1234         apply_patch(<<'EOPATCH');
1235 diff --git a/Configure b/Configure
1236 index 3d2e8b9..6ce7766 100755
1237 --- a/Configure
1238 +++ b/Configure
1239 @@ -6743,5 +6743,22 @@ set d_dosuid
1240  
1241  : see if this is a malloc.h system
1242 -set malloc.h i_malloc
1243 -eval $inhdr
1244 +: we want a real compile instead of Inhdr because some systems have a
1245 +: malloc.h that just gives a compile error saying to use stdlib.h instead
1246 +echo " "
1247 +$cat >try.c <<EOCP
1248 +#include <stdlib.h>
1249 +#include <malloc.h>
1250 +int main () { return 0; }
1251 +EOCP
1252 +set try
1253 +if $cc $optimize $ccflags $ldflags -o try $* try.c $libs > /dev/null 2>&1; then
1254 +    echo "<malloc.h> found." >&4
1255 +    val="$define"
1256 +else
1257 +    echo "<malloc.h> NOT found." >&4
1258 +    val="$undef"
1259 +fi
1260 +$rm -f try.c try
1261 +set i_malloc
1262 +eval $setvar
1263  
1264 EOPATCH
1265     }
1266 }
1267
1268 sub patch_hints {
1269     if ($^O eq 'freebsd') {
1270         # There are rather too many version-specific FreeBSD hints fixes to
1271         # patch individually. Also, more than once the FreeBSD hints file has
1272         # been written in what turned out to be a rather non-future-proof style,
1273         # with case statements treating the most recent version as the
1274         # exception, instead of treating previous versions' behaviour explicitly
1275         # and changing the default to cater for the current behaviour. (As
1276         # strangely, future versions inherit the current behaviour.)
1277         checkout_file('hints/freebsd.sh');
1278     } elsif ($^O eq 'darwin') {
1279         if ($major < 8) {
1280             # We can't build on darwin without some of the data in the hints
1281             # file. Probably less surprising to use the earliest version of
1282             # hints/darwin.sh and then edit in place just below, than use
1283             # blead's version, as that would create a discontinuity at
1284             # f556e5b971932902 - before it, hints bugs would be "fixed", after
1285             # it they'd resurface. This way, we should give the illusion of
1286             # monotonic bug fixing.
1287             my $faking_it;
1288             if (!-f 'hints/darwin.sh') {
1289                 checkout_file('hints/darwin.sh', 'f556e5b971932902');
1290                 ++$faking_it;
1291             }
1292
1293             edit_file('hints/darwin.sh', sub {
1294                       my $code = shift;
1295                       # Part of commit 8f4f83badb7d1ba9, which mostly undoes
1296                       # commit 0511a818910f476c.
1297                       $code =~ s/^cppflags='-traditional-cpp';$/cppflags="\${cppflags} -no-cpp-precomp"/m;
1298                       # commit 14c11978e9b52e08/803bb6cc74d36a3f
1299                       # Without this, code in libperl.bundle links against op.o
1300                       # in preference to opmini.o on the linker command line,
1301                       # and hence miniperl tries to use File::Glob instead of
1302                       # csh
1303                       $code =~ s/^(lddlflags=)/ldflags="\${ldflags} -flat_namespace"\n$1/m;
1304                       # f556e5b971932902 also patches Makefile.SH with some
1305                       # special case code to deal with useshrplib for darwin.
1306                       # Given that post 5.8.0 the darwin hints default was
1307                       # changed to false, and it would be very complex to splice
1308                       # in that code in various versions of Makefile.SH back
1309                       # to 5.002, lets just turn it off.
1310                       $code =~ s/^useshrplib='true'/useshrplib='false'/m
1311                           if $faking_it;
1312                       return $code;
1313                   });
1314         }
1315     } elsif ($^O eq 'netbsd') {
1316         if ($major < 6) {
1317             # These are part of commit 099685bc64c7dbce
1318             edit_file('hints/netbsd.sh', sub {
1319                           my $code = shift;
1320                           my $fixed = <<'EOC';
1321 case "$osvers" in
1322 0.9|0.8*)
1323         usedl="$undef"
1324         ;;
1325 *)
1326         if [ -f /usr/libexec/ld.elf_so ]; then
1327                 d_dlopen=$define
1328                 d_dlerror=$define
1329                 ccdlflags="-Wl,-E -Wl,-R${PREFIX}/lib $ccdlflags"
1330                 cccdlflags="-DPIC -fPIC $cccdlflags"
1331                 lddlflags="--whole-archive -shared $lddlflags"
1332         elif [ "`uname -m`" = "pmax" ]; then
1333 # NetBSD 1.3 and 1.3.1 on pmax shipped an `old' ld.so, which will not work.
1334                 d_dlopen=$undef
1335         elif [ -f /usr/libexec/ld.so ]; then
1336                 d_dlopen=$define
1337                 d_dlerror=$define
1338                 ccdlflags="-Wl,-R${PREFIX}/lib $ccdlflags"
1339 # we use -fPIC here because -fpic is *NOT* enough for some of the
1340 # extensions like Tk on some netbsd platforms (the sparc is one)
1341                 cccdlflags="-DPIC -fPIC $cccdlflags"
1342                 lddlflags="-Bforcearchive -Bshareable $lddlflags"
1343         else
1344                 d_dlopen=$undef
1345         fi
1346         ;;
1347 esac
1348 EOC
1349                           $code =~ s/^case "\$osvers" in\n0\.9\|0\.8.*?^esac\n/$fixed/ms;
1350                           return $code;
1351                       });
1352         }
1353     } elsif ($^O eq 'openbsd') {
1354         if ($major < 8) {
1355             checkout_file('hints/openbsd.sh', '43051805d53a3e4c')
1356                 unless -f 'hints/openbsd.sh';
1357             my $which = extract_from_file('hints/openbsd.sh',
1358                                           qr/# from (2\.8|3\.1) onwards/,
1359                                           '');
1360             if ($which eq '') {
1361                 my $was = extract_from_file('hints/openbsd.sh',
1362                                             qr/(lddlflags="(?:-Bforcearchive )?-Bshareable)/);
1363                 # This is commit 154d43cbcf57271c and parts of 5c75dbfa77b0949c
1364                 # and 29b5585702e5e025
1365                 apply_patch(sprintf <<'EOPATCH', $was);
1366 diff --git a/hints/openbsd.sh b/hints/openbsd.sh
1367 index a7d8bf2..5b79709 100644
1368 --- a/hints/openbsd.sh
1369 +++ b/hints/openbsd.sh
1370 @@ -37,7 +37,25 @@ OpenBSD.alpha|OpenBSD.mips|OpenBSD.powerpc|OpenBSD.vax)
1371         # we use -fPIC here because -fpic is *NOT* enough for some of the
1372         # extensions like Tk on some OpenBSD platforms (ie: sparc)
1373         cccdlflags="-DPIC -fPIC $cccdlflags"
1374 -       %s $lddlflags"
1375 +       case "$osvers" in
1376 +       [01].*|2.[0-7]|2.[0-7].*)
1377 +               lddlflags="-Bshareable $lddlflags"
1378 +               ;;
1379 +       2.[8-9]|3.0)
1380 +               ld=${cc:-cc}
1381 +               lddlflags="-shared -fPIC $lddlflags"
1382 +               ;;
1383 +       *) # from 3.1 onwards
1384 +               ld=${cc:-cc}
1385 +               lddlflags="-shared -fPIC $lddlflags"
1386 +               libswanted=`echo $libswanted | sed 's/ dl / /'`
1387 +               ;;
1388 +       esac
1389 +
1390 +       # We need to force ld to export symbols on ELF platforms.
1391 +       # Without this, dlopen() is crippled.
1392 +       ELF=`${cc:-cc} -dM -E - </dev/null | grep __ELF__`
1393 +       test -n "$ELF" && ldflags="-Wl,-E $ldflags"
1394         ;;
1395  esac
1396  
1397 EOPATCH
1398             } elsif ($which eq '2.8') {
1399                 # This is parts of 5c75dbfa77b0949c and 29b5585702e5e025, and
1400                 # possibly eb9cd59d45ad2908
1401                 my $was = extract_from_file('hints/openbsd.sh',
1402                                             qr/lddlflags="(-shared(?: -fPIC)?) \$lddlflags"/);
1403
1404                 apply_patch(sprintf <<'EOPATCH', $was);
1405 --- a/hints/openbsd.sh  2011-10-21 17:25:20.000000000 +0200
1406 +++ b/hints/openbsd.sh  2011-10-21 16:58:43.000000000 +0200
1407 @@ -44,11 +44,21 @@
1408         [01].*|2.[0-7]|2.[0-7].*)
1409                 lddlflags="-Bshareable $lddlflags"
1410                 ;;
1411 -       *) # from 2.8 onwards
1412 +       2.[8-9]|3.0)
1413                 ld=${cc:-cc}
1414 -               lddlflags="%s $lddlflags"
1415 +               lddlflags="-shared -fPIC $lddlflags"
1416 +               ;;
1417 +       *) # from 3.1 onwards
1418 +               ld=${cc:-cc}
1419 +               lddlflags="-shared -fPIC $lddlflags"
1420 +               libswanted=`echo $libswanted | sed 's/ dl / /'`
1421                 ;;
1422         esac
1423 +
1424 +       # We need to force ld to export symbols on ELF platforms.
1425 +       # Without this, dlopen() is crippled.
1426 +       ELF=`${cc:-cc} -dM -E - </dev/null | grep __ELF__`
1427 +       test -n "$ELF" && ldflags="-Wl,-E $ldflags"
1428         ;;
1429  esac
1430  
1431 EOPATCH
1432             } elsif ($which eq '3.1'
1433                      && !extract_from_file('hints/openbsd.sh',
1434                                            qr/We need to force ld to export symbols on ELF platforms/)) {
1435                 # This is part of 29b5585702e5e025
1436                 apply_patch(<<'EOPATCH');
1437 diff --git a/hints/openbsd.sh b/hints/openbsd.sh
1438 index c6b6bc9..4839d04 100644
1439 --- a/hints/openbsd.sh
1440 +++ b/hints/openbsd.sh
1441 @@ -54,6 +54,11 @@ alpha-2.[0-8]|mips-*|vax-*|powerpc-2.[0-7]|m88k-*)
1442                 libswanted=`echo $libswanted | sed 's/ dl / /'`
1443                 ;;
1444         esac
1445 +
1446 +       # We need to force ld to export symbols on ELF platforms.
1447 +       # Without this, dlopen() is crippled.
1448 +       ELF=`${cc:-cc} -dM -E - </dev/null | grep __ELF__`
1449 +       test -n "$ELF" && ldflags="-Wl,-E $ldflags"
1450         ;;
1451  esac
1452  
1453 EOPATCH
1454             }
1455         }
1456     } elsif ($^O eq 'linux') {
1457         if ($major < 1) {
1458             # sparc linux seems to need the -Dbool=char -DHAS_BOOL part of
1459             # perl5.000 patch.0n: [address Configure and build issues]
1460             edit_file('hints/linux.sh', sub {
1461                           my $code = shift;
1462                           $code =~ s!-I/usr/include/bsd!-Dbool=char -DHAS_BOOL!g;
1463                           return $code;
1464                       });
1465         }
1466
1467         if ($major <= 9) {
1468             if (`uname -sm` =~ qr/^Linux sparc/) {
1469                 if (extract_from_file('hints/linux.sh', qr/sparc-linux/)) {
1470                     # Be sure to use -fPIC not -fpic on Linux/SPARC
1471                     apply_commit('f6527d0ef0c13ad4');
1472                 } elsif(!extract_from_file('hints/linux.sh',
1473                                            qr/^sparc-linux\)$/)) {
1474                     my $fh = open_or_die('hints/linux.sh', '>>');
1475                     print $fh <<'EOT' or die $!;
1476
1477 case "`uname -m`" in
1478 sparc*)
1479         case "$cccdlflags" in
1480         *-fpic*) cccdlflags="`echo $cccdlflags|sed 's/-fpic/-fPIC/'`" ;;
1481         *)       cccdlflags="$cccdlflags -fPIC" ;;
1482         esac
1483         ;;
1484 esac
1485 EOT
1486                     close_or_die($fh);
1487                 }
1488             }
1489         }
1490     }
1491 }
1492
1493 sub patch_SH {
1494     # Cwd.xs added in commit 0d2079faa739aaa9. Cwd.pm moved to ext/ 8 years
1495     # later in commit 403f501d5b37ebf0
1496     if ($major > 0 && <*/Cwd/Cwd.xs>) {
1497         if ($major < 10
1498             && !extract_from_file('Makefile.SH', qr/^extra_dep=''$/)) {
1499             # The Makefile.PL for Unicode::Normalize needs
1500             # lib/unicore/CombiningClass.pl. Even without a parallel build, we
1501             # need a dependency to ensure that it builds. This is a variant of
1502             # commit 9f3ef600c170f61e. Putting this for earlier versions gives
1503             # us a spot on which to hang the edits below
1504             apply_patch(<<'EOPATCH');
1505 diff --git a/Makefile.SH b/Makefile.SH
1506 index f61d0db..6097954 100644
1507 --- a/Makefile.SH
1508 +++ b/Makefile.SH
1509 @@ -155,10 +155,20 @@ esac
1510  
1511  : Prepare dependency lists for Makefile.
1512  dynamic_list=' '
1513 +extra_dep=''
1514  for f in $dynamic_ext; do
1515      : the dependency named here will never exist
1516        base=`echo "$f" | sed 's/.*\///'`
1517 -    dynamic_list="$dynamic_list lib/auto/$f/$base.$dlext"
1518 +    this_target="lib/auto/$f/$base.$dlext"
1519 +    dynamic_list="$dynamic_list $this_target"
1520 +
1521 +    : Parallel makes reveal that we have some interdependencies
1522 +    case $f in
1523 +       Math/BigInt/FastCalc) extra_dep="$extra_dep
1524 +$this_target: lib/auto/List/Util/Util.$dlext" ;;
1525 +       Unicode/Normalize) extra_dep="$extra_dep
1526 +$this_target: lib/unicore/CombiningClass.pl" ;;
1527 +    esac
1528  done
1529  
1530  static_list=' '
1531 @@ -987,2 +997,9 @@ n_dummy $(nonxs_ext):       miniperl$(EXE_EXT) preplibrary $(DYNALOADER) FORCE
1532         @$(LDLIBPTH) sh ext/util/make_ext nonxs $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL)
1533 +!NO!SUBS!
1534 +
1535 +$spitshell >>Makefile <<EOF
1536 +$extra_dep
1537 +EOF
1538 +
1539 +$spitshell >>Makefile <<'!NO!SUBS!'
1540  
1541 EOPATCH
1542         }
1543         if ($major < 14) {
1544             # Commits dc0655f797469c47 and d11a62fe01f2ecb2
1545             edit_file('Makefile.SH', sub {
1546                           my $code = shift;
1547                           foreach my $ext (qw(Encode SDBM_File)) {
1548                               next if $code =~ /\b$ext\) extra_dep=/s;
1549                               $code =~ s!(\) extra_dep="\$extra_dep
1550 \$this_target: .*?" ;;)
1551 (    esac
1552 )!$1
1553         $ext) extra_dep="\$extra_dep
1554 \$this_target: lib/auto/Cwd/Cwd.\$dlext" ;;
1555 $2!;
1556                           }
1557                           return $code;
1558                       });
1559         }
1560     }
1561
1562     if ($major == 7) {
1563         # Remove commits 9fec149bb652b6e9 and 5bab1179608f81d8, which add/amend
1564         # rules to automatically run regen scripts that rebuild C headers. These
1565         # cause problems because a git checkout doesn't preserve relative file
1566         # modification times, hence the regen scripts may fire. This will
1567         # obscure whether the repository had the correct generated headers
1568         # checked in.
1569         # Also, the dependency rules for running the scripts were not correct,
1570         # which could cause spurious re-builds on re-running make, and can cause
1571         # complete build failures for a parallel make.
1572         if (extract_from_file('Makefile.SH',
1573                               qr/Writing it this way gives make a big hint to always run opcode\.pl before/)) {
1574             apply_commit('70c6e6715e8fec53');
1575         } elsif (extract_from_file('Makefile.SH',
1576                                    qr/^opcode\.h opnames\.h pp_proto\.h pp\.sym: opcode\.pl$/)) {
1577             revert_commit('9fec149bb652b6e9');
1578         }
1579     }
1580
1581     # There was a bug in makedepend.SH which was fixed in version 96a8704c.
1582     # Symptom was './makedepend: 1: Syntax error: Unterminated quoted string'
1583     # Remove this if you're actually bisecting a problem related to
1584     # makedepend.SH
1585     # If you do this, you may need to add in code to correct the output of older
1586     # makedepends, which don't correctly filter newer gcc output such as
1587     # <built-in>
1588     checkout_file('makedepend.SH');
1589
1590     if ($major < 4 && -f 'config.sh'
1591         && !extract_from_file('config.sh', qr/^trnl=/)) {
1592         # This seems to be necessary to avoid makedepend becoming confused,
1593         # and hanging on stdin. Seems that the code after
1594         # make shlist || ...here... is never run.
1595         edit_file('makedepend.SH', sub {
1596                       my $code = shift;
1597                       $code =~ s/^trnl='\$trnl'$/trnl='\\n'/m;
1598                       return $code;
1599                   });
1600     }
1601 }
1602
1603 sub patch_C {
1604     # This is ordered by $major, as it's likely that different platforms may
1605     # well want to share code.
1606
1607     if ($major == 2 && extract_from_file('perl.c', qr/^\tfclose\(e_fp\);$/)) {
1608         # need to patch perl.c to avoid calling fclose() twice on e_fp when
1609         # using -e
1610         # This diff is part of commit ab821d7fdc14a438. The second close was
1611         # introduced with perl-5.002, commit a5f75d667838e8e7
1612         # Might want a6c477ed8d4864e6 too, for the corresponding change to
1613         # pp_ctl.c (likely without this, eval will have "fun")
1614         apply_patch(<<'EOPATCH');
1615 diff --git a/perl.c b/perl.c
1616 index 03c4d48..3c814a2 100644
1617 --- a/perl.c
1618 +++ b/perl.c
1619 @@ -252,6 +252,7 @@ setuid perl scripts securely.\n");
1620  #ifndef VMS  /* VMS doesn't have environ array */
1621      origenviron = environ;
1622  #endif
1623 +    e_tmpname = Nullch;
1624  
1625      if (do_undump) {
1626  
1627 @@ -405,6 +406,7 @@ setuid perl scripts securely.\n");
1628      if (e_fp) {
1629         if (Fflush(e_fp) || ferror(e_fp) || fclose(e_fp))
1630             croak("Can't write to temp file for -e: %s", Strerror(errno));
1631 +       e_fp = Nullfp;
1632         argc++,argv--;
1633         scriptname = e_tmpname;
1634      }
1635 @@ -470,10 +472,10 @@ setuid perl scripts securely.\n");
1636      curcop->cop_line = 0;
1637      curstash = defstash;
1638      preprocess = FALSE;
1639 -    if (e_fp) {
1640 -       fclose(e_fp);
1641 -       e_fp = Nullfp;
1642 +    if (e_tmpname) {
1643         (void)UNLINK(e_tmpname);
1644 +       Safefree(e_tmpname);
1645 +       e_tmpname = Nullch;
1646      }
1647  
1648      /* now that script is parsed, we can modify record separator */
1649 @@ -1369,7 +1371,7 @@ SV *sv;
1650         scriptname = xfound;
1651      }
1652  
1653 -    origfilename = savepv(e_fp ? "-e" : scriptname);
1654 +    origfilename = savepv(e_tmpname ? "-e" : scriptname);
1655      curcop->cop_filegv = gv_fetchfile(origfilename);
1656      if (strEQ(origfilename,"-"))
1657         scriptname = "";
1658
1659 EOPATCH
1660     }
1661
1662     if ($major < 3 && $^O eq 'openbsd'
1663         && !extract_from_file('pp_sys.c', qr/BSD_GETPGRP/)) {
1664         # Part of commit c3293030fd1b7489
1665         apply_patch(<<'EOPATCH');
1666 diff --git a/pp_sys.c b/pp_sys.c
1667 index 4608a2a..f0c9d1d 100644
1668 --- a/pp_sys.c
1669 +++ b/pp_sys.c
1670 @@ -2903,8 +2903,8 @@ PP(pp_getpgrp)
1671         pid = 0;
1672      else
1673         pid = SvIVx(POPs);
1674 -#ifdef USE_BSDPGRP
1675 -    value = (I32)getpgrp(pid);
1676 +#ifdef BSD_GETPGRP
1677 +    value = (I32)BSD_GETPGRP(pid);
1678  #else
1679      if (pid != 0)
1680         DIE("POSIX getpgrp can't take an argument");
1681 @@ -2933,8 +2933,8 @@ PP(pp_setpgrp)
1682      }
1683  
1684      TAINT_PROPER("setpgrp");
1685 -#ifdef USE_BSDPGRP
1686 -    SETi( setpgrp(pid, pgrp) >= 0 );
1687 +#ifdef BSD_SETPGRP
1688 +    SETi( BSD_SETPGRP(pid, pgrp) >= 0 );
1689  #else
1690      if ((pgrp != 0) || (pid != 0)) {
1691         DIE("POSIX setpgrp can't take an argument");
1692 EOPATCH
1693     }
1694
1695     if ($major < 4 && $^O eq 'openbsd') {
1696         my $bad;
1697         # Need changes from commit a6e633defa583ad5.
1698         # Commits c07a80fdfe3926b5 and f82b3d4130164d5f changed the same part
1699         # of perl.h
1700
1701         if (extract_from_file('perl.h',
1702                               qr/^#ifdef HAS_GETPGRP2$/)) {
1703             $bad = <<'EOBAD';
1704 ***************
1705 *** 57,71 ****
1706   #define TAINT_PROPER(s)       if (tainting) taint_proper(no_security, s)
1707   #define TAINT_ENV()   if (tainting) taint_env()
1708   
1709 ! #ifdef HAS_GETPGRP2
1710 ! #   ifndef HAS_GETPGRP
1711 ! #     define HAS_GETPGRP
1712 ! #   endif
1713 ! #endif
1714
1715 ! #ifdef HAS_SETPGRP2
1716 ! #   ifndef HAS_SETPGRP
1717 ! #     define HAS_SETPGRP
1718 ! #   endif
1719   #endif
1720   
1721 EOBAD
1722         } elsif (extract_from_file('perl.h',
1723                                    qr/Gack, you have one but not both of getpgrp2/)) {
1724             $bad = <<'EOBAD';
1725 ***************
1726 *** 56,76 ****
1727   #define TAINT_PROPER(s)       if (tainting) taint_proper(no_security, s)
1728   #define TAINT_ENV()   if (tainting) taint_env()
1729   
1730 ! #if defined(HAS_GETPGRP2) && defined(HAS_SETPGRP2)
1731 ! #   define getpgrp getpgrp2
1732 ! #   define setpgrp setpgrp2
1733 ! #   ifndef HAS_GETPGRP
1734 ! #     define HAS_GETPGRP
1735 ! #   endif
1736 ! #   ifndef HAS_SETPGRP
1737 ! #     define HAS_SETPGRP
1738 ! #   endif
1739 ! #   ifndef USE_BSDPGRP
1740 ! #     define USE_BSDPGRP
1741 ! #   endif
1742 ! #else
1743 ! #   if defined(HAS_GETPGRP2) || defined(HAS_SETPGRP2)
1744 !       #include "Gack, you have one but not both of getpgrp2() and setpgrp2()."
1745 ! #   endif
1746   #endif
1747   
1748 EOBAD
1749         } elsif (extract_from_file('perl.h',
1750                                    qr/^#ifdef USE_BSDPGRP$/)) {
1751             $bad = <<'EOBAD'
1752 ***************
1753 *** 91,116 ****
1754   #define TAINT_PROPER(s)       if (tainting) taint_proper(no_security, s)
1755   #define TAINT_ENV()   if (tainting) taint_env()
1756   
1757 ! #ifdef USE_BSDPGRP
1758 ! #   ifdef HAS_GETPGRP
1759 ! #       define BSD_GETPGRP(pid) getpgrp((pid))
1760 ! #   endif
1761 ! #   ifdef HAS_SETPGRP
1762 ! #       define BSD_SETPGRP(pid, pgrp) setpgrp((pid), (pgrp))
1763 ! #   endif
1764 ! #else
1765 ! #   ifdef HAS_GETPGRP2
1766 ! #       define BSD_GETPGRP(pid) getpgrp2((pid))
1767 ! #       ifndef HAS_GETPGRP
1768 ! #         define HAS_GETPGRP
1769 ! #     endif
1770 ! #   endif
1771 ! #   ifdef HAS_SETPGRP2
1772 ! #       define BSD_SETPGRP(pid, pgrp) setpgrp2((pid), (pgrp))
1773 ! #       ifndef HAS_SETPGRP
1774 ! #         define HAS_SETPGRP
1775 ! #     endif
1776 ! #   endif
1777   #endif
1778   
1779   #ifndef _TYPES_               /* If types.h defines this it's easy. */
1780 EOBAD
1781         }
1782         if ($bad) {
1783             apply_patch(<<"EOPATCH");
1784 *** a/perl.h    2011-10-21 09:46:12.000000000 +0200
1785 --- b/perl.h    2011-10-21 09:46:12.000000000 +0200
1786 $bad--- 91,144 ----
1787   #define TAINT_PROPER(s)       if (tainting) taint_proper(no_security, s)
1788   #define TAINT_ENV()   if (tainting) taint_env()
1789   
1790 ! /* XXX All process group stuff is handled in pp_sys.c.  Should these 
1791 !    defines move there?  If so, I could simplify this a lot. --AD  9/96.
1792 ! */
1793 ! /* Process group stuff changed from traditional BSD to POSIX.
1794 !    perlfunc.pod documents the traditional BSD-style syntax, so we'll
1795 !    try to preserve that, if possible.
1796 ! */
1797 ! #ifdef HAS_SETPGID
1798 ! #  define BSD_SETPGRP(pid, pgrp)      setpgid((pid), (pgrp))
1799 ! #else
1800 ! #  if defined(HAS_SETPGRP) && defined(USE_BSD_SETPGRP)
1801 ! #    define BSD_SETPGRP(pid, pgrp)    setpgrp((pid), (pgrp))
1802 ! #  else
1803 ! #    ifdef HAS_SETPGRP2  /* DG/UX */
1804 ! #      define BSD_SETPGRP(pid, pgrp)  setpgrp2((pid), (pgrp))
1805 ! #    endif
1806 ! #  endif
1807 ! #endif
1808 ! #if defined(BSD_SETPGRP) && !defined(HAS_SETPGRP)
1809 ! #  define HAS_SETPGRP  /* Well, effectively it does . . . */
1810 ! #endif
1811
1812 ! /* getpgid isn't POSIX, but at least Solaris and Linux have it, and it makes
1813 !     our life easier :-) so we'll try it.
1814 ! */
1815 ! #ifdef HAS_GETPGID
1816 ! #  define BSD_GETPGRP(pid)            getpgid((pid))
1817 ! #else
1818 ! #  if defined(HAS_GETPGRP) && defined(USE_BSD_GETPGRP)
1819 ! #    define BSD_GETPGRP(pid)          getpgrp((pid))
1820 ! #  else
1821 ! #    ifdef HAS_GETPGRP2  /* DG/UX */
1822 ! #      define BSD_GETPGRP(pid)                getpgrp2((pid))
1823 ! #    endif
1824 ! #  endif
1825 ! #endif
1826 ! #if defined(BSD_GETPGRP) && !defined(HAS_GETPGRP)
1827 ! #  define HAS_GETPGRP  /* Well, effectively it does . . . */
1828 ! #endif
1829
1830 ! /* These are not exact synonyms, since setpgrp() and getpgrp() may 
1831 !    have different behaviors, but perl.h used to define USE_BSDPGRP
1832 !    (prior to 5.003_05) so some extension might depend on it.
1833 ! */
1834 ! #if defined(USE_BSD_SETPGRP) || defined(USE_BSD_GETPGRP)
1835 ! #  ifndef USE_BSDPGRP
1836 ! #    define USE_BSDPGRP
1837 ! #  endif
1838   #endif
1839   
1840   #ifndef _TYPES_               /* If types.h defines this it's easy. */
1841 EOPATCH
1842         }
1843     }
1844
1845     if ($major == 4 && extract_from_file('scope.c', qr/\(SV\*\)SSPOPINT/)) {
1846         # [PATCH] 5.004_04 +MAINT_TRIAL_1 broken when sizeof(int) != sizeof(void)
1847         # Fixes a bug introduced in 161b7d1635bc830b
1848         apply_commit('9002cb76ec83ef7f');
1849     }
1850
1851     if ($major == 4 && extract_from_file('av.c', qr/AvARRAY\(av\) = 0;/)) {
1852         # Fixes a bug introduced in 1393e20655efb4bc
1853         apply_commit('e1c148c28bf3335b', 'av.c');
1854     }
1855
1856     if ($major == 4 && !extract_from_file('perl.c', qr/delimcpy.*,$/)) {
1857         # bug introduced in 2a92aaa05aa1acbf, fixed in 8490252049bf42d3
1858         apply_patch(<<'EOPATCH');
1859 diff --git a/perl.c b/perl.c
1860 index 4eb69e3..54bbb00 100644
1861 --- a/perl.c
1862 +++ b/perl.c
1863 @@ -1735,7 +1735,7 @@ SV *sv;
1864             if (len < sizeof tokenbuf)
1865                 tokenbuf[len] = '\0';
1866  #else  /* ! (atarist || DOSISH) */
1867 -           s = delimcpy(tokenbuf, tokenbuf + sizeof tokenbuf, s, bufend
1868 +           s = delimcpy(tokenbuf, tokenbuf + sizeof tokenbuf, s, bufend,
1869                          ':',
1870                          &len);
1871  #endif /* ! (atarist || DOSISH) */
1872 EOPATCH
1873     }
1874
1875     if ($major == 4 && $^O eq 'linux') {
1876         # Whilst this is fixed properly in f0784f6a4c3e45e1 which provides the
1877         # Configure probe, it's easier to back out the problematic changes made
1878         # in these previous commits:
1879         if (extract_from_file('doio.c',
1880                               qr!^/\* XXX REALLY need metaconfig test \*/$!)) {
1881             revert_commit('4682965a1447ea44', 'doio.c');
1882         }
1883         if (my $token = extract_from_file('doio.c',
1884                                           qr!^#if (defined\(__sun(?:__)?\)) && defined\(__svr4__\) /\* XXX Need metaconfig test \*/$!)) {
1885             my $patch = `git show -R 9b599b2a63d2324d doio.c`;
1886             $patch =~ s/defined\(__sun__\)/$token/g;
1887             apply_patch($patch);
1888         }
1889         if (extract_from_file('doio.c',
1890                               qr!^/\* linux \(and Solaris2\?\) uses :$!)) {
1891             revert_commit('8490252049bf42d3', 'doio.c');
1892         }
1893         if (extract_from_file('doio.c',
1894                               qr/^          unsemds.buf = &semds;$/)) {
1895             revert_commit('8e591e46b4c6543e');
1896         }
1897         if (extract_from_file('doio.c',
1898                               qr!^#ifdef __linux__      /\* XXX Need metaconfig test \*/$!)) {
1899             # Reverts part of commit 3e3baf6d63945cb6
1900             apply_patch(<<'EOPATCH');
1901 diff --git b/doio.c a/doio.c
1902 index 62b7de9..0d57425 100644
1903 --- b/doio.c
1904 +++ a/doio.c
1905 @@ -1333,9 +1331,6 @@ SV **sp;
1906      char *a;
1907      I32 id, n, cmd, infosize, getinfo;
1908      I32 ret = -1;
1909 -#ifdef __linux__       /* XXX Need metaconfig test */
1910 -    union semun unsemds;
1911 -#endif
1912  
1913      id = SvIVx(*++mark);
1914      n = (optype == OP_SEMCTL) ? SvIVx(*++mark) : 0;
1915 @@ -1364,29 +1359,11 @@ SV **sp;
1916             infosize = sizeof(struct semid_ds);
1917         else if (cmd == GETALL || cmd == SETALL)
1918         {
1919 -#ifdef __linux__       /* XXX Need metaconfig test */
1920 -/* linux uses :
1921 -   int semctl (int semid, int semnun, int cmd, union semun arg)
1922 -
1923 -       union semun {
1924 -            int val;
1925 -            struct semid_ds *buf;
1926 -            ushort *array;
1927 -       };
1928 -*/
1929 -            union semun semds;
1930 -           if (semctl(id, 0, IPC_STAT, semds) == -1)
1931 -#else
1932             struct semid_ds semds;
1933             if (semctl(id, 0, IPC_STAT, &semds) == -1)
1934 -#endif
1935                 return -1;
1936             getinfo = (cmd == GETALL);
1937 -#ifdef __linux__       /* XXX Need metaconfig test */
1938 -           infosize = semds.buf->sem_nsems * sizeof(short);
1939 -#else
1940             infosize = semds.sem_nsems * sizeof(short);
1941 -#endif
1942                 /* "short" is technically wrong but much more portable
1943                    than guessing about u_?short(_t)? */
1944         }
1945 @@ -1429,12 +1406,7 @@ SV **sp;
1946  #endif
1947  #ifdef HAS_SEM
1948      case OP_SEMCTL:
1949 -#ifdef __linux__       /* XXX Need metaconfig test */
1950 -        unsemds.buf = (struct semid_ds *)a;
1951 -       ret = semctl(id, n, cmd, unsemds);
1952 -#else
1953         ret = semctl(id, n, cmd, (struct semid_ds *)a);
1954 -#endif
1955         break;
1956  #endif
1957  #ifdef HAS_SHM
1958 EOPATCH
1959         }
1960         # Incorrect prototype added as part of 8ac853655d9b7447, fixed as part
1961         # of commit dc45a647708b6c54, with at least one intermediate
1962         # modification. Correct prototype for gethostbyaddr has socklen_t
1963         # second. Linux has uint32_t first for getnetbyaddr.
1964         # Easiest just to remove, instead of attempting more complex patching.
1965         # Something similar may be needed on other platforms.
1966         edit_file('pp_sys.c', sub {
1967                       my $code = shift;
1968                       $code =~ s/^    struct hostent \*(?:PerlSock_)?gethostbyaddr\([^)]+\);$//m;
1969                       $code =~ s/^    struct netent \*getnetbyaddr\([^)]+\);$//m;
1970                       return $code;
1971                   });
1972     }
1973
1974     if ($major < 6 && $^O eq 'netbsd'
1975         && !extract_from_file('unixish.h',
1976                               qr/defined\(NSIG\).*defined\(__NetBSD__\)/)) {
1977         apply_patch(<<'EOPATCH')
1978 diff --git a/unixish.h b/unixish.h
1979 index 2a6cbcd..eab2de1 100644
1980 --- a/unixish.h
1981 +++ b/unixish.h
1982 @@ -89,7 +89,7 @@
1983   */
1984  /* #define ALTERNATE_SHEBANG "#!" / **/
1985  
1986 -#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
1987 +#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) || defined(__NetBSD__)
1988  # include <signal.h>
1989  #endif
1990  
1991 EOPATCH
1992     }
1993
1994     if (($major >= 7 || $major <= 9) && $^O eq 'openbsd'
1995         && `uname -m` eq "sparc64\n"
1996         # added in 2000 by commit cb434fcc98ac25f5:
1997         && extract_from_file('regexec.c',
1998                              qr!/\* No need to save/restore up to this paren \*/!)
1999         # re-indented in 2006 by commit 95b2444054382532:
2000         && extract_from_file('regexec.c', qr/^\t\tCURCUR cc;$/)) {
2001         # Need to work around a bug in (at least) OpenBSD's 4.6's sparc64 #
2002         # compiler ["gcc (GCC) 3.3.5 (propolice)"]. Between commits
2003         # 3ec562b0bffb8b8b (2002) and 1a4fad37125bac3e^ (2005) the darling thing
2004         # fails to compile any code for the statement cc.oldcc = PL_regcc;
2005         #
2006         # If you refactor the code to "fix" that, or force the issue using set
2007         # in the debugger, the stack smashing detection code fires on return
2008         # from S_regmatch(). Turns out that the compiler doesn't allocate any
2009         # (or at least enough) space for cc.
2010         #
2011         # Restore the "uninitialised" value for cc before function exit, and the
2012         # stack smashing code is placated.  "Fix" 3ec562b0bffb8b8b (which
2013         # changes the size of auto variables used elsewhere in S_regmatch), and
2014         # the crash is visible back to bc517b45fdfb539b (which also changes
2015         # buffer sizes). "Unfix" 1a4fad37125bac3e and the crash is visible until
2016         # 5b47454deb66294b.  Problem goes away if you compile with -O, or hack
2017         # the code as below.
2018         #
2019         # Hence this turns out to be a bug in (old) gcc. Not a security bug we
2020         # still need to fix.
2021         apply_patch(<<'EOPATCH');
2022 diff --git a/regexec.c b/regexec.c
2023 index 900b491..6251a0b 100644
2024 --- a/regexec.c
2025 +++ b/regexec.c
2026 @@ -2958,7 +2958,11 @@ S_regmatch(pTHX_ regnode *prog)
2027                                 I,I
2028   *******************************************************************/
2029         case CURLYX: {
2030 -               CURCUR cc;
2031 +           union {
2032 +               CURCUR hack_cc;
2033 +               char hack_buff[sizeof(CURCUR) + 1];
2034 +           } hack;
2035 +#define cc hack.hack_cc
2036                 CHECKPOINT cp = PL_savestack_ix;
2037                 /* No need to save/restore up to this paren */
2038                 I32 parenfloor = scan->flags;
2039 @@ -2983,6 +2987,7 @@ S_regmatch(pTHX_ regnode *prog)
2040                 n = regmatch(PREVOPER(next));   /* start on the WHILEM */
2041                 regcpblow(cp);
2042                 PL_regcc = cc.oldcc;
2043 +#undef cc
2044                 saySAME(n);
2045             }
2046             /* NOT REACHED */
2047 EOPATCH
2048 }
2049
2050     if ($major < 8 && $^O eq 'openbsd'
2051         && !extract_from_file('perl.h', qr/include <unistd\.h>/)) {
2052         # This is part of commit 3f270f98f9305540, applied at a slightly
2053         # different location in perl.h, where the context is stable back to
2054         # 5.000
2055         apply_patch(<<'EOPATCH');
2056 diff --git a/perl.h b/perl.h
2057 index 9418b52..b8b1a7c 100644
2058 --- a/perl.h
2059 +++ b/perl.h
2060 @@ -496,6 +496,10 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
2061  #   include <sys/param.h>
2062  #endif
2063  
2064 +/* If this causes problems, set i_unistd=undef in the hint file.  */
2065 +#ifdef I_UNISTD
2066 +#   include <unistd.h>
2067 +#endif
2068  
2069  /* Use all the "standard" definitions? */
2070  #if defined(STANDARD_C) && defined(I_STDLIB)
2071 EOPATCH
2072     }
2073 }
2074
2075 sub patch_ext {
2076     if (-f 'ext/POSIX/Makefile.PL'
2077         && extract_from_file('ext/POSIX/Makefile.PL',
2078                              qr/Explicitly avoid including/)) {
2079         # commit 6695a346c41138df, which effectively reverts 170888cff5e2ffb7
2080
2081         # PERL5LIB is populated by make_ext.pl with paths to the modules we need
2082         # to run, don't override this with "../../lib" since that may not have
2083         # been populated yet in a parallel build.
2084         apply_commit('6695a346c41138df');
2085     }
2086
2087     if ($major < 8 && $^O eq 'darwin' && !-f 'ext/DynaLoader/dl_dyld.xs') {
2088         checkout_file('ext/DynaLoader/dl_dyld.xs', 'f556e5b971932902');
2089         apply_patch(<<'EOPATCH');
2090 diff -u a/ext/DynaLoader/dl_dyld.xs~ a/ext/DynaLoader/dl_dyld.xs
2091 --- a/ext/DynaLoader/dl_dyld.xs~        2011-10-11 21:41:27.000000000 +0100
2092 +++ b/ext/DynaLoader/dl_dyld.xs 2011-10-11 21:42:20.000000000 +0100
2093 @@ -41,6 +41,35 @@
2094  #include "perl.h"
2095  #include "XSUB.h"
2096  
2097 +#ifndef pTHX
2098 +#  define pTHX         void
2099 +#  define pTHX_
2100 +#endif
2101 +#ifndef aTHX
2102 +#  define aTHX
2103 +#  define aTHX_
2104 +#endif
2105 +#ifndef dTHX
2106 +#  define dTHXa(a)     extern int Perl___notused(void)
2107 +#  define dTHX         extern int Perl___notused(void)
2108 +#endif
2109 +
2110 +#ifndef Perl_form_nocontext
2111 +#  define Perl_form_nocontext form
2112 +#endif
2113 +
2114 +#ifndef Perl_warn_nocontext
2115 +#  define Perl_warn_nocontext warn
2116 +#endif
2117 +
2118 +#ifndef PTR2IV
2119 +#  define PTR2IV(p)    (IV)(p)
2120 +#endif
2121 +
2122 +#ifndef get_av
2123 +#  define get_av perl_get_av
2124 +#endif
2125 +
2126  #define DL_LOADONCEONLY
2127  
2128  #include "dlutils.c"   /* SaveError() etc      */
2129 @@ -185,7 +191,7 @@
2130      CODE:
2131      DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
2132      if (flags & 0x01)
2133 -       Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
2134 +       Perl_warn_nocontext("Can't make loaded symbols global on this platform while loading %s",filename);
2135      RETVAL = dlopen(filename, mode) ;
2136      DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", RETVAL));
2137      ST(0) = sv_newmortal() ;
2138 EOPATCH
2139         if ($major < 4 && !extract_from_file('util.c', qr/^form/m)) {
2140             apply_patch(<<'EOPATCH');
2141 diff -u a/ext/DynaLoader/dl_dyld.xs~ a/ext/DynaLoader/dl_dyld.xs
2142 --- a/ext/DynaLoader/dl_dyld.xs~        2011-10-11 21:56:25.000000000 +0100
2143 +++ b/ext/DynaLoader/dl_dyld.xs 2011-10-11 22:00:00.000000000 +0100
2144 @@ -60,6 +60,18 @@
2145  #  define get_av perl_get_av
2146  #endif
2147  
2148 +static char *
2149 +form(char *pat, ...)
2150 +{
2151 +    char *retval;
2152 +    va_list args;
2153 +    va_start(args, pat);
2154 +    vasprintf(&retval, pat, &args);
2155 +    va_end(args);
2156 +    SAVEFREEPV(retval);
2157 +    return retval;
2158 +}
2159 +
2160  #define DL_LOADONCEONLY
2161  
2162  #include "dlutils.c"   /* SaveError() etc      */
2163 EOPATCH
2164         }
2165     }
2166
2167     if ($major < 10) {
2168         if (!extract_from_file('ext/DB_File/DB_File.xs',
2169                                qr!^#else /\* Berkeley DB Version > 2 \*/$!)) {
2170             # This DB_File.xs is really too old to patch up.
2171             # Skip DB_File, unless we're invoked with an explicit -Unoextensions
2172             if (!exists $defines{noextensions}) {
2173                 $defines{noextensions} = 'DB_File';
2174             } elsif (defined $defines{noextensions}) {
2175                 $defines{noextensions} .= ' DB_File';
2176             }
2177         } elsif (!extract_from_file('ext/DB_File/DB_File.xs',
2178                                     qr/^#ifdef AT_LEAST_DB_4_1$/)) {
2179             # This line is changed by commit 3245f0580c13b3ab
2180             my $line = extract_from_file('ext/DB_File/DB_File.xs',
2181                                          qr/^(        status = \(?RETVAL->dbp->open\)?\(RETVAL->dbp, name, NULL, RETVAL->type, $)/);
2182             apply_patch(<<"EOPATCH");
2183 diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs
2184 index 489ba96..fba8ded 100644
2185 --- a/ext/DB_File/DB_File.xs
2186 +++ b/ext/DB_File/DB_File.xs
2187 \@\@ -183,4 +187,8 \@\@
2188  #endif
2189  
2190 +#if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 1)
2191 +#    define AT_LEAST_DB_4_1
2192 +#endif
2193 +
2194  /* map version 2 features & constants onto their version 1 equivalent */
2195  
2196 \@\@ -1334,7 +1419,12 \@\@ SV *   sv ;
2197  #endif
2198  
2199 +#ifdef AT_LEAST_DB_4_1
2200 +        status = (RETVAL->dbp->open)(RETVAL->dbp, NULL, name, NULL, RETVAL->type, 
2201 +                               Flags, mode) ; 
2202 +#else
2203  $line
2204                                 Flags, mode) ; 
2205 +#endif
2206         /* printf("open returned %d %s\\n", status, db_strerror(status)) ; */
2207  
2208 EOPATCH
2209         }
2210     }
2211
2212     if ($major < 10 and -f 'ext/IPC/SysV/SysV.xs') {
2213         edit_file('ext/IPC/SysV/SysV.xs', sub {
2214                       my $xs = shift;
2215                       my $fixed = <<'EOFIX';
2216
2217 #include <sys/types.h>
2218 #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
2219 #ifndef HAS_SEM
2220 #   include <sys/ipc.h>
2221 #endif
2222 #   ifdef HAS_MSG
2223 #       include <sys/msg.h>
2224 #   endif
2225 #   ifdef HAS_SHM
2226 #       if defined(PERL_SCO) || defined(PERL_ISC)
2227 #           include <sys/sysmacros.h>   /* SHMLBA */
2228 #       endif
2229 #      include <sys/shm.h>
2230 #      ifndef HAS_SHMAT_PROTOTYPE
2231            extern Shmat_t shmat (int, char *, int);
2232 #      endif
2233 #      if defined(HAS_SYSCONF) && defined(_SC_PAGESIZE)
2234 #          undef  SHMLBA /* not static: determined at boot time */
2235 #          define SHMLBA sysconf(_SC_PAGESIZE)
2236 #      elif defined(HAS_GETPAGESIZE)
2237 #          undef  SHMLBA /* not static: determined at boot time */
2238 #          define SHMLBA getpagesize()
2239 #      endif
2240 #   endif
2241 #endif
2242 EOFIX
2243                       $xs =~ s!
2244 #include <sys/types\.h>
2245 .*
2246 (#ifdef newCONSTSUB|/\* Required)!$fixed$1!ms;
2247                       return $xs;
2248                   });
2249     }
2250 }
2251
2252 # Local variables:
2253 # cperl-indent-level: 4
2254 # indent-tabs-mode: nil
2255 # End:
2256 #
2257 # ex: set ts=8 sts=4 sw=4 et: