#!/usr/bin/perl -w
sub
slow_rmtree(@) {
for
my
$tree
(
grep
-d,
@_
) {
for
( 0..9 ) {
eval
{ $@ =
''
;
local
$SIG
{__WARN__} =
sub
{
die
@_
}; rmtree
$tree
};
-d
$tree
or
last
;
$_
< 9 and
select
undef
,
undef
,
undef
, .1;
}
warn
$@
if
$@;
}
}
my
$sigint
;
if
(
defined
$Config
{sig_name}) {
my
$i
=0;
for
(
split
(
' '
,
$Config
{sig_name})) {
$sigint
=
$i
,
last
if
$_
eq
'INT'
;
++
$i
;
}
}
my
$archive
=
$Config
{perlpath};
our
$source_path
;
my
$old_cwd
;
my
$dot
;
my
$hint
;
my
$verbose
;
my
$test
;
my
$keep
;
my
$name
;
my
$perltype
;
my
$basedir
;
my
$subdir
;
my
$dotted
;
our
$makepp_path
;
BEGIN {
open
OSTDOUT,
'>&STDOUT'
or
die
$!;
open
OSTDERR,
'>&STDERR'
or
die
$!;
$old_cwd
= cwd;
if
( $0 =~ m@/@ ) {
(
$source_path
= $0) =~ s@/[^/]+$@@;
}
elsif
(
$ENV
{PATH} =~ /[;\\]/ ) {
foreach
(
split
(/;/,
$ENV
{PATH}),
'.'
) {
my
$dir
=
$_
||
'.'
;
if
( -e
"$dir\\$0"
) {
$source_path
=
$dir
;
last
;
}
}
}
else
{
foreach
(
split
(/:/,
$ENV
{PATH}),
'.'
) {
my
$dir
=
$_
||
'.'
;
if
( -x
"$dir/$0"
) {
$source_path
=
$dir
;
last
;
}
}
}
$source_path
or
die
"$0: something's wrong, can't find path to executable\n"
;
$source_path
=~ m@^/@ or
$source_path
=
"$old_cwd/$source_path"
;
$source_path
=~ s@/(?:\./)+@/@;
$source_path
=~ s@/\.$@@;
1
while
(
$source_path
=~ s@/\.(?=/|$)@@) ||
(
$source_path
=~ s@/[^/]+/\.\.(?=/|$)@@);
$makepp_path
=
$source_path
;
$makepp_path
=~ s@/([^/]+)$@/makepp@;
our
$datadir
=
substr
$makepp_path
, 0,
rindex
$makepp_path
,
'/'
;
push
@INC
,
$datadir
;
open
my
$fh
,
'<'
,
$makepp_path
;
while
( <
$fh
> ) {
if
( /^\
$datadir
= / ) {
eval
;
$INC
[-1] =
$datadir
;
last
;
}
die
"Can't locate path to makepp libraries."
if
$. == 99;
}
}
if
( $^O =~ /^MSWin/ && $] < 5.008007 ) {
my
$file
=
"$datadir/Mpp/File.pm"
;
local
$_
=
"$file.broken"
;
unless
( -f ) {
rename
$file
,
$_
;
open
my
$in
,
'<'
,
$_
;
open
my
$out
,
'>'
,
$file
;
chmod
07777 & (
stat
)[2],
$file
;
while
( <
$in
> ) {
s/\blstat\b/
stat
/g;
s/-l _/0/g;
print
$out
$_
;
}
}
}
Mpp::Text::getopts(
[
qw(b basedir)
, \
$basedir
, 1],
[
qw(d dots)
, \
$dot
],
[
qw(h hint)
, \
$hint
],
[
qw(k keep)
, \
$keep
],
[
qw(m makepp)
, \
$makepp_path
, 1],
[
qw(n name)
, \
$name
, 1],
[
qw(s subdir)
, \
$subdir
],
[
qw(t test)
, \
$test
],
[
qw(v verbose)
, \
$verbose
],
[
qr/[h?]/
,
'help'
,
undef
, 0,
sub
{
print
<<EOF; exit }] );
run_tests.pl[ options][ tests]
-b, --basedir=BASEDIR
Put tdirs into subdir of given dir, to perform tests elsewhere.
-d, --dots
Output only a dot for every successful test.
-h, --hint
For some tests explain what might be wrong, and give a general hint.
-k, --keep
Keep the tdir even if the test was successful.
-m, --makepp=PATH_TO_MAKEPP
Use that makepp, instead of the one above run_tests.pl.
-n, --name=NAME
Give this test series a name.
-s, --subdir
Put tdirs into a subdir named [BASEDIR/]perlversion[-NAME].
-t, --test
Output in format expected by Test::Harness.
-v, --verbose
Give some initial info and final statistics.
If no tests are given, runs all in the current directory.
EOF
for
(
keys
%Mpp::Cmds::
) {
if
( /^c_/ and
my
$coderef
= *{
"Mpp::Cmds::$_"
}{CODE} ) {
*{
"Mpp::$_"
} =
$coderef
;
}
}
$perltype
=
$Config
{cf_email} =~ /(Active)(?:Perl|State)/ ? $1 :
$Config
{ldflags} =~ /(vanilla|strawberry|chocolate)/i ?
ucfirst
lc
$1 :
''
;
printf
"%s%sPerl V%vd %dbits - %s %s\n"
,
$name
?
"$name "
:
''
,
$perltype
,
$^V,
$Config
{ptrsize} * 8, $^O,
$Config
{archname}
if
$verbose
;
if
(
defined
$basedir
) {
substr
$basedir
, 0, 0,
"$old_cwd/"
if
&is_windows
?
$basedir
!~ /^(?:[a-z]:)?\//i :
$basedir
!~ /^\//;
$basedir
.=
'/'
if
$basedir
!~ /\/$/
}
else
{
$basedir
=
"$old_cwd/"
;
}
if
(
$subdir
) {
$basedir
.=
sprintf
$Config
{ptrsize} == 4 ?
'V%vd'
:
'V%vd-%dbits'
, $^V,
$Config
{ptrsize} * 8;
$basedir
.=
"-$perltype"
if
$perltype
;
$basedir
.=
"-$name"
if
$name
;
slow_rmtree
$basedir
;
mkdir
$basedir
or
die
"can't mkdir $basedir--$!"
;
$basedir
.=
'/'
;
}
chdir
$basedir
;
mkdir
'd'
;
my
$symlink
= (
stat
'd'
)[1] &&
eval
{
symlink
'd'
,
'e'
} &&
(
stat
_)[1] == (
stat
'e'
)[1];
rmdir
'd'
;
unlink
'e'
or
rmdir
'e'
;
eval
'sub no_symlink() {'
. (
$symlink
?
''
: 1) .
'}'
;
open
my
$fh
,
'>f'
;
close
$fh
;
my
$link
=
eval
{
link
'f'
,
'g'
} &&
((
stat
'f'
)[1] ?
(
stat
_)[1] == (
stat
'g'
)[1] :
(
stat
_)[3] == 2 && (
stat
'g'
)[3] == 2);
unlink
'f'
,
'g'
;
eval
'sub no_link() {'
. (
$link
?
''
: 1) .
'}'
;
chdir
$old_cwd
;
}
my
$have_cc
;
sub
have_cc() {
unless
(
defined
$have_cc
) {
$have_cc
=
$ENV
{CC} ||
system
( PERL,
'-w'
,
$makepp_path
.
'builtin'
,
'expr'
,
'sub Mpp::log($@) {} sub Mpp::Makefile::implicitly_load {} close STDERR; q!not-found! eq Mpp::Subs::f_CC'
,
'-ohave_cc'
) ?
1 : 0;
}
$have_cc
;
}
$ENV
{PERL} ||= PERL;
$ENV
{
"${_}FLAGS"
} =
''
for
qw(MAKEPP MAKE MAKEPPBUILTIN MAKEPPCLEAN MAKEPPLOG MAKEPPGRAPH)
;
for
(
$ENV
{PATH} ) {
my
$sep
= is_windows > 0 ?
';'
:
':'
;
s/^\.?
$sep
+//;
s/
$sep
+\.?$//;
s/
$sep
+\.?
$sep
+/
$sep
/;
$_
=
"$source_path$sep$_"
;
}
sub
system_intabort {
my
$cmd
=
ref
(
$_
[0] ) &&
shift
;
system
@_
;
kill
'INT'
, $$
if
$sigint
&& $? ==
$sigint
;
if
( $? &&
$cmd
) {
if
( $? == -1 ) {
die
"failed to execute $$cmd: $!\n"
}
elsif
( $? & 127 ) {
die
sprintf
"$$cmd died with signal %d%s coredump\n"
,
($? & 127), ($? & 128) ?
' and'
:
', no'
;
}
else
{
die
sprintf
"$$cmd exited with value %d\n"
, $? >> 8;
}
}
return
$?;
}
my
%file
;
my
$page_break
=
''
;
my
$log_count
= 1;
sub
makepp(@) {
my
$suffix
=
''
;
$suffix
= ${
shift
()}
if
ref
$_
[0];
print
"${page_break}makepp$suffix"
. (
@_
?
" @_\n"
:
"\n"
);
$page_break
=
"\cL\n"
;
if
( !
$suffix
&& -f
'.makepp/log'
) {
chdir
'.makepp'
;
rename
log
=>
'log'
.
$log_count
++;
chdir
'..'
;
}
system_intabort \
"makepp$suffix"
,
PERL,
'-w'
,
exists
$file
{
'makeppextra.pm'
} ?
'-Mmakeppextra'
: (),
$makepp_path
.
$suffix
,
@_
;
1;
}
@ARGV
or
@ARGV
= <*.test *.tar *.tar.gz>;
my
$n_failures
= 0;
my
$n_successes
= 0;
(
my
$wts
= $0) =~ s/run_tests/wait_timestamp/;
do
$wts
;
sub
un_spar() {
my
(
$lines
,
$kind
,
$mode
,
%mode
,
$atime
,
$mtime
,
$name
,
$nl
) = (-1, 0);
while
( <DATA> ) {
s/\r?\n$//;
if
(
$lines
>= 0 ) {
print
F
$_
,
$lines
?
"\n"
:
$nl
;
}
elsif
(
$kind
eq
'L'
) {
if
(
$mode
eq
'S'
) {
symlink
$_
,
$name
;
}
else
{
link
$_
,
$name
;
}
$kind
= 0;
}
elsif
( /^
(
undef
,
$kind
,
$mode
,
$atime
,
$mtime
,
$name
) =
split
/\t/,
$_
, 6;
if
( !
$name
) {
}
elsif
(
$kind
eq
'D'
) {
$name
=~ s!/+$!!;
-d
$name
or
mkdir
$name
, 0700 or
warn
"spar: can't mkdir `$name': $!\n"
;
$mode
{
$name
} = [
$atime
,
$mtime
,
oct
$mode
];
}
elsif
(
$kind
ne
'L'
) {
open
F,
">$name"
or
warn
"spar: can't open >`$name': $!\n"
;
$lines
=
abs
$kind
;
$nl
= (
$kind
< 0) ?
''
:
"\n"
;
}
}
elsif
(
defined
$mode
) {
warn
"spar: $archive:$.: trailing garbage ignored\n"
;
}
}
continue
{
if
( !
$lines
-- ) {
close
F;
chmod
oct
(
$mode
),
$name
and
utime
$atime
,
$mtime
,
$name
or
warn
"spar: $archive:$name: Failed to set file attributes: $!\n"
;
}
}
for
(
keys
%mode
) {
chmod
pop
@{
$mode
{
$_
}},
$_
and
utime
@{
$mode
{
$_
}},
$_
or
warn
"spar: $archive:$_: Failed to set directory attributes: $!\n"
;
}
}
sub
dot($$;$) {
if
(
defined
$_
[0] ) {
if
(
$test
) {
for
(
"$_[1]"
) {
s/^passed // || s/^skipped/
print
"ok $test $_"
;
}
$test
++;
}
else
{
print
$_
[
$dot
? 0 : 1];
$dotted
= 1
if
$dot
;
}
return
;
}
elsif
(
$test
) {
print
"not ok $test $_[1]"
;
$test
++;
}
else
{
print
"\n"
if
defined
$dotted
;
print
"FAILED $_[1]"
;
undef
$dotted
;
}
if
(
$_
[2] ) {
open
my
$fh
,
'>>'
,
$_
[2];
print
$fh
"\nmakepp: run_tests.pl `FAILED' $_[1]"
;
close
$fh
;
}
}
$Mpp::Subs::rule
->{MAKEFILE}{PACKAGE} =
'Mpp'
;
sub
do_pl($) {
my
$pl
=
"$_[0].pl"
;
return
-1
unless
exists
$file
{
$pl
};
$Mpp::Subs::rule
->{MAKEFILE}{MAKEFILE} = Mpp::File::file_info
$pl
;
$Mpp::Subs::rule
->{RULE_SOURCE} =
$pl
.
':0'
;
do
$pl
;
}
sub
n_files(;$$) {
my
(
$outf
,
$code
) =
@_
;
open
my
$logfh
,
'.makepp/log'
or
die
".makepp/log--$!\n"
;
seek
$logfh
, -20, 2
if
!
$code
;
open
my
$outfh
,
'>'
,
$outf
if
$outf
;
while
( <
$logfh
> ) {
&$code
if
$code
;
if
( /^[\02\03]?N_FILES\01(\d+)\01(\d+)\01(\d+)\01$/ ) {
close
$logfh
;
my
$ret
=
"$1 $2 $3\n"
;
print
$outfh
$ret
if
$outfh
;
return
$ret
;
}
}
return
;
}
my
$have_shell
= -x
'/bin/sh'
;
print
OSTDOUT
'1..'
.
@ARGV
.
"\n"
if
$test
;
test_loop:
foreach
$archive
(
@ARGV
) {
%file
= ();
my
$testname
=
$archive
;
my
(
$tarcmd
,
$dirtest
,
$warned
,
$tdir
,
$tdir_failed
,
$log
);
$SIG
{__WARN__} =
sub
{
warn
defined
$dotted
?
"\n"
:
''
,
$warned
?
''
:
"$testname: warning: "
,
$_
[0];
undef
$dotted
if
-t STDERR;
$warned
= 1;
};
if
( -d
$archive
) {
$tdir
=
$archive
;
substr
$tdir
, 0, 0,
"$old_cwd/"
if
is_windows ?
$tdir
!~ /^(?:[a-z]:)?\// :
$tdir
!~ /^\//;
(
$log
=
$tdir
) =~ s!/*$!.
log
!;
chdir
$tdir
;
$dirtest
= 1;
}
else
{
$testname
=~ s/\..*$//;
if
( is_windows &&
$testname
=~ /_unix/ ) {
dot
w
=>
"skipped $testname on Windows\n"
;
next
;
}
if
( no_symlink &&
$testname
=~ /repository|
symlink
/ ) {
dot
s
=>
"skipped $testname because symbolic links do not work\n"
;
next
;
}
if
( no_link &&
$testname
=~ /build_cache/ ) {
dot
l
=>
"skipped $testname because links do not work\n"
;
next
;
}
if
(
$archive
!~ /^\//) {
$archive
=
"$old_cwd/$archive"
;
}
if
(
$testname
=~ /\.gz$/) {
$tarcmd
=
"gzip -dc $archive | tar xf -"
;
}
elsif
(
$testname
=~ /\.bz2$/) {
$tarcmd
=
"bzip2 -dc $archive | tar xf -"
;
}
(
$tdir
=
"$testname.tdir"
) =~ s!.*/!!;
substr
$tdir
, 0, 0,
$basedir
;
$log
=
substr
(
$tdir
, 0, -4 ) .
'log'
;
$tdir_failed
=
substr
(
$tdir
, 0, -4 ) .
'failed'
;
slow_rmtree
$tdir
,
$tdir_failed
;
mkdir
$tdir
, 0755 or
die
"$0: can't make directory $tdir--$!\n"
;
chdir
$tdir
or
die
"$0: can't cd into tdir--$!\n"
;
}
eval
{
local
$SIG
{ALRM} =
sub
{
die
"timed out\n"
};
eval
{
alarm
(
$ENV
{MAKEPP_TEST_TIMEOUT} || 600 ) };
if
(
$tarcmd
) {
system_intabort
$tarcmd
and
die
"$0: can't extract testfile $archive\n"
;
}
elsif
( !
$dirtest
) {
open
DATA,
$archive
or
die
"$0: can't open $archive--$!\n"
;
eval
{
local
$SIG
{__WARN__} =
sub
{
die
@_
if
$_
[0] !~ /Failed to set/ }; un_spar };
die
+(is_windows && $@ =~ /
symlink
.* unimplemented/) ?
"skipped s\n"
:
$@ =~ /: can't
open
>`/ ?
"skipped\n"
: $@
if
$@;
}
open
STDOUT,
'>'
,
$log
or
die
"write $log: $!"
;
open
STDERR,
'>&STDOUT'
or
die
$!;
open
my
$fh
,
'>>.makepprc'
;
close
$fh
;
@file
{<{is_relevant.pl,makepp_test_script.pl,makepp_test_script,cleanup_script.pl,makeppextra.pm,hint}*>} = ();
eval
{
die
"skipped x\n"
if
exists
$file
{makepp_test_script} && !
$have_shell
;
do_pl
'is_relevant'
or
die
"skipped r\n"
;
$page_break
=
''
;
$log_count
= 1;
if
(
exists
$file
{
'makepp_test_script.pl'
} ) {
local
%ENV
=
%ENV
;
do_pl
'makepp_test_script'
or
die
'makepp_test_script.pl '
. ($@ ?
"died: $@"
:
"returned false\n"
);
}
elsif
(
exists
$file
{
'makepp_test_script'
} ) {
system_intabort \
'makepp_test_script'
,
'./makepp_test_script'
,
$makepp_path
;
}
else
{
makepp;
}
};
open
STDOUT,
'>&OSTDOUT'
or
die
$!;
open
STDERR,
'>&OSTDERR'
or
die
$!;
die
$@
if
$@;
my
@errors
;
{
local
$/;
for
my
$name
( Mpp::Glob::zglob
'answers/**/*'
) {
next
if
$name
=~ /\/n_files$/
or -d
$name
;
open
TFILE,
'<:crlf'
,
$name
or
die
"$0: can't open $tdir/$name--$!\n"
;
$tfile_contents
= <TFILE>;
$name
=~ s!answers/!!;
open
TFILE,
'<:crlf'
,
$name
or
die
"$0: can't open $tdir/$name--$!\n"
;
my
$mtfile_contents
= <TFILE>;
$mtfile_contents
eq
$tfile_contents
or
push
@errors
,
$name
;
}
}
close
TFILE;
if
( !
defined
(
my
$n_files_updated
= n_files )) {
push
@errors
,
'.makepp/log:'
.(
stat
'.makepp/log'
)[7];
}
elsif
(
open
my
$n_files
,
'answers/n_files'
) {
$_
= <
$n_files
>;
$_
eq
$n_files_updated
or
push
@errors
,
'n_files'
;
}
rename
'.makepp/log'
=>
'.makepp/log.failed'
;
if
(
open
my
$logfile
,
$log
) {
while
( <
$logfile
> ) {
if
( /at (\S+) line \d+/ && $1 !~ /[Mm]akep
*file
$|\.mk$/ || /(?:internal|generated) error/ ) {
push
@errors
,
$log
;
last
;
}
}
}
eval
{
alarm
0 };
die
'wrong file'
. (
@errors
> 1 ?
's'
:
''
) .
': '
.
join
(
', '
,
@errors
) .
"\n"
if
@errors
;
};
if
($@) {
if
($@ =~ /skipped(?: (.))?/) {
chop
(
my
$loc
= $@ );
dot $1 ||
'-'
,
"$loc $testname\n"
;
if
( !
$dirtest
) {
do_pl
'cleanup_script'
;
chdir
$old_cwd
;
slow_rmtree
$tdir
;
}
else
{
chdir
$old_cwd
;
}
next
;
}
elsif
($@ =~ /^\S+$/) {
my
$loc
= $@;
$loc
=~ s/\n//;
dot
undef
,
"$testname (at $loc)\n"
,
$log
;
}
else
{
dot
undef
,
"$testname: $@"
,
$log
;
}
++
$n_failures
;
close
TFILE;
c_cat
'hint'
if
$hint
&&
exists
$file
{hint};
chdir
$old_cwd
;
rename
$tdir
=>
$tdir_failed
unless
$dirtest
;
last
if
$testname
eq
'aaasimple'
;
}
else
{
dot
'.'
,
"passed $testname\n"
;
$n_successes
++;
if
( !
$dirtest
) {
do_pl
'cleanup_script'
;
chdir
$old_cwd
;
slow_rmtree
$tdir
unless
$keep
;
}
else
{
chdir
$old_cwd
;
}
}
}
print
"\n"
if
defined
$dotted
;
if
(
$n_failures
&&
$hint
) {
print
"\n"
;
my
$common
=
"\nIn the $basedir directory you will find details\nin the <testname>.log files and <testname>.failed directories.\n"
;
if
(
$n_failures
>
$n_successes
) {
print
$n_successes
?
'Fairly bad failure!'
:
'Total failure!'
,
$common
;
}
else
{
print
$n_failures
>
$n_successes
/ 2 ?
'Partial failure, but many things work, so makepp might be ok for you...'
:
'Some failures, which possibly all have the same cause -- you are probably ok.'
,
$common
,
<<EOF;
If you are trying to install from a makefile you configured, you need to
touch .test_done
in case you want to ignore the above failures.
EOF
}
}
printf
"%ds real %.2fs user %.2fs system children: %.2fs user %.2fs system\n"
,
time
- $^T,
times
if
$verbose
;
close
OSTDOUT;
close
OSTDERR;
exit
$n_failures
;