#!/usr/bin/perl -w
my
@targets
=
qw(none config.sh config.h miniperl lib/Config.pm Fcntl perl test_prep)
;
my
%options
=
(
'expect-pass'
=> 1,
clean
=> 1,
);
my
$run_with_our_perl
=
qr{\A#!(\./(?:mini)?perl)\b}
;
my
$linux64
= `uname -sm` eq
"Linux x86_64\n"
?
'64'
:
''
;
my
@paths
;
if
($^O eq
'linux'
) {
my
$gcc
= -x
'/usr/bin/gcc'
?
'/usr/bin/gcc'
:
'gcc'
;
foreach
(`
$gcc
-
print
-search-dirs`) {
next
unless
/^libraries: =(.*)/;
foreach
(
split
':'
, $1) {
next
if
m/gcc/;
next
unless
-d
$_
;
s!/$!!;
push
@paths
,
$_
;
}
}
push
@paths
,
map
{
$_
.
$linux64
}
qw(/usr/local/lib /lib /usr/lib)
if
$linux64
;
}
my
%defines
=
(
usedevel
=>
''
,
optimize
=>
'-g'
,
ld
=>
'cc'
,
(
@paths
? (
libpth
=> \
@paths
) : ()),
);
push
@paths
,
qw(/usr/local/lib /lib /usr/lib)
unless
$linux64
;
unless
(GetOptions(\
%options
,
'target=s'
,
'make=s'
,
'jobs|j=i'
,
'crash'
,
'expect-pass=i'
,
'expect-fail'
=>
sub
{
$options
{
'expect-pass'
} = 0; },
'clean!'
,
'one-liner|e=s@'
,
'c'
,
'l'
,
'w'
,
'match=s'
,
'no-match=s'
=>
sub
{
$options
{match} =
$_
[1];
$options
{
'expect-pass'
} = 0;
},
'force-manifest'
,
'force-regen'
,
'setpgrp!'
,
'timeout=i'
,
'test-build'
,
'validate'
,
'all-fixups'
,
'early-fixup=s@'
,
'late-fixup=s@'
,
'valgrind'
,
'check-args'
,
'check-shebang!'
,
'usage|help|?'
,
'gold=s'
,
'module=s'
,
'with-module=s'
,
'cpan-config-dir=s'
,
'test-module=s'
,
'no-module-tests'
,
'A=s@'
,
'D=s@'
=>
sub
{
my
(
undef
,
$val
) =
@_
;
if
(
$val
=~ /\A([^=]+)=(.*)/s) {
$defines
{$1} =
length
$2 ? $2 :
"\0"
;
}
else
{
$defines
{
$val
} =
''
;
}
},
'U=s@'
=>
sub
{
$defines
{
$_
[1]} =
undef
;
},
)) {
pod2usage(
exitval
=> 255,
verbose
=> 1);
}
my
(
$target
,
$match
) =
@options
{
qw(target match)
};
@ARGV
= (
'sh'
,
'-c'
,
'cd t && ./perl TEST base/*.t'
)
if
$options
{validate} && !
@ARGV
;
pod2usage(
exitval
=> 0,
verbose
=> 2)
if
$options
{usage};
if
(
defined
$target
&&
$target
=~ /\.t\z/) {
foreach
(
qw(valgrind match validate test-build one-liner)
) {
die_255(
"$0: Test-case targets can't be run with --$_"
)
if
$options
{
$_
};
}
die_255(
"$0: Test-case targets can't be combined with an explicit test"
)
if
@ARGV
;
unless
(
$options
{
'check-args'
}) {
skip(
"Test case $target is not a readable file"
)
unless
-f
$target
&& -r _;
}
unless
(
$target
=~ s!\At/!!) {
$target
=
"../$target"
;
}
@ARGV
= (
'sh'
,
'-c'
,
"cd t && ./perl TEST "
.
quotemeta
$target
);
$target
=
'test_prep'
;
}
pod2usage(
exitval
=> 255,
verbose
=> 1)
unless
@ARGV
||
$match
||
$options
{
'test-build'
}
||
defined
$options
{
'one-liner'
} ||
defined
$options
{module}
||
defined
$options
{
'test-module'
};
pod2usage(
exitval
=> 255,
verbose
=> 1)
if
!
$options
{
'one-liner'
} && (
$options
{l} ||
$options
{w});
if
(
$options
{
'no-module-tests'
} &&
$options
{module}) {
print
STDERR
"--module and --no-module-tests are exclusive.\n\n"
;
pod2usage(
exitval
=> 255,
verbose
=> 1)
}
if
(
$options
{
'no-module-tests'
} &&
$options
{
'test-module'
}) {
print
STDERR
"--test-module and --no-module-tests are exclusive.\n\n"
;
pod2usage(
exitval
=> 255,
verbose
=> 1)
}
if
(
$options
{module} &&
$options
{
'test-module'
}) {
print
STDERR
"--module and --test-module are exclusive.\n\n"
;
pod2usage(
exitval
=> 255,
verbose
=> 1)
}
check_shebang(
$ARGV
[0])
if
$options
{
'check-shebang'
} &&
@ARGV
&& !
$options
{match};
exit
0
if
$options
{
'check-args'
};
sub
croak_255 {
my
$message
=
join
''
,
@_
;
if
(
$message
=~ /\n\z/) {
print
STDERR
$message
;
}
else
{
my
(
undef
,
$file
,
$line
) =
caller
1;
print
STDERR
"@_ at $file line $line\n"
;
}
exit
255;
}
sub
die_255 {
croak_255(
@_
);
}
die_255(
"$0: Can't build $target"
)
if
defined
$target
&& !
grep
{
@targets
}
$target
;
foreach
my
$phase
(
qw(early late)
) {
next
unless
$options
{
"$phase-fixup"
};
my
$bail_out
;
my
@expanded
;
foreach
my
$glob
(@{
$options
{
"$phase-fixup"
}}) {
my
@got
= File::Glob::bsd_glob(
$glob
);
push
@expanded
,
@got
?
@got
:
$glob
;
}
@expanded
=
sort
@expanded
;
$options
{
"$phase-fixup"
} = \
@expanded
;
foreach
(
@expanded
) {
unless
(-f
$_
) {
print
STDERR
"$phase-fixup '$_' is not a readable file\n"
;
++
$bail_out
;
}
}
exit
255
if
$bail_out
;
}
unless
(
exists
$defines
{cc}) {
$defines
{cc} = (`ccache -V`, $?) ?
'cc'
:
'ccache cc'
;
}
my
$j
=
$options
{jobs} ?
"-j$options{jobs}"
:
''
;
if
(
exists
$options
{make}) {
if
(!
exists
$defines
{make}) {
$defines
{make} =
$options
{make};
}
}
else
{
$options
{make} =
'make'
;
}
sub
open_or_die {
my
$file
=
shift
;
my
$mode
=
@_
?
shift
:
'<'
;
open
my
$fh
,
$mode
,
$file
or croak_255(
"Can't open $file: $!"
);
${
*$fh
{SCALAR}} =
$file
;
return
$fh
;
}
sub
close_or_die {
my
$fh
=
shift
;
return
if
close
$fh
;
croak_255(
"Can't close: $!"
)
unless
ref
$fh
eq 'GLOB';
croak_255(
"Can't close ${*$fh{SCALAR}}: $!"
);
}
sub
system_or_die {
my
$command
=
'</dev/null '
.
shift
;
system
(
$command
) and croak_255(
"'$command' failed, \$!=$!, \$?=$?"
);
}
sub
run_with_options {
my
$options
=
shift
;
my
$name
=
$options
->{name};
$name
=
"@_"
unless
defined
$name
;
my
$setgrp
=
$options
->{
setpgrp
};
if
(
$options
->{timeout}) {
$setgrp
= 1
unless
defined
$setgrp
;
}
my
$pid
=
fork
;
die_255(
"Can't fork: $!"
)
unless
defined
$pid
;
if
(!
$pid
) {
if
(
exists
$options
->{stdin}) {
open
STDIN,
'<'
,
$options
->{stdin}
or
die
"Can't open STDIN from $options->{stdin}: $!"
;
}
if
(
$setgrp
) {
setpgrp
0, 0
or
die
"Can't setpgrp 0, 0: $!"
;
}
{
exec
@_
};
die_255(
"Failed to start $name: $!"
);
}
my
$start
;
if
(
$options
->{timeout}) {
die_255(
"No POSIX::WNOHANG"
)
unless
&POSIX::WNOHANG
;
$start
=
time
;
$SIG
{ALRM} =
sub
{
my
$victim
=
$setgrp
? -
$pid
:
$pid
;
my
$delay
= 1;
kill
'TERM'
,
$victim
;
waitpid
(-1,
&POSIX::WNOHANG
);
while
(
kill
0,
$victim
) {
sleep
$delay
;
waitpid
(-1,
&POSIX::WNOHANG
);
$delay
*= 2;
if
(
$delay
> 8) {
if
(
kill
'KILL'
,
$victim
) {
print
STDERR
"$0: Had to kill 'KILL', $victim\n"
}
elsif
(! $!{ESRCH}) {
print
STDERR
"$0: kill 'KILL', $victim failed: $!\n"
;
}
last
;
}
}
report_and_exit(0,
'No timeout'
,
'Timeout'
,
"when running $name"
);
};
alarm
$options
->{timeout};
}
waitpid
$pid
, 0
or die_255(
"wait for $name, pid $pid failed: $!"
);
alarm
0;
if
(
$options
->{timeout}) {
my
$elapsed
=
time
-
$start
;
if
(
$elapsed
/
$options
->{timeout} > 0.8) {
print
STDERR
"$0: Beware, took $elapsed seconds of $options->{timeout} permitted to run $name\n"
;
}
}
return
$?;
}
sub
extract_from_file {
my
(
$file
,
$rx
,
$default
) =
@_
;
my
$fh
= open_or_die(
$file
);
while
(<
$fh
>) {
my
@got
=
$_
=~
$rx
;
return
wantarray
?
@got
:
$got
[0]
if
@got
;
}
return
$default
if
defined
$default
;
return
;
}
sub
edit_file {
my
(
$file
,
$munger
) =
@_
;
local
$/;
my
$fh
= open_or_die(
$file
);
my
$orig
= <
$fh
>;
die_255(
"Can't read $file: $!"
)
unless
defined
$orig
&&
close
$fh
;
my
$new
=
$munger
->(
$orig
);
return
if
$new
eq
$orig
;
$fh
= open_or_die(
$file
,
'>'
);
print
$fh
$new
or die_255(
"Can't print to $file: $!"
);
close_or_die(
$fh
);
}
sub
process_hunk {
my
(
$from_out
,
$to_out
,
$has_from
,
$has_to
,
$delete
,
$add
) =
@_
;
++
$$has_from
if
$delete
;
++
$$has_to
if
$add
;
if
(
$delete
&&
$add
) {
$$from_out
.=
"! $_\n"
foreach
@$delete
;
$$to_out
.=
"! $_\n"
foreach
@$add
;
}
elsif
(
$delete
) {
$$from_out
.=
"- $_\n"
foreach
@$delete
;
}
elsif
(
$add
) {
$$to_out
.=
"+ $_\n"
foreach
@$add
;
}
}
sub
ud2cd {
my
$diff_in
=
shift
;
my
$diff_out
=
''
;
while
(
$diff_in
=~ s/\A(?!\*\*\* )(?!--- )([^\n]*\n?)//ms &&
length
$1) {
$diff_out
.= $1;
}
if
(!
length
$diff_in
) {
die_255(
"That didn't seem to be a diff"
);
}
if
(
$diff_in
=~ /\A\*\*\* /ms) {
warn
"Seems to be a context diff already\n"
;
return
$diff_out
.
$diff_in
;
}
FILE:
while
(1) {
if
(
$diff_in
=~ s/\A((?:diff |
index
)[^\n]+\n)//ms) {
$diff_out
.= $1;
next
;
}
if
(
$diff_in
!~ /\A--- /ms) {
return
$diff_out
.
$diff_in
;
}
$diff_in
=~ s/\A([^\n]+\n?)//ms;
my
$line
= $1;
die_255(
"Can't parse '$line'"
)
unless
$line
=~ s/\A--- /*** /ms;
$diff_out
.=
$line
;
$diff_in
=~ s/\A([^\n]+\n?)//ms;
$line
= $1;
die_255(
"Can't parse '$line'"
)
unless
$line
=~ s/\A\+\+\+ /--- /ms;
$diff_out
.=
$line
;
while
(1) {
next
FILE
unless
$diff_in
=~ s/\A\@\@ (-([0-9]+),([0-9]+) \+([0-9]+),([0-9]+)) \@\@[^\n]*\n?//;
my
(
$hunk
,
$from_start
,
$from_count
,
$to_start
,
$to_count
)
= ($1, $2, $3, $4, $5);
my
$from_end
=
$from_start
+
$from_count
- 1;
my
$to_end
=
$to_start
+
$to_count
- 1;
my
(
$from_out
,
$to_out
,
$has_from
,
$has_to
,
$add
,
$delete
);
while
(
length
$diff_in
&& (
$from_count
||
$to_count
)) {
die_255(
"Confused in $hunk"
)
unless
$diff_in
=~ s/\A([^\n]*)\n//ms;
my
$line
= $1;
$line
=
' '
unless
length
$line
;
if
(
$line
=~ /^ .*/) {
process_hunk(\
$from_out
, \
$to_out
, \
$has_from
, \
$has_to
,
$delete
,
$add
);
undef
$delete
;
undef
$add
;
$from_out
.=
" $line\n"
;
$to_out
.=
" $line\n"
;
--
$from_count
;
--
$to_count
;
}
elsif
(
$line
=~ /^-(.*)/) {
push
@$delete
, $1;
--
$from_count
;
}
elsif
(
$line
=~ /^\+(.*)/) {
push
@$add
, $1;
--
$to_count
;
}
else
{
die_255(
"Can't parse '$line' as part of hunk $hunk"
);
}
}
process_hunk(\
$from_out
, \
$to_out
, \
$has_from
, \
$has_to
,
$delete
,
$add
);
die_255(
"No lines in hunk $hunk"
)
unless
length
$from_out
||
length
$to_out
;
die_255(
"No changes in hunk $hunk"
)
unless
$has_from
||
$has_to
;
$diff_out
.=
"***************\n"
;
$diff_out
.=
"*** $from_start,$from_end ****\n"
;
$diff_out
.=
$from_out
if
$has_from
;
$diff_out
.=
"--- $to_start,$to_end ----\n"
;
$diff_out
.=
$to_out
if
$has_to
;
}
}
}
{
my
$use_context
;
sub
placate_patch_prog {
my
$patch
=
shift
;
if
(!
defined
$use_context
) {
my
$version
= `patch -v 2>&1`;
die_255(
"Can't run `patch -v`, \$?=$?, bailing out"
)
unless
defined
$version
;
if
(
$version
=~ /Free Software Foundation/) {
$use_context
= 0;
}
elsif
(
$version
=~ /Header: patch\.c,v.*\blwall\b/) {
$use_context
= 1;
}
elsif
(
$version
=~ /Header: patch\.c,v.*\babhinav\b/) {
$use_context
= 1;
}
else
{
$use_context
= 0;
}
}
return
$use_context
? ud2cd(
$patch
) :
$patch
;
}
}
sub
apply_patch {
my
(
$patch
,
$what
,
$files
) =
@_
;
$what
=
'patch'
unless
defined
$what
;
unless
(
defined
$files
) {
$patch
=~ m!^--- [ab]/(\S+)\n\+\+\+ [ba]/\1!sm;
$files
=
" $1"
;
}
my
$patch_to_use
= placate_patch_prog(
$patch
);
open
my
$fh
,
'|-'
,
'patch'
,
'-p1'
or die_255(
"Can't run patch: $!"
);
print
$fh
$patch_to_use
;
return
if
close
$fh
;
print
STDERR
"Patch is <<'EOPATCH'\n${patch}EOPATCH\n"
;
print
STDERR
"\nConverted to a context diff <<'EOCONTEXT'\n${patch_to_use}EOCONTEXT\n"
if
$patch_to_use
ne
$patch
;
die_255(
"Can't $what$files: $?, $!"
);
}
sub
apply_commit {
my
(
$commit
,
@files
) =
@_
;
my
$patch
= `git show
$commit
@files
`;
if
(!
defined
$patch
) {
die_255(
"Can't get commit $commit for @files: $?"
)
if
@files
;
die_255(
"Can't get commit $commit: $?"
);
}
apply_patch(
$patch
,
"patch $commit"
,
@files
?
" for @files"
:
''
);
}
sub
revert_commit {
my
(
$commit
,
@files
) =
@_
;
my
$patch
= `git show -R
$commit
@files
`;
if
(!
defined
$patch
) {
die_255(
"Can't get revert commit $commit for @files: $?"
)
if
@files
;
die_255(
"Can't get revert commit $commit: $?"
);
}
apply_patch(
$patch
,
"revert $commit"
,
@files
?
" for @files"
:
''
);
}
sub
checkout_file {
my
(
$file
,
$commit
) =
@_
;
$commit
||=
$options
{gold} ||
'blead'
;
system
"git show $commit:$file > $file </dev/null"
and die_255(
"Could not extract $file at revision $commit"
);
}
sub
check_shebang {
my
$file
=
shift
;
return
unless
-e
$file
;
my
$fh
= open_or_die(
$file
);
my
$line
= <
$fh
>;
return
if
$line
=~
$run_with_our_perl
;
if
(!-x
$file
) {
die_255("
$file
is not executable.
system
(
$file
, ...) is always going to fail.
Bailing out");
}
return
unless
$line
=~ m{\A
die_255("
$file
will always be run by $1
It won't be tested by the ./perl we build.
If you intended to run it
with
that perl binary, please change your
test case to
$1
@ARGV
If you intended to test it
with
the ./perl we build, please change your
test case to
./perl -Ilib
@ARGV
[You may also need to add --
before
./perl to prevent that -Ilib as being
parsed as an argument to bisect.pl]
Bailing out");
}
sub
clean {
if
(
$options
{clean}) {
system
'git clean -qdxf </dev/null'
;
system
'git reset --hard HEAD </dev/null'
;
}
}
sub
skip {
my
$reason
=
shift
;
clean();
warn
"skipping - $reason"
;
exit
125;
}
sub
report_and_exit {
my
(
$good
,
$pass
,
$fail
,
$desc
) =
@_
;
clean();
my
$got
= (
$options
{
'expect-pass'
} ?
$good
: !
$good
) ?
'good'
:
'bad'
;
if
(
$good
) {
print
"$got - $pass $desc\n"
;
}
else
{
print
"$got - $fail $desc\n"
;
}
exit
(
$got
eq
'bad'
);
}
sub
run_report_and_exit {
my
$ret
= run_with_options({
setprgp
=>
$options
{
setpgrp
},
timeout
=>
$options
{timeout},
},
@_
);
$ret
&= 0xff
if
$options
{crash};
report_and_exit(!
$ret
,
'zero exit from'
,
'non-zero exit from'
,
"@_"
);
}
sub
match_and_exit {
my
(
$target
,
@globs
) =
@_
;
my
$matches
= 0;
my
$re
=
qr/$match/
;
my
@files
;
if
(
@globs
) {
foreach
(
sort
map
{ File::Glob::bsd_glob(
$_
)}
@globs
) {
if
(!-f
$_
|| !-r _) {
warn
"Skipping matching '$_' as it is not a readable file\n"
;
}
else
{
push
@files
,
$_
;
}
}
}
else
{
local
$/ =
"\0"
;
@files
=
defined
$target
? `git ls-files -o -z`: `git ls-files -z`;
chomp
@files
;
}
foreach
my
$file
(
@files
) {
my
$fh
= open_or_die(
$file
);
while
(<
$fh
>) {
if
(
$_
=~
$re
) {
++
$matches
;
if
(/[^[:^cntrl:]\h\v]/) {
print
"Binary file $file matches\n"
;
}
else
{
$_
.=
"\n"
unless
/\n\z/;
print
"$file: $_"
;
}
}
}
close_or_die(
$fh
);
}
report_and_exit(
$matches
,
$matches
== 1 ?
'1 match for'
:
"$matches matches for"
,
'no matches for'
,
$match
);
}
system_or_die(
'git clean -dxf'
);
if
(!
defined
$target
) {
match_and_exit(
undef
,
@ARGV
)
if
$match
;
$target
=
'test_prep'
;
}
elsif
(
$target
eq
'none'
) {
match_and_exit(
undef
,
@ARGV
)
if
$match
;
run_report_and_exit(
@ARGV
);
}
skip(
'no Configure - is this the //depot/perlext/Compiler branch?'
)
unless
-f
'Configure'
;
my
$case_insensitive
;
{
my
(
$dev_C
,
$ino_C
) =
stat
'Configure'
;
die_255(
"Could not stat Configure: $!"
)
unless
defined
$dev_C
;
my
(
$dev_c
,
$ino_c
) =
stat
'configure'
;
++
$case_insensitive
if
defined
$dev_c
&&
$dev_C
==
$dev_c
&&
$ino_C
==
$ino_c
;
}
my
$major
= extract_from_file(
'patchlevel.h'
,
qr/^#define\s+(?:PERL_VERSION|PATCHLEVEL)\s+(\d+)\s/
,
0);
my
$unfixable_db_file
;
if
(
$major
< 10
&& !extract_from_file(
'ext/DB_File/DB_File.xs'
,
qr!^#else /\* Berkeley DB Version > 2 \*/$!
)) {
if
(!
exists
$defines
{noextensions}) {
$defines
{noextensions} =
'DB_File'
;
}
elsif
(
defined
$defines
{noextensions}) {
$defines
{noextensions} .=
' DB_File'
;
}
++
$unfixable_db_file
;
}
patch_Configure();
patch_hints();
if
(
$options
{
'all-fixups'
}) {
patch_SH();
patch_C();
patch_ext();
}
apply_fixups(
$options
{
'early-fixup'
});
foreach
(@{
$options
{A}}) {
push
@paths
, $1
if
/^libpth=(.*)/s;
}
unless
(extract_from_file(
'Configure'
,
'ignore_versioned_solibs'
)) {
my
@libs
;
foreach
my
$lib
(
qw(sfio socket inet nsl nm ndbm gdbm dbm db malloc dl
ld sun m crypt sec util c cposix posix ucb BSD)
) {
foreach
my
$dir
(
@paths
) {
next
unless
-f
"$dir/lib$lib.$Config{dlext}"
|| -f
"$dir/lib$lib$Config{lib_ext}"
;
push
@libs
,
"-l$lib"
;
last
;
}
}
$defines
{libs} = \
@libs
unless
exists
$defines
{libs};
}
$defines
{usenm} =
undef
if
$major
< 2 && !
exists
$defines
{usenm};
my
(
$missing
,
$created_dirs
);
(
$missing
,
$created_dirs
) = force_manifest()
if
$options
{
'force-manifest'
};
my
@ARGS
=
'-dEs'
;
foreach
my
$key
(
sort
keys
%defines
) {
my
$val
=
$defines
{
$key
};
if
(
ref
$val
) {
push
@ARGS
,
"-D$key=@$val"
;
}
elsif
(!
defined
$val
) {
push
@ARGS
,
"-U$key"
;
}
elsif
(!
length
$val
) {
push
@ARGS
,
"-D$key"
;
}
else
{
$val
=
""
if
$val
eq
"\0"
;
push
@ARGS
,
"-D$key=$val"
;
}
}
push
@ARGS
,
map
{
"-A$_"
} @{
$options
{A}};
my
$prefix
;
if
(
$options
{module} ||
$options
{
'with-module'
} ||
$options
{
'test-module'
})
{
$prefix
= tempdir(
CLEANUP
=> 1);
push
@ARGS
,
"-Dprefix=$prefix"
;
push
@ARGS
,
"-Uversiononly"
,
"-Dinstallusrbinperl=n"
;
}
run_with_options({
stdin
=>
'/dev/null'
,
name
=>
'Configure'
},
'./Configure'
,
@ARGS
);
patch_SH()
unless
$options
{
'all-fixups'
};
apply_fixups(
$options
{
'late-fixup'
});
if
(-f
'config.sh'
) {
fake_noextensions()
if
$major
< 10 &&
$defines
{noextensions};
if
(
system
'./Configure -S'
) {
File::Copy::copy(
"UU/optdef.sh"
,
"./optdef.sh"
);
system_or_die(
'./Configure -S'
);
}
}
if
(
$target
=~ /config\.s?h/) {
match_and_exit(
$target
,
@ARGV
)
if
$match
&& -f
$target
;
report_and_exit(-f
$target
,
'could build'
,
'could not build'
,
$target
)
if
$options
{
'test-build'
};
skip(
"could not build $target"
)
unless
-f
$target
;
run_report_and_exit(
@ARGV
);
}
elsif
(!-f
'config.sh'
) {
skip(
'could not build config.sh'
);
}
force_manifest_cleanup(
$missing
,
$created_dirs
)
if
$missing
;
if
(
$options
{
'force-regen'
}
&& extract_from_file(
'Makefile'
,
qr/\bregen_headers\b/
)) {
system_or_die(
'make regen_headers'
);
}
unless
(
$options
{
'all-fixups'
}) {
patch_C();
patch_ext();
}
system
"$options{make} $j miniperl </dev/null"
;
my
$expected_file
=
$target
=~ /^test/ ?
't/perl'
:
$target
eq
'Fcntl'
?
"lib/auto/Fcntl/Fcntl.$Config{so}"
:
$target
;
my
$real_target
=
$target
eq
'Fcntl'
?
$expected_file
:
$target
;
if
(
$target
ne
'miniperl'
) {
$j
=
''
if
$major
< 10;
if
(
$real_target
eq
'test_prep'
) {
if
(
$major
< 8) {
$real_target
= extract_from_file(
'Makefile.SH'
,
qr/^(test[-_]prep):/
,
'test'
);
}
}
system
"$options{make} $j $real_target </dev/null"
;
}
my
$expected_file_found
=
$expected_file
=~ /perl$/
? -x
$expected_file
: -r
$expected_file
;
if
(
$expected_file_found
&&
$expected_file
eq
't/perl'
) {
my
(
$dev0
,
$ino0
) =
stat
't/perl'
;
my
(
$dev1
,
$ino1
) =
stat
'perl'
;
unless
(
defined
$dev0
&&
defined
$dev1
&&
$dev0
==
$dev1
&&
$ino0
==
$ino1
) {
undef
$expected_file_found
;
my
$link
=
readlink
$expected_file
;
warn
"'t/perl' => '$link', not 'perl'"
;
die_255(
"Could not realink t/perl: $!"
)
unless
defined
$link
;
}
}
my
$just_testing
= 0;
if
(
$options
{
'test-build'
}) {
report_and_exit(
$expected_file_found
,
'could build'
,
'could not build'
,
$real_target
);
}
elsif
(!
$expected_file_found
) {
skip(
"could not build $real_target"
);
}
elsif
(
my
$mod_opt
=
$options
{module} ||
$options
{
'with-module'
}
|| (
$just_testing
++,
$options
{
'test-module'
})) {
system_or_die(
'./installperl'
);
my
@m
=
split
(
','
,
$mod_opt
);
my
$bdir
= File::Temp::tempdir(
CLEANUP
=> 1,
) or
die
$!;
$ENV
{AUTOMATED_TESTING} = 1;
$ENV
{PERL_MM_USE_DEFAULT} = 1;
delete
$ENV
{PERL_MB_OPT};
delete
$ENV
{PERL_MM_OPT};
my
$cdir
=
$options
{
'cpan-config-dir'
}
|| File::Spec->catfile(
$ENV
{HOME},
".cpan"
);
my
@cpanshell
= (
"$prefix/bin/perl"
,
"-I"
,
"$cdir"
,
"-MCPAN::MyConfig"
,
"-MCPAN"
,
"-e"
,
"\$CPAN::Config->{build_dir}=q{$bdir};"
,
"-e"
,
);
for
(
@m
) {
s/-/::/g
if
/-/ and !m|/|;
}
my
$install
=
join
","
,
map
{
"'$_'"
}
@m
;
if
(
$just_testing
) {
$install
=
"test($install)"
;
}
elsif
(
$options
{
'no-module-tests'
}) {
$install
=
"notest('install',$install)"
;
}
else
{
$install
=
"install($install)"
;
}
my
$last
=
$m
[-1];
my
$status_method
=
$just_testing
?
'test'
:
'uptodate'
;
my
$shellcmd
=
"$install; die unless CPAN::Shell->expand(Module => '$last')->$status_method;"
;
if
(
$options
{module} ||
$options
{
'test-module'
}) {
run_report_and_exit(
@cpanshell
,
$shellcmd
);
}
else
{
my
$ret
= run_with_options({
setprgp
=>
$options
{
setpgrp
},
timeout
=>
$options
{timeout},
},
@cpanshell
,
$shellcmd
);
$ret
&= 0xff
if
$options
{crash};
if
(
$ret
) {
report_and_exit(!
$ret
,
'zero exit from'
,
'non-zero exit from'
,
"@_"
);
}
}
}
match_and_exit(
$real_target
,
@ARGV
)
if
$match
;
if
(
defined
$options
{
'one-liner'
}) {
my
$exe
=
$target
=~ /^(?:perl$|test)/ ?
'perl'
:
'miniperl'
;
unshift
@ARGV
,
map
{(
'-e'
,
$_
)} @{
$options
{
'one-liner'
}};
foreach
(
qw(c l w)
) {
unshift
@ARGV
,
"-$_"
if
$options
{
$_
};
}
unshift
@ARGV
,
"./$exe"
,
'-Ilib'
;
}
if
(-f
$ARGV
[0]) {
my
$fh
= open_or_die(
$ARGV
[0]);
my
$line
= <
$fh
>;
unshift
@ARGV
, $1,
'-Ilib'
if
$line
=~
$run_with_our_perl
;
}
if
(
$options
{valgrind}) {
unshift
@ARGV
,
'valgrind'
,
'--error-exitcode=124'
;
}
if
(
exists
$Config
{ldlibpthname}) {
my
$varname
=
$Config
{ldlibpthname};
my
$cwd
= Cwd::getcwd();
if
(
defined
$ENV
{
$varname
}) {
$ENV
{
$varname
} =
$cwd
.
$Config
{path_sep} .
$ENV
{
$varname
};
}
else
{
$ENV
{
$varname
} =
$cwd
;
}
}
run_report_and_exit(
@ARGV
);
sub
fake_noextensions {
edit_file(
'config.sh'
,
sub
{
my
@lines
=
split
/\n/,
shift
;
my
@ext
=
split
/\s+/,
$defines
{noextensions};
foreach
(
@lines
) {
next
unless
/^extensions=/ || /^dynamic_ext/;
foreach
my
$ext
(
@ext
) {
s/\b
$ext
( )?\b/$1/;
}
}
return
join
"\n"
,
@lines
;
});
}
sub
force_manifest {
my
(
@missing
,
@created_dirs
);
my
$fh
= open_or_die(
'MANIFEST'
);
while
(<
$fh
>) {
next
unless
/^(\S+)/;
push
@missing
, $1
unless
-f $1 || -d $1;
}
close_or_die(
$fh
);
foreach
my
$pathname
(
@missing
) {
my
@parts
=
split
'/'
,
$pathname
;
my
$leaf
=
pop
@parts
;
my
$path
=
'.'
;
while
(
@parts
) {
$path
.=
'/'
.
shift
@parts
;
next
if
-d
$path
;
mkdir
$path
, 0700 or die_255(
"Can't create $path: $!"
);
unshift
@created_dirs
,
$path
;
}
$fh
= open_or_die(
$pathname
,
'>'
);
close_or_die(
$fh
);
chmod
0,
$pathname
or die_255(
"Can't chmod 0 $pathname: $!"
);
}
return
\
@missing
, \
@created_dirs
;
}
sub
force_manifest_cleanup {
my
(
$missing
,
$created_dirs
) =
@_
;
my
@errors
;
foreach
my
$file
(
@$missing
) {
my
(
undef
,
undef
,
$mode
,
undef
,
undef
,
undef
,
undef
,
$size
)
=
stat
$file
;
if
(!
defined
$mode
) {
push
@errors
,
"Added file $file has been deleted by Configure"
;
next
;
}
if
(Fcntl::S_IMODE(
$mode
) != 0) {
push
@errors
,
sprintf
'Added file %s had mode changed by Configure to %03o'
,
$file
,
$mode
;
}
if
(
$size
!= 0) {
push
@errors
,
"Added file $file had sized changed by Configure to $size"
;
}
unlink
$file
or die_255(
"Can't unlink $file: $!"
);
}
foreach
my
$dir
(
@$created_dirs
) {
rmdir
$dir
or die_255(
"Can't rmdir $dir: $!"
);
}
skip(
"@errors"
)
if
@errors
;
}
sub
patch_Configure {
if
(
$major
< 1) {
if
(extract_from_file(
'Configure'
,
qr/^\t\t\*=\*\) echo "\$1" >> \$optdef;;$/
)) {
apply_patch(<<
'EOPATCH'
);
diff --git a/Configure b/Configure
index
3d3b38d..78ffe16 100755
--- a/Configure
+++ b/Configure
@@ -652,7 +777,8 @@
while
test $
echo
"$me: use '-U symbol=', not '-D symbol='."
>&2
echo
"$me: ignoring -D $1"
>&2
;;
- *=*) echo
"$1"
>>
$optdef
;;
+ *=*) echo
"$1"
| \
+ sed -e
"s/'/'\"'\"'/g"
-e
"s/=\(.*\)/='\1'/"
>>
$optdef
;;
*) echo
"$1='define'"
>>
$optdef
;;
esac
shift
EOPATCH
}
if
(extract_from_file(
'Configure'
,
qr/^if \$contains 'd_namlen' \$xinc\b/
)) {
apply_patch(
<<'EOPATCH');
diff --git a/Configure b/Configure
index 3d3b38d..78ffe16 100755
--- a/Configure
+++ b/Configure
@@ -3935,7 +4045,8 @@ $rm -f try.c
: see if the directory entry stores field length
echo " "
-if $contains 'd_namlen' $xinc >/dev/null 2>&1; then
+$cppstdin $cppflags $cppminus < "$xinc" > try.c
+if $contains 'd_namlen' try.c >/dev/null 2>&1; then
echo "Good, your directory entry keeps length information in d_namlen." >&4
val="$define"
else
EOPATCH
}
}
if
(
$major
< 2
&& !extract_from_file(
'Configure'
,
qr/Try to guess additional flags to pick up local libraries/
)) {
my
$mips
= extract_from_file(
'Configure'
,
qr!(''\) if (?:\./)?mips; then)!
);
apply_patch(
sprintf
<<'EOPATCH', $mips);
diff --git a/Configure b/Configure
index 53649d5..0635a6e 100755
--- a/Configure
+++ b/Configure
@@ -2749,6 +2749,52 @@ EOM
;;
esac
+: Set private lib path
+case "$plibpth" in
+'') if ./mips; then
+ plibpth="$incpath/usr/lib /usr/local/lib /usr/ccs/lib"
+ fi;;
+esac
+case "$libpth" in
+' ') dlist='';;
+'') dlist="$plibpth $glibpth";;
+*) dlist="$libpth";;
+esac
+
+: Now check and see which directories actually exist, avoiding duplicates
+libpth=''
+for xxx in $dlist
+do
+ if $test -d $xxx; then
+ case " $libpth " in
+ *" $xxx "*) ;;
+ *) libpth="$libpth $xxx";;
+ esac
+ fi
+done
+$cat <<'EOM'
+
+Some systems have incompatible or broken versions of libraries. Among
+the directories listed in the question below, please remove any you
+know not to be holding relevant libraries, and add any that are needed.
+Say "none" for none.
+
+EOM
+case "$libpth" in
+'') dflt='none';;
+*)
+ set X $libpth
+ shift
+ dflt=${1+"$@"}
+ ;;
+esac
+rp="Directories to use for library searches?"
+. ./myread
+case "$ans" in
+none) libpth=' ';;
+*) libpth="$ans";;
+esac
+
: flags used in final linking phase
case "$ldflags" in
'') if ./venix; then
@@ -2765,6 +2811,23 @@ case "$ldflags" in
;;
*) dflt="$ldflags";;
esac
+
+: Possible local library directories to search.
+loclibpth="/usr/local/lib /opt/local/lib /usr/gnu/lib"
+loclibpth="$loclibpth /opt/gnu/lib /usr/GNU/lib /opt/GNU/lib"
+
+: Try to guess additional flags to pick up local libraries.
+for thislibdir in $libpth; do
+ case " $loclibpth " in
+ *" $thislibdir "*)
+ case "$dflt " in
+ "-L$thislibdir ") ;;
+ *) dflt="$dflt -L$thislibdir" ;;
+ esac
+ ;;
+ esac
+done
+
echo " "
rp="Any additional ld flags (NOT including libraries)?"
. ./myread
@@ -2828,52 +2891,6 @@ n) echo "OK, that should do.";;
esac
$rm -f try try.* core
-: Set private lib path
-case "$plibpth" in
-%s
- plibpth="$incpath/usr/lib /usr/local/lib /usr/ccs/lib"
- fi;;
-esac
-case "$libpth" in
-' ') dlist='';;
-'') dlist="$plibpth $glibpth";;
-*) dlist="$libpth";;
-esac
-
-: Now check and see which directories actually exist, avoiding duplicates
-libpth=''
-for xxx in $dlist
-do
- if $test -d $xxx; then
- case " $libpth " in
- *" $xxx "*) ;;
- *) libpth="$libpth $xxx";;
- esac
- fi
-done
-$cat <<'EOM'
-
-Some systems have incompatible or broken versions of libraries. Among
-the directories listed in the question below, please remove any you
-know not to be holding relevant libraries, and add any that are needed.
-Say "none" for none.
-
-EOM
-case "$libpth" in
-'') dflt='none';;
-*)
- set X $libpth
- shift
- dflt=${1+"$@"}
- ;;
-esac
-rp="Directories to use for library searches?"
-. ./myread
-case "$ans" in
-none) libpth=' ';;
-*) libpth="$ans";;
-esac
-
: compute shared library extension
case "$so" in
'')
EOPATCH
}
if
(
$major
== 4 && extract_from_file(
'Configure'
,
qr/^d_gethbynam=/
)) {
apply_commit(
'3cbc818d1d0ac470'
);
}
if
(
$major
== 4 && extract_from_file(
'Configure'
,
qr/gethbadd_addr_type=`echo \$gethbadd_addr_type/
)) {
apply_commit(
'6ff9219da6cf8cfd'
);
}
if
(
$major
== 4 && extract_from_file(
'Configure'
,
qr/^pthreads_created_joinable=/
)) {
edit_file(
'Configure'
,
sub
{
my
$code
=
shift
;
$code
=~ s{^pthreads_created_joinable=
''
}
{d_pthreads_created_joinable=
''
}ms
or die_255(
"Substitution failed"
);
$code
=~ s{^pthreads_created_joinable=
'\$pthreads_created_joinable'
}
{d_pthreads_created_joinable=
'\$d_pthreads_created_joinable'
}ms
or die_255(
"Substitution failed"
);
return
$code
;
});
}
if
(
$major
< 5 && extract_from_file(
'Configure'
,
qr!if \$cc \$ccflags try\.c -o try >/dev/null 2>&1; then!
)) {
if
(extract_from_file(
'Configure'
,
qr/xxx_prompt=y/
)) {
apply_patch(
<<'EOPATCH');
diff --git a/Configure b/Configure
index 62249dd..c5c384e 100755
--- a/Configure
+++ b/Configure
@@ -8247,7 +8247,7 @@ main()
}
EOCP
xxx_prompt=y
- if $cc $ccflags try.c -o try >/dev/null 2>&1 && ./try > /dev/null; then
+ if $cc $ccflags $ldflags try.c -o try >/dev/null 2>&1 && ./try > /dev/null; then
dflt=`./try`
case "$dflt" in
[1-4][1-4][1-4][1-4]|12345678|87654321)
EOPATCH
}
else
{
apply_patch(
<<'EOPATCH');
diff --git a/Configure b/Configure
index 53649d5..f1cd64a 100755
--- a/Configure
+++ b/Configure
@@ -6362,7 +6362,7 @@ main()
printf("\n");
}
EOCP
- if $cc $ccflags try.c -o try >/dev/null 2>&1 ; then
+ if $cc $ccflags $ldflags try.c -o try >/dev/null 2>&1 ; then
dflt=`./try`
case "$dflt" in
????|????????) echo "(The test program ran ok.)";;
EOPATCH
}
}
if
(
$major
< 6 && !extract_from_file(
'Configure'
,
qr!^\t-A\)$!
)) {
edit_file(
'Configure'
,
sub
{
my
$code
=
shift
;
$code
=~ s/(optstr =
")([^"
]+";\s*
or die_255(
"Substitution failed"
);
$code
=~ s!^(: who configured the
system
)!
touch posthint.sh
. ./posthint.sh
$1!ms
or die_255(
"Substitution failed"
);
return
$code
;
});
apply_patch(
<<'EOPATCH');
diff --git a/Configure b/Configure
index 4b55fa6..60c3c64 100755
--- a/Configure
+++ b/Configure
@@ -1150,6 +1150,7 @@ set X `for arg in "$@"; do echo "X$arg"; done |
eval "set $*"
shift
rm -f options.awk
+rm -f posthint.sh
: set up default values
fastread=''
@@ -1172,6 +1173,56 @@ while test $# -gt 0; do
case "$1" in
-d) shift; fastread=yes;;
-e) shift; alldone=cont;;
+ -A)
+ shift
+ xxx=''
+ yyy="$1"
+ zzz=''
+ uuu=undef
+ case "$yyy" in
+ *=*) zzz=`echo "$yyy"|sed 's!=.*!!'`
+ case "$zzz" in
+ *:*) zzz='' ;;
+ *) xxx=append
+ zzz=" "`echo "$yyy"|sed 's!^[^=]*=!!'`
+ yyy=`echo "$yyy"|sed 's!=.*!!'` ;;
+ esac
+ ;;
+ esac
+ case "$xxx" in
+ '') case "$yyy" in
+ *:*) xxx=`echo "$yyy"|sed 's!:.*!!'`
+ yyy=`echo "$yyy"|sed 's!^[^:]*:!!'`
+ zzz=`echo "$yyy"|sed 's!^[^=]*=!!'`
+ yyy=`echo "$yyy"|sed 's!=.*!!'` ;;
+ *) xxx=`echo "$yyy"|sed 's!:.*!!'`
+ yyy=`echo "$yyy"|sed 's!^[^:]*:!!'` ;;
+ esac
+ ;;
+ esac
+ case "$xxx" in
+ append)
+ echo "$yyy=\"\${$yyy}$zzz\"" >> posthint.sh ;;
+ clear)
+ echo "$yyy=''" >> posthint.sh ;;
+ define)
+ case "$zzz" in
+ '') zzz=define ;;
+ esac
+ echo "$yyy='$zzz'" >> posthint.sh ;;
+ eval)
+ echo "eval \"$yyy=$zzz\"" >> posthint.sh ;;
+ prepend)
+ echo "$yyy=\"$zzz\${$yyy}\"" >> posthint.sh ;;
+ undef)
+ case "$zzz" in
+ '') zzz="$uuu" ;;
+ esac
+ echo "$yyy=$zzz" >> posthint.sh ;;
+ *) echo "$me: unknown -A command '$xxx', ignoring -A $1" >&2 ;;
+ esac
+ shift
+ ;;
-f)
shift
cd ..
EOPATCH
}
if
(
$major
< 8 && $^O eq
'aix'
) {
edit_file(
'Configure'
,
sub
{
my
$code
=
shift
;
$code
=~ s{(\bsed\b.*\bsyscall)(?:\[0-9\]\*)?(\$.*/lib/syscalls\.
exp
)}
{$1 .
"[0-9]*[ \t]*"
. $2}e;
return
$code
;
});
}
if
(
$major
< 8 && !extract_from_file(
'Configure'
,
qr/^\t\tif test ! -t 0; then$/
)) {
edit_file(
'Configure'
,
sub
{
my
$code
=
shift
;
$code
=~ s/test ! -t 0/test Perl = rules/;
return
$code
;
});
}
if
(
$major
== 8 ||
$major
== 9) {
edit_file(
'Configure'
,
sub
{
my
$code
=
shift
;
return
$code
if
$code
!~ /\btc=
""
;/;
return
$code
if
$code
!~ /\bmistrustnm\b/;
my
$fixed
=
<<'EOC';
: is a C symbol defined?
csym='tlook=$1;
case "$3" in
-v) tf=libc.tmp; tdc="";;
-a) tf=libc.tmp; tdc="[]";;
*) tlook="^$1\$"; tf=libc.list; tdc="()";;
esac;
tx=yes;
case "$reuseval-$4" in
true-) ;;
true-*) tx=no; eval "tval=\$$4"; case "$tval" in "") tx=yes;; esac;;
esac;
case "$tx" in
yes)
tval=false;
if $test "$runnm" = true; then
if $contains $tlook $tf >/dev/null 2>&1; then
tval=true;
elif $test "$mistrustnm" = compile -o "$mistrustnm" = run; then
echo "void *(*(p()))$tdc { extern void *$1$tdc; return &$1; } int main() { if(p()) return(0); else return(1); }"> try.c;
$cc -o try $optimize $ccflags $ldflags try.c >/dev/null 2>&1 $libs && tval=true;
$test "$mistrustnm" = run -a -x try && { $run ./try$_exe >/dev/null 2>&1 || tval=false; };
$rm -f try$_exe try.c core core.* try.core;
fi;
else
echo "void *(*(p()))$tdc { extern void *$1$tdc; return &$1; } int main() { if(p()) return(0); else return(1); }"> try.c;
$cc -o try $optimize $ccflags $ldflags try.c $libs >/dev/null 2>&1 && tval=true;
$rm -f try$_exe try.c;
fi;
;;
*)
case "$tval" in
$define) tval=true;;
*) tval=false;;
esac;
;;
esac;
eval "$2=$tval"'
EOC
$code
=~ s/\n: is a C symbol
defined
\?\n.*?\neval
"\$2=\$tval"
'\n\n/
$fixed
/sm
or die_255(
"substitution failed"
);
return
$code
;
});
}
if
(
$major
< 10
&& extract_from_file(
'Configure'
,
qr/^set malloc\.h i_malloc$/
)) {
apply_patch(
<<'EOPATCH');
diff --git a/Configure b/Configure
index 3d2e8b9..6ce7766 100755
--- a/Configure
+++ b/Configure
@@ -6743,5 +6743,22 @@ set d_dosuid
: see if this is a malloc.h system
-set malloc.h i_malloc
-eval $inhdr
+: we want a real compile instead of Inhdr because some systems have a
+: malloc.h that just gives a compile error saying to use stdlib.h instead
+echo " "
+$cat >try.c <<EOCP
+#include <stdlib.h>
+#include <malloc.h>
+int main () { return 0; }
+EOCP
+set try
+if $cc $optimize $ccflags $ldflags -o try $* try.c $libs > /dev/null 2>&1; then
+ echo "<malloc.h> found." >&4
+ val="$define"
+else
+ echo "<malloc.h> NOT found." >&4
+ val="$undef"
+fi
+$rm -f try.c try
+set i_malloc
+eval $setvar
EOPATCH
}
}
sub
patch_hints {
if
($^O eq
'freebsd'
) {
checkout_file(
'hints/freebsd.sh'
);
}
elsif
($^O eq
'darwin'
) {
if
(
$major
< 8) {
my
$faking_it
;
if
(!-f
'hints/darwin.sh'
) {
checkout_file(
'hints/darwin.sh'
,
'f556e5b971932902'
);
++
$faking_it
;
}
edit_file(
'hints/darwin.sh'
,
sub
{
my
$code
=
shift
;
$code
=~ s/^cppflags=
'-traditional-cpp'
;$/cppflags=
"\${cppflags} -no-cpp-precomp"
/m;
$code
=~ s/^(lddlflags=)/ldflags=
"\${ldflags} -flat_namespace"
\n$1/m;
$code
=~ s/^useshrplib=
'true'
/useshrplib=
'false'
/m
if
$faking_it
;
if
(
$case_insensitive
&&
$code
!~ /^firstmakefile=GNUmakefile/) {
$code
.=
"\nfirstmakefile=GNUmakefile;\n"
;
}
return
$code
;
});
}
}
elsif
($^O eq
'netbsd'
) {
if
(
$major
< 6) {
edit_file(
'hints/netbsd.sh'
,
sub
{
my
$code
=
shift
;
my
$fixed
=
<<'EOC';
case "$osvers" in
0.9|0.8*)
usedl="$undef"
;;
*)
if [ -f /usr/libexec/ld.elf_so ]; then
d_dlopen=$define
d_dlerror=$define
ccdlflags="-Wl,-E -Wl,-R${PREFIX}/lib $ccdlflags"
cccdlflags="-DPIC -fPIC $cccdlflags"
lddlflags="--whole-archive -shared $lddlflags"
elif [ "`uname -m`" = "pmax" ]; then
# NetBSD 1.3 and 1.3.1 on pmax shipped an 'old' ld.so, which will not work.
d_dlopen=$undef
elif [ -f /usr/libexec/ld.so ]; then
d_dlopen=$define
d_dlerror=$define
ccdlflags="-Wl,-R${PREFIX}/lib $ccdlflags"
# we use -fPIC here because -fpic is *NOT* enough for some of the
# extensions like Tk on some netbsd platforms (the sparc is one)
cccdlflags="-DPIC -fPIC $cccdlflags"
lddlflags="-Bforcearchive -Bshareable $lddlflags"
else
d_dlopen=$undef
fi
;;
esac
EOC
$code
=~ s/^case
"\$osvers"
in\n0\.9\|0\.8.*?^esac\n/
$fixed
/ms;
return
$code
;
});
}
}
elsif
($^O eq
'openbsd'
) {
if
(
$major
< 8) {
checkout_file(
'hints/openbsd.sh'
,
'43051805d53a3e4c'
)
unless
-f
'hints/openbsd.sh'
;
my
$which
= extract_from_file(
'hints/openbsd.sh'
,
qr/# from (2\.8|3\.1) onwards/
,
''
);
if
(
$which
eq
''
) {
my
$was
= extract_from_file(
'hints/openbsd.sh'
,
qr/(lddlflags="(?:-Bforcearchive )?-Bshareable)/
);
apply_patch(
sprintf
<<'EOPATCH', $was);
diff --git a/hints/openbsd.sh b/hints/openbsd.sh
index a7d8bf2..5b79709 100644
--- a/hints/openbsd.sh
+++ b/hints/openbsd.sh
@@ -37,7 +37,25 @@ OpenBSD.alpha|OpenBSD.mips|OpenBSD.powerpc|OpenBSD.vax)
# we use -fPIC here because -fpic is *NOT* enough for some of the
# extensions like Tk on some OpenBSD platforms (ie: sparc)
cccdlflags="-DPIC -fPIC $cccdlflags"
- %s $lddlflags"
+ case "$osvers" in
+ [01].*|2.[0-7]|2.[0-7].*)
+ lddlflags="-Bshareable $lddlflags"
+ ;;
+ 2.[8-9]|3.0)
+ ld=${cc:-cc}
+ lddlflags="-shared -fPIC $lddlflags"
+ ;;
+ *) # from 3.1 onwards
+ ld=${cc:-cc}
+ lddlflags="-shared -fPIC $lddlflags"
+ libswanted=`echo $libswanted | sed 's/ dl / /'`
+ ;;
+ esac
+
+ # We need to force ld to export symbols on ELF platforms.
+ # Without this, dlopen() is crippled.
+ ELF=`${cc:-cc} -dM -E - </dev/null | grep __ELF__`
+ test -n "$ELF" && ldflags="-Wl,-E $ldflags"
;;
esac
EOPATCH
}
elsif
(
$which
eq
'2.8'
) {
my
$was
= extract_from_file(
'hints/openbsd.sh'
,
qr/lddlflags="(-shared(?: -fPIC)?) \$lddlflags"/
);
apply_patch(
sprintf
<<'EOPATCH', $was);
--- a/hints/openbsd.sh 2011-10-21 17:25:20.000000000 +0200
+++ b/hints/openbsd.sh 2011-10-21 16:58:43.000000000 +0200
@@ -44,11 +44,21 @@
[01].*|2.[0-7]|2.[0-7].*)
lddlflags="-Bshareable $lddlflags"
;;
- *) # from 2.8 onwards
+ 2.[8-9]|3.0)
ld=${cc:-cc}
- lddlflags="%s $lddlflags"
+ lddlflags="-shared -fPIC $lddlflags"
+ ;;
+ *) # from 3.1 onwards
+ ld=${cc:-cc}
+ lddlflags="-shared -fPIC $lddlflags"
+ libswanted=`echo $libswanted | sed 's/ dl / /'`
;;
esac
+
+ # We need to force ld to export symbols on ELF platforms.
+ # Without this, dlopen() is crippled.
+ ELF=`${cc:-cc} -dM -E - </dev/null | grep __ELF__`
+ test -n "$ELF" && ldflags="-Wl,-E $ldflags"
;;
esac
EOPATCH
}
elsif
(
$which
eq
'3.1'
&& !extract_from_file(
'hints/openbsd.sh'
,
qr/We need to force ld to export symbols on ELF platforms/
)) {
apply_patch(
<<'EOPATCH');
diff --git a/hints/openbsd.sh b/hints/openbsd.sh
index c6b6bc9..4839d04 100644
--- a/hints/openbsd.sh
+++ b/hints/openbsd.sh
@@ -54,6 +54,11 @@ alpha-2.[0-8]|mips-*|vax-*|powerpc-2.[0-7]|m88k-*)
libswanted=`echo $libswanted | sed 's/ dl / /'`
;;
esac
+
+ # We need to force ld to export symbols on ELF platforms.
+ # Without this, dlopen() is crippled.
+ ELF=`${cc:-cc} -dM -E - </dev/null | grep __ELF__`
+ test -n "$ELF" && ldflags="-Wl,-E $ldflags"
;;
esac
EOPATCH
}
}
}
elsif
($^O eq
'linux'
) {
if
(
$major
< 1) {
edit_file(
'hints/linux.sh'
,
sub
{
my
$code
=
shift
;
$code
=~ s!-I/usr/include/bsd!-Dbool=char -DHAS_BOOL!g;
return
$code
;
});
}
if
(
$major
<= 9) {
if
(`uname -sm` =~
qr/^Linux sparc/
) {
if
(extract_from_file(
'hints/linux.sh'
,
qr/sparc-linux/
)) {
apply_commit(
'f6527d0ef0c13ad4'
);
}
elsif
(!extract_from_file(
'hints/linux.sh'
,
qr/^sparc-linux\)$/
)) {
my
$fh
= open_or_die(
'hints/linux.sh'
,
'>>'
);
print
$fh
<<'EOT' or die_255($!);
case "`uname -m`" in
sparc*)
case "$cccdlflags" in
*-fpic*) cccdlflags="`echo $cccdlflags|sed 's/-fpic/-fPIC/'`" ;;
*) cccdlflags="$cccdlflags -fPIC" ;;
esac
;;
esac
EOT
close_or_die(
$fh
);
}
}
}
}
elsif
($^O eq
'solaris'
) {
if
((
$major
== 13 ||
$major
== 14)
&& extract_from_file(
'hints/solaris_2.sh'
,
qr/getconfldllflags/
)) {
apply_commit(
'c80bde4388070c45'
);
}
}
}
sub
patch_SH {
if
(
$major
> 0 && <*/Cwd/Cwd.xs>) {
if
(
$major
< 10
&& !extract_from_file(
'Makefile.SH'
,
qr/^extra_dep=''$/
)) {
apply_patch(
<<'EOPATCH');
diff --git a/Makefile.SH b/Makefile.SH
index f61d0db..6097954 100644
--- a/Makefile.SH
+++ b/Makefile.SH
@@ -155,10 +155,20 @@ esac
: Prepare dependency lists for Makefile.
dynamic_list=' '
+extra_dep=''
for f in $dynamic_ext; do
: the dependency named here will never exist
base=`echo "$f" | sed 's/.*\///'`
- dynamic_list="$dynamic_list lib/auto/$f/$base.$dlext"
+ this_target="lib/auto/$f/$base.$dlext"
+ dynamic_list="$dynamic_list $this_target"
+
+ : Parallel makes reveal that we have some interdependencies
+ case $f in
+ Math/BigInt/FastCalc) extra_dep="$extra_dep
+$this_target: lib/auto/List/Util/Util.$dlext" ;;
+ Unicode/Normalize) extra_dep="$extra_dep
+$this_target: lib/unicore/CombiningClass.pl" ;;
+ esac
done
static_list=' '
@@ -987,2 +997,9 @@ n_dummy $(nonxs_ext): miniperl$(EXE_EXT) preplibrary $(DYNALOADER) FORCE
@$(LDLIBPTH) sh ext/util/make_ext nonxs $@ MAKE=$(MAKE) LIBPERL_A=$(LIBPERL)
+!NO!SUBS!
+
+$spitshell >>Makefile <<EOF
+$extra_dep
+EOF
+
+$spitshell >>Makefile <<'!NO!SUBS!'
EOPATCH
}
if
(
$major
== 15 && $^O !~ /^(linux|darwin|.
*bsd
)$/
&& extract_from_file(
'Makefile.SH'
,
qr/^V.* \?= /
)) {
apply_patch(
<<'EOPATCH');
diff --git a/Makefile.SH b/Makefile.SH
index 94952bd..13e9001 100755
--- a/Makefile.SH
+++ b/Makefile.SH
@@ -338,8 +338,8 @@ linux*|darwin)
$spitshell >>$Makefile <<!GROK!THIS!
# If you're going to use valgrind and it can't be invoked as plain valgrind
# then you'll need to change this, or override it on the make command line.
-VALGRIND ?= valgrind
-VG_TEST ?= ./perl -e 1 2>/dev/null
+VALGRIND = valgrind
+VG_TEST = ./perl -e 1 2>/dev/null
!GROK!THIS!
;;
EOPATCH
}
if
(
$major
== 11) {
if
(extract_from_file(
'patchlevel.h'
,
qr/^#include "unpushed\.h"/
)) {
apply_patch(
<<'EOPATCH');
diff --git a/Makefile.SH b/Makefile.SH
index 9ad8b6f..106e721 100644
--- a/Makefile.SH
+++ b/Makefile.SH
@@ -540,9 +544,14 @@ sperl.i: perl.c $(h)
.PHONY: all translators utilities make_patchnum
-make_patchnum:
+make_patchnum: lib/Config_git.pl
+
+lib/Config_git.pl: make_patchnum.sh
sh $(shellflags) make_patchnum.sh
+# .patchnum, unpushed.h and lib/Config_git.pl are built by make_patchnum.sh
+unpushed.h .patchnum: lib/Config_git.pl
+
# make sure that we recompile perl.c if .patchnum changes
perl$(OBJ_EXT): .patchnum unpushed.h
EOPATCH
}
elsif
(-f
'.gitignore'
&& extract_from_file(
'.gitignore'
,
qr/^\.patchnum$/
)) {
edit_file(
'Makefile.SH'
,
sub
{
my
$code
=
shift
;
$code
=~ s/^make_patchnum:\n/make_patchnum: .patchnum
.sha1: .patchnum
.patchnum: make_patchnum.sh
/m;
return
$code
;
});
}
elsif
(-f
'lib/.gitignore'
&& extract_from_file(
'lib/.gitignore'
,
qr!^/Config_git.pl!
)
&& !extract_from_file(
'Makefile.SH'
,
qr/^uudmap\.h.*:bitcount.h$/
)) {
edit_file(
'Makefile.SH'
,
sub
{
my
$code
=
shift
;
$code
=~ s{^(pod/perlapi\.pod) (pod/perlintern\.pod): }
{$1: $2\n\n$2: }m;
$code
=~ s{^(uudmap\.h) (bitcount\.h): }
{$1: $2\n\n$2: }m;
if
(
$code
=~ s{git_version\.h: stock_git_version\.h
\tcp stock_git_version\.h git_version\.h}
{}m) {
$code
=~ s{\|\| \$\(MAKE\) miniperl.*}
{}m;
$code
=~ s{^\t(sh.
*make_patchnum
\.sh.*)}
{\t-$1}m;
$code
=~ s{^\t.
*make_patchnum
\.pl}
{\t-$^X make_patchnum.pl}m;
$code
=~ s{^make_patchnum:.*}{
make_patchnum: lib/Config_git.pl
git_version.h: lib/Config_git.pl
perlmini\$(OBJ_EXT): git_version.h
lib/Config_git.pl:}m;
}
$code
=~ s{^(?:lib/Config_git\.pl )?git_version\.h: (.* make_patchnum\.pl.*)}
{git_version.h: lib/Config_git.pl
lib/Config_git.pl: $1}m;
$code
=~ s{^(\$\(.*?\) )?(\$\(CONFIGPOD\))(: .*? configpm Porting/Glossary)( lib/Config_git\.pl)?}{
($1 ?
"$1: $2\n\n"
:
''
)
. $2 . $3
. ($4 ? $4 :
' lib/Config_git.pl'
)
}me;
return
$code
;
});
}
}
if
(
$major
< 14) {
edit_file(
'Makefile.SH'
,
sub
{
my
$code
=
shift
;
foreach
my
$ext
(
qw(Encode SDBM_File)
) {
next
if
$code
=~ /\b
$ext
\) extra_dep=/s;
$code
=~ s!(\) extra_dep="\
$extra_dep
\
$this_target
: .*?" ;;)
( esac
)!$1
$ext
) extra_dep="\
$extra_dep
\
$this_target
: lib/auto/Cwd/Cwd.\
$dlext
" ;;
$2!;
}
return
$code
;
});
}
}
if
(
$major
== 7) {
if
(extract_from_file(
'Makefile.SH'
,
qr/Writing it this way gives make a big hint to always run opcode\.pl before/
)) {
apply_commit(
'70c6e6715e8fec53'
);
}
elsif
(extract_from_file(
'Makefile.SH'
,
qr/^opcode\.h opnames\.h pp_proto\.h pp\.sym: opcode\.pl$/
)) {
revert_commit(
'9fec149bb652b6e9'
);
}
}
if
($^O eq
'aix'
&&
$major
>= 8 &&
$major
< 28
&& extract_from_file(
'Makefile.SH'
,
qr!\Q./$(MINIPERLEXP) makedef.pl\E.*aix!
)) {
edit_file(
'Makefile.SH'
,
sub
{
my
$code
=
shift
;
$code
=~ s{(\Q./$(MINIPERLEXP)\E) (makedef\.pl.
*aix
)}
{$1 -Ilib $2};
return
$code
;
})
}
if
($^O eq
'aix'
&&
$major
>= 11 &&
$major
<= 15
&& extract_from_file(
'makedef.pl'
,
qr/^use Config/
)) {
edit_file(
'Makefile.SH'
,
sub
{
my
$code
=
shift
;
$code
=~ s{^(perl\.
exp
:.* )config\.sh(\b.*)}
{$1 .
'$(CONFIGPM)'
. $2}me;
return
$code
;
});
}
checkout_file(
'makedepend.SH'
,
'v5.34.0'
)
if
$major
< 26;
if
(
$major
< 4 && -f
'config.sh'
&& !extract_from_file(
'config.sh'
,
qr/^trnl=/
)) {
edit_file(
'makedepend.SH'
,
sub
{
my
$code
=
shift
;
$code
=~ s/^trnl=
'\$trnl'
$/trnl=
'\\n'
/m;
return
$code
;
});
}
}
sub
patch_C {
if
(
$major
== 2 && extract_from_file(
'perl.c'
,
qr/^\tfclose\(e_fp\);$/
)) {
apply_patch(
<<'EOPATCH');
diff --git a/perl.c b/perl.c
index 03c4d48..3c814a2 100644
--- a/perl.c
+++ b/perl.c
@@ -252,6 +252,7 @@ setuid perl scripts securely.\n");
#ifndef VMS /* VMS doesn't have environ array */
origenviron = environ;
#endif
+ e_tmpname = Nullch;
if (do_undump) {
@@ -405,6 +406,7 @@ setuid perl scripts securely.\n");
if (e_fp) {
if (Fflush(e_fp) || ferror(e_fp) || fclose(e_fp))
croak("Can't write to temp file for -e: %s", Strerror(errno));
+ e_fp = Nullfp;
argc++,argv--;
scriptname = e_tmpname;
}
@@ -470,10 +472,10 @@ setuid perl scripts securely.\n");
curcop->cop_line = 0;
curstash = defstash;
preprocess = FALSE;
- if (e_fp) {
- fclose(e_fp);
- e_fp = Nullfp;
+ if (e_tmpname) {
(void)UNLINK(e_tmpname);
+ Safefree(e_tmpname);
+ e_tmpname = Nullch;
}
/* now that script is parsed, we can modify record separator */
@@ -1369,7 +1371,7 @@ SV *sv;
scriptname = xfound;
}
- origfilename = savepv(e_fp ? "-e" : scriptname);
+ origfilename = savepv(e_tmpname ? "-e" : scriptname);
curcop->cop_filegv = gv_fetchfile(origfilename);
if (strEQ(origfilename,"-"))
scriptname = "";
EOPATCH
}
if
(
$major
< 3 && $^O eq
'openbsd'
&& !extract_from_file(
'pp_sys.c'
,
qr/BSD_GETPGRP/
)) {
apply_patch(
<<'EOPATCH');
diff --git a/pp_sys.c b/pp_sys.c
index 4608a2a..f0c9d1d 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -2903,8 +2903,8 @@ PP(pp_getpgrp)
pid = 0;
else
pid = SvIVx(POPs);
-#ifdef USE_BSDPGRP
- value = (I32)getpgrp(pid);
+#ifdef BSD_GETPGRP
+ value = (I32)BSD_GETPGRP(pid);
#else
if (pid != 0)
DIE("POSIX getpgrp can't take an argument");
@@ -2933,8 +2933,8 @@ PP(pp_setpgrp)
}
TAINT_PROPER("setpgrp");
-#ifdef USE_BSDPGRP
- SETi( setpgrp(pid, pgrp) >= 0 );
+#ifdef BSD_SETPGRP
+ SETi( BSD_SETPGRP(pid, pgrp) >= 0 );
#else
if ((pgrp != 0) || (pid != 0)) {
DIE("POSIX setpgrp can't take an argument");
EOPATCH
}
if
(
$major
< 4 && $^O eq
'openbsd'
) {
my
$bad
;
if
(extract_from_file(
'perl.h'
,
qr/^#ifdef HAS_GETPGRP2$/
)) {
$bad
=
<<'EOBAD';
***************
*** 57,71 ****
#define TAINT_PROPER(s) if (tainting) taint_proper(no_security, s)
#define TAINT_ENV() if (tainting) taint_env()
! #ifdef HAS_GETPGRP2
! # ifndef HAS_GETPGRP
! # define HAS_GETPGRP
! # endif
! #endif
!
! #ifdef HAS_SETPGRP2
! # ifndef HAS_SETPGRP
! # define HAS_SETPGRP
! # endif
#endif
EOBAD
}
elsif
(extract_from_file(
'perl.h'
,
qr/Gack, you have one but not both of getpgrp2/
)) {
$bad
=
<<'EOBAD';
***************
*** 56,76 ****
#define TAINT_PROPER(s) if (tainting) taint_proper(no_security, s)
#define TAINT_ENV() if (tainting) taint_env()
! #if defined(HAS_GETPGRP2) && defined(HAS_SETPGRP2)
! # define getpgrp getpgrp2
! # define setpgrp setpgrp2
! # ifndef HAS_GETPGRP
! # define HAS_GETPGRP
! # endif
! # ifndef HAS_SETPGRP
! # define HAS_SETPGRP
! # endif
! # ifndef USE_BSDPGRP
! # define USE_BSDPGRP
! # endif
! #else
! # if defined(HAS_GETPGRP2) || defined(HAS_SETPGRP2)
! #include "Gack, you have one but not both of getpgrp2() and setpgrp2()."
! # endif
#endif
EOBAD
}
elsif
(extract_from_file(
'perl.h'
,
qr/^#ifdef USE_BSDPGRP$/
)) {
$bad
=
<<'EOBAD'
***************
*** 91,116 ****
#define TAINT_PROPER(s) if (tainting) taint_proper(no_security, s)
#define TAINT_ENV() if (tainting) taint_env()
! #ifdef USE_BSDPGRP
! # ifdef HAS_GETPGRP
! # define BSD_GETPGRP(pid) getpgrp((pid))
! # endif
! # ifdef HAS_SETPGRP
! # define BSD_SETPGRP(pid, pgrp) setpgrp((pid), (pgrp))
! # endif
! #else
! # ifdef HAS_GETPGRP2
! # define BSD_GETPGRP(pid) getpgrp2((pid))
! # ifndef HAS_GETPGRP
! # define HAS_GETPGRP
! # endif
! # endif
! # ifdef HAS_SETPGRP2
! # define BSD_SETPGRP(pid, pgrp) setpgrp2((pid), (pgrp))
! # ifndef HAS_SETPGRP
! # define HAS_SETPGRP
! # endif
! # endif
#endif
#ifndef _TYPES_ /* If types.h defines this it's easy. */
EOBAD
}
if
(
$bad
) {
apply_patch(
<<"EOPATCH");
*** a/perl.h 2011-10-21 09:46:12.000000000 +0200
--- b/perl.h 2011-10-21 09:46:12.000000000 +0200
$bad--- 91,144 ----
#define TAINT_PROPER(s) if (tainting) taint_proper(no_security, s)
#define TAINT_ENV() if (tainting) taint_env()
! /* XXX All process group stuff is handled in pp_sys.c. Should these
! defines move there? If so, I could simplify this a lot. --AD 9/96.
! */
! /* Process group stuff changed from traditional BSD to POSIX.
! perlfunc.pod documents the traditional BSD-style syntax, so we'll
! try to preserve that, if possible.
! */
! #ifdef HAS_SETPGID
! # define BSD_SETPGRP(pid, pgrp) setpgid((pid), (pgrp))
! #else
! # if defined(HAS_SETPGRP) && defined(USE_BSD_SETPGRP)
! # define BSD_SETPGRP(pid, pgrp) setpgrp((pid), (pgrp))
! # else
! # ifdef HAS_SETPGRP2 /* DG/UX */
! # define BSD_SETPGRP(pid, pgrp) setpgrp2((pid), (pgrp))
! # endif
! # endif
! #endif
! #if defined(BSD_SETPGRP) && !defined(HAS_SETPGRP)
! # define HAS_SETPGRP /* Well, effectively it does . . . */
! #endif
!
! /* getpgid isn't POSIX, but at least Solaris and Linux have it, and it makes
! our life easier :-) so we'll try it.
! */
! #ifdef HAS_GETPGID
! # define BSD_GETPGRP(pid) getpgid((pid))
! #else
! # if defined(HAS_GETPGRP) && defined(USE_BSD_GETPGRP)
! # define BSD_GETPGRP(pid) getpgrp((pid))
! # else
! # ifdef HAS_GETPGRP2 /* DG/UX */
! # define BSD_GETPGRP(pid) getpgrp2((pid))
! # endif
! # endif
! #endif
! #if defined(BSD_GETPGRP) && !defined(HAS_GETPGRP)
! # define HAS_GETPGRP /* Well, effectively it does . . . */
! #endif
!
! /* These are not exact synonyms, since setpgrp() and getpgrp() may
! have different behaviors, but perl.h used to define USE_BSDPGRP
! (prior to 5.003_05) so some extension might depend on it.
! */
! #if defined(USE_BSD_SETPGRP) || defined(USE_BSD_GETPGRP)
! # ifndef USE_BSDPGRP
! # define USE_BSDPGRP
! # endif
#endif
#ifndef _TYPES_ /* If types.h defines this it's easy. */
EOPATCH
}
}
if
(
$major
< 4 && $^O eq
'hpux'
&& extract_from_file(
'sv.c'
,
qr/i = _filbuf\(/
)) {
apply_patch(
<<'EOPATCH');
diff --git a/sv.c b/sv.c
index a1f1d60..0a806f1 100644
--- a/sv.c
+++ b/sv.c
@@ -2641,7 +2641,7 @@ I32 append;
FILE_cnt(fp) = cnt; /* deregisterize cnt and ptr */
FILE_ptr(fp) = ptr;
- i = _filbuf(fp); /* get more characters */
+ i = __filbuf(fp); /* get more characters */
cnt = FILE_cnt(fp);
ptr = FILE_ptr(fp); /* reregisterize cnt and ptr */
EOPATCH
}
if
(
$major
== 4 && extract_from_file(
'scope.c'
,
qr/\(SV\*\)SSPOPINT/
)) {
apply_commit(
'9002cb76ec83ef7f'
);
}
if
(
$major
== 4 && extract_from_file(
'av.c'
,
qr/AvARRAY\(av\) = 0;/
)) {
apply_commit(
'e1c148c28bf3335b'
,
'av.c'
);
}
if
(
$major
== 4) {
my
$rest
= extract_from_file(
'perl.c'
,
qr/delimcpy(.*)/
);
if
(
defined
$rest
and
$rest
!~ /,$/) {
apply_patch(
<<'EOPATCH');
diff --git a/perl.c b/perl.c
index 4eb69e3..54bbb00 100644
--- a/perl.c
+++ b/perl.c
@@ -1735,7 +1735,7 @@ SV *sv;
if (len < sizeof tokenbuf)
tokenbuf[len] = '\0';
#else /* ! (atarist || DOSISH) */
- s = delimcpy(tokenbuf, tokenbuf + sizeof tokenbuf, s, bufend
+ s = delimcpy(tokenbuf, tokenbuf + sizeof tokenbuf, s, bufend,
':',
&len);
#endif /* ! (atarist || DOSISH) */
EOPATCH
}
}
if
(
$major
== 4 && $^O eq
'linux'
) {
edit_file(
'doio.c'
,
sub
{
my
$code
=
shift
;
$code
=~ s{
defined
\(__sun\) &&
defined
\(__SVR4\)}
{
defined
(__sun__) &&
defined
(__svr4__)}g;
return
$code
;
});
if
(extract_from_file(
'doio.c'
,
qr!^/\* XXX REALLY need metaconfig test \*/$!
)) {
revert_commit(
'4682965a1447ea44'
,
'doio.c'
);
}
if
(
my
$token
= extract_from_file(
'doio.c'
,
qr!^#if (defined\(__sun(?:__)?\)) && defined\(__svr4__\) /\* XXX Need metaconfig test \*/$!
)) {
my
$patch
= `git show -R 9b599b2a63d2324d doio.c`;
$patch
=~ s/
defined
\(__sun__\)/
$token
/g;
apply_patch(
$patch
);
}
if
(extract_from_file(
'doio.c'
,
qr!^/\* linux \(and Solaris2\?\) uses :$!
)) {
revert_commit(
'8490252049bf42d3'
,
'doio.c'
);
}
if
(extract_from_file(
'doio.c'
,
qr/^ unsemds.buf = &semds;$/
)) {
revert_commit(
'8e591e46b4c6543e'
);
}
if
(extract_from_file(
'doio.c'
,
qr!^#ifdef __linux__ /\* XXX Need metaconfig test \*/$!
)) {
apply_patch(
<<'EOPATCH');
diff --git b/doio.c a/doio.c
index 62b7de9..0d57425 100644
--- b/doio.c
+++ a/doio.c
@@ -1333,9 +1331,6 @@ SV **sp;
char *a;
I32 id, n, cmd, infosize, getinfo;
I32 ret = -1;
-#ifdef __linux__ /* XXX Need metaconfig test */
- union semun unsemds;
-#endif
id = SvIVx(*++mark);
n = (optype == OP_SEMCTL) ? SvIVx(*++mark) : 0;
@@ -1364,29 +1359,11 @@ SV **sp;
infosize = sizeof(struct semid_ds);
else if (cmd == GETALL || cmd == SETALL)
{
-#ifdef __linux__ /* XXX Need metaconfig test */
-/* linux uses :
- int semctl (int semid, int semnun, int cmd, union semun arg)
-
- union semun {
- int val;
- struct semid_ds *buf;
- ushort *array;
- };
-*/
- union semun semds;
- if (semctl(id, 0, IPC_STAT, semds) == -1)
-#else
struct semid_ds semds;
if (semctl(id, 0, IPC_STAT, &semds) == -1)
-#endif
return -1;
getinfo = (cmd == GETALL);
-#ifdef __linux__ /* XXX Need metaconfig test */
- infosize = semds.buf->sem_nsems * sizeof(short);
-#else
infosize = semds.sem_nsems * sizeof(short);
-#endif
/* "short" is technically wrong but much more portable
than guessing about u_?short(_t)? */
}
@@ -1429,12 +1406,7 @@ SV **sp;
#endif
#ifdef HAS_SEM
case OP_SEMCTL:
-#ifdef __linux__ /* XXX Need metaconfig test */
- unsemds.buf = (struct semid_ds *)a;
- ret = semctl(id, n, cmd, unsemds);
-#else
ret = semctl(id, n, cmd, (struct semid_ds *)a);
-#endif
break;
#endif
#ifdef HAS_SHM
EOPATCH
}
edit_file(
'pp_sys.c'
,
sub
{
my
$code
=
shift
;
$code
=~ s/^ struct hostent \*(?:PerlSock_)?
gethostbyaddr
\([^)]+\);$//m;
$code
=~ s/^ struct netent \
*getnetbyaddr
\([^)]+\);$//m;
return
$code
;
});
}
if
(
$major
< 5 && $^O eq
'aix'
&& !extract_from_file(
'pp_sys.c'
,
qr/defined\(HOST_NOT_FOUND\) && !defined\(h_errno\)/
)) {
apply_patch(
<<'EOPATCH')
diff --git a/pp_sys.c b/pp_sys.c
index c2fcb6f..efa39fb 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -54,7 +54,7 @@ extern "C" int syscall(unsigned long,...);
#endif
#endif
-#ifdef HOST_NOT_FOUND
+#if defined(HOST_NOT_FOUND) && !defined(h_errno)
extern int h_errno;
#endif
EOPATCH
}
if
(
$major
== 5
&& `git rev-parse HEAD` eq
"22c35a8c2392967a5ba6b5370695be464bd7012c\n"
) {
apply_commit(
'4ec43091e8e6657c'
);
}
if
(
$major
== 5
&& extract_from_file(
'pp_sys.c'
,
qr/PERL_EFF_ACCESS_R_OK/
)
&& !extract_from_file(
'pp_sys.c'
,
qr/XXX Configure test needed for eaccess/
)) {
apply_patch(
<<'EOPATCH');
diff --git a/pp_sys.c b/pp_sys.c
index d60c8dc..867dee4 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -198,9 +198,18 @@ static char zero_but_true[ZBTLEN + 1] = "0 but true";
# if defined(I_SYS_SECURITY)
# include <sys/security.h>
# endif
-# define PERL_EFF_ACCESS_R_OK(p) (eaccess((p), R_OK, ACC_SELF))
-# define PERL_EFF_ACCESS_W_OK(p) (eaccess((p), W_OK, ACC_SELF))
-# define PERL_EFF_ACCESS_X_OK(p) (eaccess((p), X_OK, ACC_SELF))
+ /* XXX Configure test needed for eaccess */
+# ifdef ACC_SELF
+ /* HP SecureWare */
+# define PERL_EFF_ACCESS_R_OK(p) (eaccess((p), R_OK, ACC_SELF))
+# define PERL_EFF_ACCESS_W_OK(p) (eaccess((p), W_OK, ACC_SELF))
+# define PERL_EFF_ACCESS_X_OK(p) (eaccess((p), X_OK, ACC_SELF))
+# else
+ /* SCO */
+# define PERL_EFF_ACCESS_R_OK(p) (eaccess((p), R_OK))
+# define PERL_EFF_ACCESS_W_OK(p) (eaccess((p), W_OK))
+# define PERL_EFF_ACCESS_X_OK(p) (eaccess((p), X_OK))
+# endif
#endif
#if !defined(PERL_EFF_ACCESS_R_OK) && defined(HAS_ACCESSX) && defined(ACC_SELF)
EOPATCH
}
if
(
$major
== 5
&& extract_from_file(
'mg.c'
,
qr/If we're still on top of the stack, pop us off/
)
&& !extract_from_file(
'mg.c'
,
qr/PL_savestack_ix -= popval/
)) {
apply_commit(
'3c8a44569607336e'
,
'mg.c'
);
}
if
(
$major
== 5) {
if
(extract_from_file(
'doop.c'
,
qr/croak\(no_modify\);/
)
&& extract_from_file(
'doop.c'
,
qr/croak\(PL_no_modify\);/
)) {
apply_commit(
'6393042b638dafd3'
);
}
if
(extract_from_file(
'pp_ctl.c'
,
qr/\Qstatic void *docatch_body _((void *o));\E/
)) {
apply_commit(
'5b51e982882955fe'
);
}
if
(extract_from_file(
'pp_ctl.c'
,
qr/\Qstatic void *docatch_body _((valist\E/
)) {
apply_commit(
'47aa779ee4c1a50e'
);
}
if
(extract_from_file(
'thrdvar.h'
,
qr/PERLVARI\(Tprotect/
)
&& !extract_from_file(
'embedvar.h'
,
qr/PL_protect/
)) {
apply_commit(
'e0284a306d2de082'
,
'embedvar.h'
);
}
}
if
(
$major
== 5
&& extract_from_file(
'sv.c'
,
qr/PerlDir_close\(IoDIRP\((?:\(IO\*\))?sv\)\);/
)
&& !(extract_from_file(
'toke.c'
,
qr/\QIoDIRP(FILTER_DATA(AvFILLp(PL_rsfp_filters))) = NULL\E/
)
|| extract_from_file(
'toke.c'
,
qr/\QIoDIRP(datasv) = (DIR*)NULL;\E/
))) {
apply_commit(
'a6c403648ecd5cc7'
,
'toke.c'
);
}
if
(
$major
< 6 && $^O eq
'netbsd'
&& !extract_from_file(
'unixish.h'
,
qr/defined\(NSIG\).*defined\(__NetBSD__\)/
)) {
apply_patch(
<<'EOPATCH')
diff --git a/unixish.h b/unixish.h
index 2a6cbcd..eab2de1 100644
--- a/unixish.h
+++ b/unixish.h
@@ -89,7 +89,7 @@
*/
/* #define ALTERNATE_SHEBANG "#!" / **/
-#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
+#if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX) || defined(__NetBSD__)
# include <signal.h>
#endif
EOPATCH
}
if
(
$major
== 7 && $^O eq
'aix'
&& -f
'ext/List/Util/Util.xs'
&& extract_from_file(
'ext/List/Util/Util.xs'
,
qr/PUSHBLOCK/
)
&& !extract_from_file(
'makedef.pl'
,
qr/^Perl_cxinc/
)) {
apply_commit(
'cbb96eed3f175499'
);
}
if
((
$major
>= 7 ||
$major
<= 9) && $^O eq
'openbsd'
&& `uname -m` eq
"sparc64\n"
&& extract_from_file(
'regexec.c'
,
qr!/\* No need to save/restore up to this paren \*/!
)
&& extract_from_file(
'regexec.c'
,
qr/^\t\tCURCUR cc;$/
)) {
apply_patch(
<<'EOPATCH');
diff --git a/regexec.c b/regexec.c
index 900b491..6251a0b 100644
--- a/regexec.c
+++ b/regexec.c
@@ -2958,7 +2958,11 @@ S_regmatch(pTHX_ regnode *prog)
I,I
*******************************************************************/
case CURLYX: {
- CURCUR cc;
+ union {
+ CURCUR hack_cc;
+ char hack_buff[sizeof(CURCUR) + 1];
+ } hack;
+#define cc hack.hack_cc
CHECKPOINT cp = PL_savestack_ix;
/* No need to save/restore up to this paren */
I32 parenfloor = scan->flags;
@@ -2983,6 +2987,7 @@ S_regmatch(pTHX_ regnode *prog)
n = regmatch(PREVOPER(next)); /* start on the WHILEM */
regcpblow(cp);
PL_regcc = cc.oldcc;
+#undef cc
saySAME(n);
}
/* NOT REACHED */
EOPATCH
}
if
(
$major
< 8 && $^O eq
'openbsd'
&& !extract_from_file(
'perl.h'
,
qr/include <unistd\.h>/
)) {
apply_patch(
<<'EOPATCH');
diff --git a/perl.h b/perl.h
index 9418b52..b8b1a7c 100644
--- a/perl.h
+++ b/perl.h
@@ -496,6 +496,10 @@ register struct op *Perl_op asm(stringify(OP_IN_REGISTER));
# include <sys/param.h>
#endif
+/* If this causes problems, set i_unistd=undef in the hint file. */
+#ifdef I_UNISTD
+# include <unistd.h>
+#endif
/* Use all the "standard" definitions? */
#if defined(STANDARD_C) && defined(I_STDLIB)
EOPATCH
}
}
sub
patch_ext {
if
(-f
'ext/POSIX/Makefile.PL'
&& extract_from_file(
'ext/POSIX/Makefile.PL'
,
qr/Explicitly avoid including/
)) {
apply_commit(
'6695a346c41138df'
);
}
if
(-f
'ext/Hash/Util/Makefile.PL'
&& extract_from_file(
'ext/Hash/Util/Makefile.PL'
,
qr/\bDIR\b.*'FieldHash'/
)) {
apply_commit(
'550428fe486b1888'
);
}
if
(
$major
< 8 && $^O eq
'darwin'
&& !-f
'ext/DynaLoader/dl_dyld.xs'
) {
checkout_file(
'ext/DynaLoader/dl_dyld.xs'
,
'f556e5b971932902'
);
apply_patch(
<<'EOPATCH');
diff -u a/ext/DynaLoader/dl_dyld.xs~ a/ext/DynaLoader/dl_dyld.xs
--- a/ext/DynaLoader/dl_dyld.xs~ 2011-10-11 21:41:27.000000000 +0100
+++ b/ext/DynaLoader/dl_dyld.xs 2011-10-11 21:42:20.000000000 +0100
@@ -41,6 +41,35 @@
#include "perl.h"
#include "XSUB.h"
+#ifndef pTHX
+# define pTHX void
+# define pTHX_
+#endif
+#ifndef aTHX
+# define aTHX
+# define aTHX_
+#endif
+#ifndef dTHX
+# define dTHXa(a) extern int Perl___notused(void)
+# define dTHX extern int Perl___notused(void)
+#endif
+
+#ifndef Perl_form_nocontext
+# define Perl_form_nocontext form
+#endif
+
+#ifndef Perl_warn_nocontext
+# define Perl_warn_nocontext warn
+#endif
+
+#ifndef PTR2IV
+# define PTR2IV(p) (IV)(p)
+#endif
+
+#ifndef get_av
+# define get_av perl_get_av
+#endif
+
#define DL_LOADONCEONLY
#include "dlutils.c" /* SaveError() etc */
@@ -185,7 +191,7 @@
CODE:
DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_load_file(%s,%x):\n", filename,flags));
if (flags & 0x01)
- Perl_warn(aTHX_ "Can't make loaded symbols global on this platform while loading %s",filename);
+ Perl_warn_nocontext("Can't make loaded symbols global on this platform while loading %s",filename);
RETVAL = dlopen(filename, mode) ;
DLDEBUG(2,PerlIO_printf(Perl_debug_log, " libref=%x\n", RETVAL));
ST(0) = sv_newmortal() ;
EOPATCH
if
(
$major
< 4 && !extract_from_file(
'util.c'
,
qr/^form/
m)) {
apply_patch(
<<'EOPATCH');
diff -u a/ext/DynaLoader/dl_dyld.xs~ a/ext/DynaLoader/dl_dyld.xs
--- a/ext/DynaLoader/dl_dyld.xs~ 2011-10-11 21:56:25.000000000 +0100
+++ b/ext/DynaLoader/dl_dyld.xs 2011-10-11 22:00:00.000000000 +0100
@@ -60,6 +60,18 @@
# define get_av perl_get_av
#endif
+static char *
+form(char *pat, ...)
+{
+ char *retval;
+ va_list args;
+ va_start(args, pat);
+ vasprintf(&retval, pat, &args);
+ va_end(args);
+ SAVEFREEPV(retval);
+ return retval;
+}
+
#define DL_LOADONCEONLY
#include "dlutils.c" /* SaveError() etc */
EOPATCH
}
}
if
(
$major
< 10) {
if
(
$unfixable_db_file
) {
}
elsif
(!extract_from_file(
'ext/DB_File/DB_File.xs'
,
qr/^#ifdef AT_LEAST_DB_4_1$/
)) {
my
$line
= extract_from_file(
'ext/DB_File/DB_File.xs'
,
qr/^( status = \(?RETVAL->dbp->open\)?\(RETVAL->dbp, name, NULL, RETVAL->type, $)/
);
apply_patch(
<<"EOPATCH");
diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs
index 489ba96..fba8ded 100644
--- a/ext/DB_File/DB_File.xs
+++ b/ext/DB_File/DB_File.xs
\@\@ -183,4 +187,8 \@\@
#endif
+#if DB_VERSION_MAJOR > 4 || (DB_VERSION_MAJOR == 4 && DB_VERSION_MINOR >= 1)
+# define AT_LEAST_DB_4_1
+#endif
+
/* map version 2 features & constants onto their version 1 equivalent */
\@\@ -1334,7 +1419,12 \@\@ SV * sv ;
#endif
+#ifdef AT_LEAST_DB_4_1
+ status = (RETVAL->dbp->open)(RETVAL->dbp, NULL, name, NULL, RETVAL->type,
+ Flags, mode) ;
+#else
$line
Flags, mode) ;
+#endif
/* printf("open returned %d %s\\n", status, db_strerror(status)) ; */
EOPATCH
}
}
if
(
$major
< 10 and -f
'ext/IPC/SysV/SysV.xs'
) {
edit_file(
'ext/IPC/SysV/SysV.xs'
,
sub
{
my
$xs
=
shift
;
my
$fixed
=
<<'EOFIX';
#include <sys/types.h>
#if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
#ifndef HAS_SEM
# include <sys/ipc.h>
#endif
# ifdef HAS_MSG
# include <sys/msg.h>
# endif
# ifdef HAS_SHM
# if defined(PERL_SCO) || defined(PERL_ISC)
# include <sys/sysmacros.h> /* SHMLBA */
# endif
# include <sys/shm.h>
# ifndef HAS_SHMAT_PROTOTYPE
extern Shmat_t shmat (int, char *, int);
# endif
# if defined(HAS_SYSCONF) && defined(_SC_PAGESIZE)
# undef SHMLBA /* not static: determined at boot time */
# define SHMLBA sysconf(_SC_PAGESIZE)
# elif defined(HAS_GETPAGESIZE)
# undef SHMLBA /* not static: determined at boot time */
# define SHMLBA getpagesize()
# endif
# endif
#endif
EOFIX
$xs
=~ s!
.*
(
return
$xs
;
});
}
if
(
$major
>= 10 &&
$major
< 20
&& !extract_from_file(
'ext/SDBM_File/Makefile.PL'
,
qr/MY::subdir_x/
)) {
apply_commit(
'4d106cc5d8fd328d'
,
'ext/SDBM_File/Makefile.PL'
);
}
}
sub
apply_fixups {
my
$fixups
=
shift
;
return
unless
$fixups
;
foreach
my
$file
(
@$fixups
) {
my
$fh
= open_or_die(
$file
);
my
$line
= <
$fh
>;
close_or_die(
$fh
);
if
(
$line
=~ /^
system
$^X,
$file
and die_255(
"$^X $file failed: \$!=$!, \$?=$?"
);
}
elsif
(
$line
=~ /^
system
$file
and die_255(
"$file failed: \$!=$!, \$?=$?"
);
}
else
{
if
(
my
(
$target
,
$action
,
$pattern
)
=
$line
=~ m
if
(
length
$pattern
) {
next
unless
-f
$target
;
if
(
$action
eq
'='
) {
next
unless
extract_from_file(
$target
,
$pattern
);
}
else
{
next
if
extract_from_file(
$target
,
$pattern
);
}
}
else
{
if
(
$action
eq
'='
) {
next
unless
-f
$target
;
}
else
{
next
if
-f
$target
;
}
}
}
system_or_die(
"patch -p1 <$file"
);
}
}
}