oqapi/webgui
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Ready for 7.10.29 development.

Browse source
This commit is contained in:
Colin Kuskie 2013-03-20 21:38:23 -07:00
commit c806f99b7b
4236 changed files with 1217679 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

106
t/Fork.t Normal file
View file

@ -0,0 +1,106 @@
# vim:syntax=perl
#-------------------------------------------------------------------
# WebGUI is Copyright 2001-2009 Plain Black Corporation.
#-------------------------------------------------------------------
# Please read the legal notices (docs/legal.txt) and the license
# (docs/license.txt) that came with this distribution before using
# this software.
#------------------------------------------------------------------
# http://www.plainblack.com info@plainblack.com
#------------------------------------------------------------------
# WebGUI::Fork tests
use strict;
use warnings;
use FindBin;
use lib "$FindBin::Bin/lib";
use lib "$FindBin::Bin/../lib";
use Test::More;
use Test::Deep;
use Data::Dumper;
use JSON;
use WebGUI::Test;
use WebGUI::Session;
use WebGUI::Fork;
my $class = 'WebGUI::Fork';
my $testClass = 'WebGUI::Test::Fork';
my $pipe = $class->init();
my $session = WebGUI::Test->session;
# test simplest (non-forking) case
my $process = $class->create($session);
my $request = $process->request( $testClass, 'simple', ['data'] );
cmp_bag(
[ keys %$request ],
[qw(webguiRoot configFile sessionId id module subname data)],
'request hash has the right keys'
);
my $now = time;
$class->runRequest($request);
ok $process->isFinished, 'finished';
my $error = $process->getError;
ok( !$error, 'no errors' ) or diag " Expected nothing, got: $error\n";
$process->setWait(0);
is $process->getStatus, 'data', 'proper status';
my $started = $process->startTime;
ok( ( $started >= $now ), 'sane startTime' );
ok( ( $process->endTime >= $started ), 'sane endTime' );
$process->delete;
note "Testing error case\n";
$process = $class->create($session);
$request = $process->request( $testClass, 'error', ['error'] );
$class->runRequest($request);
ok $process->isFinished, 'finished';
is $process->getError, "error\n", 'has error code';
$process->setWait(0);
my $status = $process->getStatus;
ok( !$status, 'no discernable status' ) or diag $status;
ok( ( $process->endTime >= $started ), 'sane endTime' );
my $forkCount = 0;
my $forkAndExec = $class->can('forkAndExec');
my $replace = sub {
my $self = shift;
$forkCount++;
$self->$forkAndExec(@_);
};
{
no strict 'refs';
no warnings 'redefine';
*{ $class . '::forkAndExec' } = $replace;
}
sub backgroundTest {
note "$_[0]\n";
$process = $class->start( $session, $testClass, 'complex', ['data'] );
my $sleeping;
while ( !$process->isFinished && $sleeping++ < 10 ) {
sleep 1;
}
ok $process->isFinished, 'finished';
is $process->getStatus, 'baz', 'correct status'
or diag $process->getError . "\n";
$process->delete;
}
backgroundTest('talk to background');
is $forkCount, 0, 'we did not fork';
close $pipe;
backgroundTest('On-demand fork');
is $forkCount, 1, 'we did fork';
done_testing;
#vim:ft=perl