File Coverage

blib/lib/Job/Async/Test/Compliance.pm
Criterion Covered Total %
statement 50 52 96.1
branch 6 12 50.0
condition 2 3 66.6
subroutine 12 12 100.0
pod 0 3 0.0
total 70 82 85.3


line stmt bran cond sub pod time code
1             package Job::Async::Test::Compliance;
2              
3 1     1   122677 use strict;
  1         13  
  1         28  
4 1     1   6 use warnings;
  1         1  
  1         42  
5              
6             our $VERSION = '0.003'; # VERSION
7              
8 1     1   418 use parent qw(IO::Async::Notifier);
  1         292  
  1         6  
9              
10             =head1 NAME
11              
12             Job::Async::Test::Compliance - verify whether a client+worker pair conform
13             to the current API.
14              
15             =head1 SYNOPSIS
16              
17             use IO::Async::Loop;
18             use Job::Async::Test::Compliance;
19             my $loop = IO::Async::Loop->new;
20             $loop->add(
21             my $compliance = Job::Async::Test::Compliance->new
22             );
23             eval {
24             print "Test result: " . $compliance->test(
25             'memory',
26             worker => { },
27             client => { },
28             )->get;
29             } or do {
30             warn "Compliance test failed: $@\n";
31             };
32              
33             =head1 DESCRIPTION
34              
35             Provides a compliance test. Might be of use when writing
36              
37             =cut
38              
39 1     1   15161 use Job::Async;
  1         4  
  1         96  
40 1     1   463 use Future::Utils qw(fmap0);
  1         2092  
  1         65  
41 1     1   443 use Log::Any qw($log);
  1         8008  
  1         5  
42              
43             sub jobman {
44 2     2 0 6 my ($self) = @_;
45 2   66     16 $self->{jobman} //= do {
46 1         10 $self->add_child(
47             my $jobman = Job::Async->new
48             );
49 1         178 $jobman
50             };
51             }
52              
53             sub test {
54 1     1 0 4728 my ($self, $type, %args) = @_;
55             my $worker = $self->jobman->worker(
56             $type => $args{worker},
57 1         7 );
58             my $client = $self->jobman->client(
59             $type => $args{client},
60 1         6 );
61 1         5 Future->needs_all(
62             $worker->start,
63             $client->start,
64             )->then($self->curry::weak::start(
65             $worker,
66             $client
67             ))
68             }
69              
70             sub start {
71 1     1 0 333 my ($self, $worker, $client) = @_;
72 1         7 my $start = Time::HiRes::time;
73 1         2 my $count = 0;
74 1         275 my @seq = (
75             [ 0, 1 => 1 ],
76             [ 1, 1 => 2 ],
77             [ 1, 0 => 1 ],
78             [ 1, 1 => 2 ],
79             [ 0, 0 => 0 ],
80             [ 10, 11 => 21 ],
81             (map [ 0, $_ => $_ ], 1..100),
82             (map [ 2, $_ => 2 + $_ ], 1..100),
83             (map [ 4, $_ => 4 + $_ ], 1..100),
84             (map [ 5, $_ => 5 + $_ ], 1..100),
85             (map [ 7, $_ => 7 + $_ ], 1..100),
86             );
87             $worker->jobs->each(sub {
88 2531     2531   57406 $_->done($_->data('first') + $_->data('second'));
89 1         49 });
90 1         170 $worker->trigger;
91             $client->submit(
92             first => 8,
93             second => 2,
94             )->then(sub {
95 1 50   1   77 return Future->fail('Unable to perform initial job') unless shift eq 10;
96              
97             (fmap0 {
98 5         628 my $concurrent = shift;
99             (fmap0 {
100 2530         140577 my ($x, $y, $expected) = @{shift()};
  2530         6041  
101 2530         4051 ++$self->{jobs};
102             $client->submit(
103             first => $x,
104             second => $y,
105             )->on_done(sub {
106 2530         112203 ++$self->{responses};
107 2530 50       8770 ++$self->{shift eq $expected ? 'success' : 'fail'};
108             })->on_fail(sub {
109 0         0 ++$self->{errors}{shift()};
110             })
111 5         287 } concurrent => $concurrent, foreach => [ @seq ])
  2530         6242  
112 1         11 } foreach => [1, 2, 4, 8, 50])
113             })->then(sub {
114 1     1   279 my $elapsed = Time::HiRes::time - $start;
115 1         24 $log->debugf("Took $elapsed sec, which would be %.2f/sec", $self->{jobs} / $elapsed);
116 1 50       8 return Future->fail('response count did not match job count') unless $self->{jobs} == $self->{responses};
117 1 50       5 return Future->fail('had failed results') if $self->{fail};
118 1 50       4 return Future->fail('had errors') if $self->{errors};
119 1 50       9 return Future->done($elapsed) if $self->{success} == $self->{responses};
120 0           return Future->fail('unexpected inconsistency');
121             })
122 1         131 }
123              
124             1;
125              
126             =head1 AUTHOR
127              
128             Tom Molesworth
129              
130             =head1 LICENSE
131              
132             Copyright Tom Molesworth 2017. Licensed under the same terms as Perl itself.
133