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