view release on metacpan or search on metacpan
- Bug fix: successful PL's where prereqs happen not to be satisfied
were mistakenly being marked as 'DISCARD' for the PL phase. Fixed so
that PL's that PASS will stay that way regardless of prerequisites.
(This does not prevent a later make or test failure from being
downgraded,
- Bug fix: skipfiles patterns should match case-insensitive (Cantrell);
also, documented lack of starting anchor
- Bug fix: command_timeout option would not accept zero as valid; now
zero is a valid option and disables command_timeout
- more minor boilerplate tweaks
1.10 Mon Feb 25 10:07:28 EST 2008
I hereby dub 1.10 as the "I hate Windows" release
- Bug fix (sort of): On Win32, child processes were not timing out.
Changed from Win32::Process to Win32::Job to fix that. However,
discovered that process termination on Win32 can deadlock in some
- Simplified and shortened boilerplate
- Bug fix (minor): better detection of make vs Build for progress
messages
- Test fix: skip interrupt testing on MSWin32 if Win32::Process
is not installed
1.0801 Sun Feb 10 00:27:05 EST 2008
- Test fix: adjust timeout timings in t/14_command_timeout.t to try to
avoid failures on heavily loaded machines
1.08 Sat Jan 26 18:52:45 EST 2008
- No changes from 1.07_06 (seems to pass smoke tests)
- Summary of new features since 1.06:
- Added have_tested() function to CPAN::Reporter::History
- Added 'cc_skipfile' and 'send_skipfile' advanced config options
- Added 'command_timeout' advanced config option
- Added support for PERL_CPAN_REPORTER_DIR and
PERL_CPAN_REPORTER_CONFIG environment variables
1.07_06 Fri Jan 25 11:27:28 EST 2008
- Added 'command_timeout' config to halt commands after a period of time
- Added detection of commands killed with a signal; reports are discarded
(N.B. this may change in a future version)
- Bug fix: processes timing out could still hang with child processes
(killing 'make test' still leaves the harness running); fixed by making
'make test' its own process group and killing the process group; hoping
that's portable across non-Win32; Win32 timeouts use Win32::Process and
do the right thing already
t/03_config_file.t
t/04_option_parsing.t
t/05_prompting.t
t/06_prompt_text.t
t/10_prereq_check.t
t/10_prereq_computed.t
t/10_prereq_pm.t
t/11_env_config.t
t/12_toolchain_versions.t
t/13_record_command.t
t/14_command_timeout.t
t/15_option_validation.t
t/20_report_output.t
t/30_PL_report.t
t/31_PL_report_discard.t
t/40_make_report.t
t/41_make_report_discard.t
t/50_test_report_pass.t
t/51_test_report_fail.t
t/52_test_report_unknown.t
t/53_test_report_na.t
These have been intentionally limited to items that should not cause
harmful personal information to be revealed -- it does *not* include
your entire environment. Nevertheless, please do not use CPAN::Reporter
if you are concerned about the disclosure of this information as part of
your test report.
Users wishing to review this information may choose to edit the report
prior to sending it.
BUGS
Using command_timeout on Linux may cause problems. See
<https://rt.cpan.org/Ticket/Display.html?id=62310>
Please report any bugs or feature using the CPAN Request Tracker. Bugs
can be submitted through the web interface at
<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Reporter>
When submitting a bug or request, please include a test-file or a patch
to an existing test-file that illustrates the bug or desired feature.
SEE ALSO
corpus/PL-Hang/Build.PL view on Meta::CPAN
use strict;
use Module::Build;
# just spin and be interrupted by command_timeout
sleep 30;
die "Fail, fail, fail!";
Module::Build->new(
module_name => 'Bogus::Module',
dist_author => 'David A. Golden <dagolden@cpan.org>',
create_makefile_pl => 'traditional',
)->create_build_script;
corpus/PL-Hang/Makefile.PL view on Meta::CPAN
use ExtUtils::MakeMaker;
# just spin and be interrupted by command_timeout
sleep 30;
die "Fail, fail, fail!";
WriteMakefile
(
'PL_FILES' => {},
'INSTALLDIRS' => 'site',
'NAME' => 'Bogus::Module',
'EXE_FILES' => [],
'VERSION_FROM' => 'lib/Bogus/Module.pm',
corpus/t-Hang/t/01_Bogus.t view on Meta::CPAN
# Bogus::Pass tests
use strict;
use Test::More;
plan tests => 2 ;
pass( "Passed this test" );
# just spin and be interrupted by command_timeout
my $now = time; 1 while ( time - $now < 40 );
die "!!! TIMER DIDNT TIMEOUT -- SHOULDNT BE HERE !!!";
pass( "Won't reach this test" );
lib/CPAN/Reporter.pm view on Meta::CPAN
my ($command, $timeout) = @_;
# XXX refactor this!
# Get configuration options
if ( -r CPAN::Reporter::Config::_get_config_file() ) {
my $config_obj = CPAN::Reporter::Config::_open_config_file();
my $config;
$config = CPAN::Reporter::Config::_get_config_options( $config_obj )
if $config_obj;
$timeout ||= $config->{command_timeout}; # might still be undef
}
my ($cmd, $redirect) = _split_redirect($command);
# Teeing a command loses its exit value so we must wrap the command
# and print the exit code so we can read it off of output
my $wrap_code;
if ( $timeout ) {
$wrap_code = $^O eq 'MSWin32'
? _timeout_wrapper_win32($cmd, $timeout)
lib/CPAN/Reporter.pm view on Meta::CPAN
These have been intentionally limited to items that should not cause harmful
personal information to be revealed -- it does I<not> include your entire
environment. Nevertheless, please do not use CPAN::Reporter if you are
concerned about the disclosure of this information as part of your test report.
Users wishing to review this information may choose to edit the report
prior to sending it.
=head1 BUGS
Using command_timeout on Linux may cause problems. See
L<https://rt.cpan.org/Ticket/Display.html?id=62310>
Please report any bugs or feature using the CPAN Request Tracker.
Bugs can be submitted through the web interface at
L<http://rt.cpan.org/Dist/Display.html?Queue=CPAN-Reporter>
When submitting a bug or request, please include a test-file or a patch to an
existing test-file that illustrates the bug or desired feature.
=head1 SEE ALSO
lib/CPAN/Reporter/Config.pm view on Meta::CPAN
send_skipfile => {
prompt => "What file has patterns for things that shouldn't be reported?",
default => undef,
validate => \&_validate_skipfile,
},
cc_skipfile => {
prompt => "What file has patterns for things that shouldn't CC to authors?",
default => undef,
validate => \&_validate_skipfile,
},
command_timeout => {
prompt => "If no timeout is set by CPAN, halt system commands after how many seconds?",
default => undef,
validate => \&_validate_seconds,
},
email_to => {
default => undef,
},
editor => {
default => undef,
},
lib/CPAN/Reporter/Config.pm view on Meta::CPAN
=head1 ADVANCED CONFIGURATION OPTIONS
These additional options are only necessary in special cases, for example if
the default editor cannot be found or if reports shouldn't be sent in
certain situations or for automated testing, and so on.
=over
=item *
C<<< command_timeout >>> -- if greater than zero and the CPAN config is
C<<< inactivity_timeout >>> is not set, then any commands executed by CPAN::Reporter
will be halted after this many seconds; useful for unattended smoke testing
to stop after some amount of time; generally, this should be large --
900 seconds or more -- as some distributions' tests take quite a long time to
run. On MSWin32, L<Win32::Job> is a needed and trying to kill a process may
actually deadlock in some situations -- so use at your own risk.
=item *
C<<< editor = <editor> >>> -- editor to use to edit the test report; if not set,
t/14_command_timeout.t view on Meta::CPAN
#--------------------------------------------------------------------------#
# Test planning
#--------------------------------------------------------------------------#
my @cases = (
{
label => "regular < global < delay",
program => '$now=time(); 1 while( time() - $now < 60); print qq{foo\n}; exit 0',
output => [],
timeout => 5,
command_timeout => 30,
delay => 60,
exit_code => 9,
},
{
label => "regular < delay < global",
program => '$now=time(); 1 while( time() - $now < 30); print qq{foo\n}; exit 0',
output => [],
timeout => 5,
delay => 30,
command_timeout => 60,
exit_code => 9,
},
{
label => "global < regular < delay",
program => '$now=time(); 1 while( time() - $now < 60); print qq{foo\n}; exit 0',
output => [],
command_timeout => 2,
timeout => 5,
delay => 60,
exit_code => 9,
},
{
label => "global < delay < regular",
program => '$now=time(); 1 while( time() - $now < 5); print qq{foo\n}; exit 0',
output => ["foo\n"],
command_timeout => 2,
delay => 5,
timeout => 60,
exit_code => 0,
},
{
label => "delay < regular < global",
program => '$now=time(); 1 while( time() - $now < 2); print qq{foo\n}; exit 0',
output => ["foo\n"],
delay => 2,
timeout => 30,
command_timeout => 60,
exit_code => 0,
},
{
label => "delay < global < regular",
program => '$now=time(); 1 while( time() - $now < 2); print qq{foo\n}; exit 0',
output => ["foo\n"],
delay => 2,
command_timeout => 30,
timeout => 60,
exit_code => 0,
},
{
label => "global < delay",
program => '$now=time(); 1 while( time() - $now < 30); print qq{foo\n}; exit 0',
output => [],
command_timeout => 5,
delay => 30,
exit_code => 9,
},
{
label => "delay < global",
program => '$now=time(); 1 while( time() - $now < 2); print qq{foo\n}; exit 0',
output => ["foo\n"],
delay => 2,
command_timeout => 30,
exit_code => 0,
},
);
my $tests_per_case = 4 + test_fake_config_plan();
plan tests => 1 + $tests_per_case * @cases;
#--------------------------------------------------------------------------#
# tests
#--------------------------------------------------------------------------#
require_ok( "CPAN::Reporter" );
for my $c ( @cases ) {
SKIP: {
skip "Couldn't run perl with relative path", $tests_per_case
if $c->{relative} && system("perl -e 1") == -1;
my @extra_config = $c->{command_timeout}
? ( command_timeout => $c->{command_timeout} ) : ();
test_fake_config( @extra_config );
my $fh = File::Temp->new( UNLINK => ! $ENV{PERL_CR_NO_CLEANUP} )
or die "Couldn't create a temporary file: $!\nIs your temp drive full?";
print {$fh} $c->{program}, "\n";
$fh->flush;
my ($output, $exit);
my ($stdout, $stderr);
my $start_time = time();
my $cmd = $c->{relative} ? "perl" : $perl;
t/14_command_timeout.t view on Meta::CPAN
};
};
sleep 1; # pad the run time into the next second
my $run_time = time() - $start_time;
diag $@ if $@;
my ($time_ok, $who, $diag);
if ( $c->{timeout} ) {
# (A) program delay, (B) regular timeout, (C) command timeout
# ABC, ACB, BAC, BCA, CAB, CBA
# Option 1 -- program ends before either timeout (ABC, ACB)
if ( $c->{delay} < $c->{command_timeout}
&& $c->{delay} < $c->{timeout}
) {
my ($next_t) = sort {$a <=> $b} ($c->{timeout}, $c->{command_timeout});
$time_ok = $run_time < $next_t;
$who = "no";
}
# Option 2 -- regular before program or command (BAC, BCA)
elsif ( $c->{timeout} < $c->{command_timeout}
&& $c->{timeout} < $c->{delay}
) {
my ($next_t) = sort {$a <=> $b} ($c->{delay},$c->{command_timeout});
$time_ok = $run_time < $next_t;
$who = "regular";
}
# Option 3 -- command before program or regular (CAB, CBA)
# C does nothing so are A,B in right order?
else {
# command timeout should be the default
if ( $c->{timeout} < $c->{delay} ) {
# did command timeout kill?
$time_ok = $run_time < $c->{delay};
$who = "regular"
}
else {
# did no timeout happen
$time_ok = $run_time < $c->{timeout};
$who = "no"
}
}
$diag = sprintf(
"timeout (%d) : command_timeout (%d) : ran (%d) : sleep (%d)",
$c->{timeout}, $c->{command_timeout}, $run_time, $c->{delay}
);
}
else {
# command timeout should be the default
$diag = sprintf( "timeout (%d) : ran (%d) : sleep (%d)",
$c->{command_timeout}, $run_time, $c->{delay}
);
if ( $c->{command_timeout} < $c->{delay} ) {
# did command timeout kill?
$time_ok = $run_time < $c->{delay};
$who = "command"
}
else {
# did no timeout happen
$time_ok = $run_time < $c->{command_timeout};
$who = "no"
}
}
ok( $time_ok, "$c->{label}: $who timeout") or diag $diag;
like( $stdout, "/" . quotemeta(join(q{},@{ $output || [] })) . "/",
"$c->{label}: captured stdout"
);
is_deeply( $output, $c->{output}, "$c->{label}: output as expected" )
or diag "STDOUT:\n$stdout\n\nSTDERR:\n$stderr\n";
t/15_option_validation.t view on Meta::CPAN
input => File::Spec->rel2abs("Changes"),
output => File::Spec->rel2abs("Changes"),
},
{
label => "skipfile (missing)",
option => "cc_skipfile",
input => "afdadfasdfasdf",
output => undef,
},
{
label => "command_timeout (positive)",
option => "command_timeout",
input => 10,
output => 10,
},
{
label => "command_timeout (negative)",
option => "command_timeout",
input => -10,
output => undef,
},
{
label => "command_timeout (zero)",
option => "command_timeout",
input => 0,
output => 0,
},
{
label => "command_timeout (empty)",
option => "command_timeout",
input => q{},
output => undef,
},
{
label => "command_timeout (undef)",
option => "command_timeout",
input => undef,
output => undef,
},
{
label => "command_timeout (alpha)",
option => "command_timeout",
input => "abcd",
output => undef,
},
);
plan tests => 1 + 1 * @cases;
#--------------------------------------------------------------------------#
# Begin tests
#--------------------------------------------------------------------------#
t/57_hang_interrupt.t view on Meta::CPAN
#--------------------------------------------------------------------------#
require_ok('CPAN::Reporter');
# test send_skipfile
for my $case ( @cases ) {
$case->{dist} = MockCPANDist->new(
pretty_id => $case->{pretty_id},
%mock_dist_options,
);
test_fake_config( command_timeout => 3 );
test_dispatch(
$case,
will_send => $case->{will_send},
);
}