#! /usr/bin/env perl
BEGIN {
if
(
$ENV
{PERL_CORE}) {
unshift
@INC
, (
't'
,
'../../lib'
);
}
else
{
unshift
@INC
,
't'
;
}
}
sub
faster { (
$_
[1] -
$_
[0]) < 0.05 }
sub
diagv {
diag
@_
if
$ENV
{TEST_VERBOSE};
}
sub
todofaster {
my
(
$t1
,
$t2
,
$cmt
) =
@_
;
if
(faster(
$t1
,
$t2
)) {
ok(1,
$cmt
);
}
else
{
TODO: {
local
$TODO
=
" (unreliable timings with parallel testing)"
;
ok(0,
$cmt
);
}
}
}
my
$X
= $^X =~ m/\s/ ?
qq{"$^X"}
: $^X;
my
$Mblib
= Mblib();
my
$perldoc
= File::Spec->catfile(
$Config
{installbin},
'perldoc'
);
if
(
$ENV
{PERL_CORE}) {
$perldoc
= File::Spec->catfile(
'..'
,
'..'
,
'utils'
, (
$Config
{usecperl} ?
'cperldoc'
:
'perldoc'
));
$X
.=
' -I../../pod'
;
}
my
$perlcc
=
"$X $Mblib script/perlcc"
;
$perlcc
.=
" -Wb=-fno-fold,-fno-warnings"
if
$] > 5.013;
$perlcc
.=
" -UB -uFile::Spec -uCwd"
;
$perlcc
.=
" -uPod::Perldoc::ToText"
if
$] >= 5.023004;
$perlcc
.=
" -uExporter"
if
$] < 5.010;
my
$has_flto
=
$Config
{ccflags} =~ /-flto/ ? 1 : 0;
plan
skip_all
=>
"$perldoc not found"
unless
-f
$perldoc
;
plan
skip_all
=>
"MSVC"
if
($^O eq
'MSWin32'
and
$Config
{cc} eq
'cl'
);
plan
skip_all
=>
"mingw"
if
($^O eq
'MSWin32'
and
$Config
{cc} eq
'gcc'
);
plan
skip_all
=>
"-flto too slow"
if
$ENV
{PERL_CORE} and
$has_flto
;
plan
tests
=> 7;
$perlcc
.=
" --Wc=-O1"
if
$has_flto
;
my
$exe
=
$Config
{exe_ext};
my
$perldocexe
= $^O eq
'MSWin32'
?
"perldoc$exe"
:
"./perldoc$exe"
;
my
$strip_banner
= 0;
sub
strip_banner($) {
my
$s
=
shift
;
$s
=~ s/^.* User Contributed Perl Documentation (.*?)$//m;
$s
=~ s/^perl v.*$//m;
return
$s
;
}
my
(
$compile
,
$res
,
$result
,
$ori
,
$out
,
$err
,
$t0
,
$t1
,
$t2
);
$compile
=
"$perlcc -o $perldocexe $perldoc"
;
diagv
$compile
;
$res
= `
$compile
`;
ok(-s
$perldocexe
,
"$perldocexe compiled"
);
diagv
"see if $perldoc -T works"
;
my
$T_opt
=
"-T -f wait"
;
my
$PAGER
=
''
;
$t0
= [gettimeofday];
if
($^O eq
'MSWin32'
) {
$T_opt
=
"-t -f wait"
;
$PAGER
=
"PERLDOC_PAGER=type "
;
(
$result
,
$ori
,
$err
) = run_cmd(
"$PAGER$X -S $perldoc $T_opt"
, 20);
}
else
{
(
$result
,
$ori
,
$err
) = run_cmd(
"$X -S $perldoc $T_opt"
, 20);
}
$t1
= tv_interval(
$t0
);
if
(
$ori
=~ /Unknown option/) {
$T_opt
=
"-t -f wait"
;
$PAGER
=
"PERLDOC_PAGER=cat "
if
$^O ne
'MSWin32'
;
diagv
"No, use $PAGER instead"
;
$t0
= [gettimeofday];
(
$result
,
$ori
,
$err
) = run_cmd(
"$PAGER$X -S $perldoc $T_opt"
, 20);
$t1
= tv_interval(
$t0
);
}
else
{
diagv
"it does"
;
}
if
(
$ori
=~ / User Contributed Perl Documentation /) {
$strip_banner
++;
$ori
= strip_banner
$ori
;
}
$t0
= [gettimeofday];
(
$result
,
$out
,
$err
) = run_cmd(
"$PAGER $perldocexe $T_opt"
, 20);
$t2
= tv_interval(
$t0
);
$ori
=~ s{ /\S
*perldoc
}{ perldoc };
$out
=~ s{ ./perldoc }{ perldoc };
$out
= strip_banner
$out
if
$strip_banner
;
if
($] > 5.023 and
$out
ne
$ori
) {
ok(1,
"TODO 5.24 Pod::Simple"
);
}
else
{
is(
$out
,
$ori
,
"same result"
);
}
SKIP: {
skip
"cannot compare times"
, 1
if
$out
ne
$ori
;
todofaster(
$t1
,
$t2
,
"compiled faster than uncompiled: $t2 < $t1"
);
}
unlink
$perldocexe
if
-e
$perldocexe
;
$perldocexe
= $^O eq
'MSWin32'
?
"perldoc_O3$exe"
:
"./perldoc_O3$exe"
;
$compile
=
"$perlcc -O3 -o $perldocexe $perldoc"
;
diagv
$compile
;
$res
= `
$compile
`;
ok(-s
$perldocexe
,
"perldoc compiled"
);
unlink
"perldoc.c"
if
$] < 5.10;
diagv
$res
unless
-s
$perldocexe
;
$t0
= [gettimeofday];
(
$result
,
$out
,
$err
) = run_cmd(
"$PAGER $perldocexe $T_opt"
, 20);
my
$t3
= tv_interval(
$t0
);
$out
=~ s{ ./perldoc_O3 }{ perldoc };
$out
= strip_banner
$out
if
$strip_banner
;
if
($] > 5.023 and
$out
ne
$ori
) {
ok(1,
"TODO 5.24 Pod::Simple"
);
}
else
{
is(
$out
,
$ori
,
"same result"
);
}
SKIP: {
skip
"cannot compare times"
, 2
if
$out
ne
$ori
;
todofaster(
$t2
,
$t3
,
"compiled -O3 not slower than -O0: $t3 <= $t2"
);
todofaster(
$t1
,
$t3
,
"compiled -O3 faster than uncompiled: $t3 < $t1"
);
}
END {
unlink
$perldocexe
if
-e
$perldocexe
;
}