File Coverage

blib/lib/Argon/Test.pm
Criterion Covered Total %
statement 58 59 98.3
branch n/a
condition 6 11 54.5
subroutine 14 14 100.0
pod 0 3 0.0
total 78 87 89.6


line stmt bran cond sub pod time code
1             package Argon::Test;
2             # ABSTRACT: Utilities used by Argon's tests
3             $Argon::Test::VERSION = '0.17';
4 3     3   705720 use strict;
  3         42  
  3         138  
5 3     3   24 use warnings;
  3         6  
  3         132  
6 3     3   19 use Test2::Bundle::Extended;
  3         8  
  3         33  
7 3     3   11681 use AnyEvent;
  3         29500  
  3         168  
8 3     3   1463 use AnyEvent::Impl::Perl;
  3         81994  
  3         150  
9 3     3   42 use AnyEvent::Util;
  3         7  
  3         332  
10 3     3   1507 use Argon::Channel;
  3         12  
  3         152  
11 3     3   1506 use Argon::SecureChannel;
  3         16  
  3         159  
12 3     3   33 use Const::Fast;
  3         9  
  3         27  
13              
14 3     3   309 use parent 'Exporter';
  3         9  
  3         23  
15              
16             our @EXPORT = qw(
17             ar_test
18             channel_pair
19             secure_channel_pair
20             );
21              
22             const our $DEFAULT_TIMEOUT => 30;
23             const our $KEY => 'how now brown bureaucrat';
24              
25             sub ar_test {
26 6     6 0 10902 my $name = shift;
27 6         21 my $code = pop;
28 6   66     44 my $timeout = shift || $DEFAULT_TIMEOUT;
29              
30             subtest $name => sub {
31 6     6   23418 my $cv = AnyEvent->condvar;
32 6         2479 my $guard = AnyEvent::Util::guard { $cv->send };
  6         38  
33              
34             my $timer = AnyEvent->timer(
35             after => $timeout,
36 0         0 cb => sub { $cv->croak("Failsafe timeout triggered after $timeout seconds") },
37 6         231 );
38              
39 6         390 $code->($cv);
40              
41 6         583 undef $timer;
42 6         66 };
43             }
44              
45             sub channel_pair {
46 1     1 0 29 my ($cb1, $cb2) = @_;
47 1   50     6 $cb1 ||= {};
48 1   50     6 $cb2 ||= {};
49              
50 1         7 my ($fh1, $fh2) = AnyEvent::Util::portable_socketpair;
51 1         95 AnyEvent::Util::fh_nonblocking($fh1, 1);
52 1         12 AnyEvent::Util::fh_nonblocking($fh2, 1);
53              
54 1         59 my $ch1 = Argon::Channel->new(fh => $fh1, %$cb1);
55 1         41 my $ch2 = Argon::Channel->new(fh => $fh2, %$cb2);
56              
57 1         7 return ($ch1, $ch2);
58             }
59              
60             sub secure_channel_pair {
61 3     3 0 48 my ($cb1, $cb2) = @_;
62 3   50     23 $cb1 ||= {};
63 3   50     20 $cb2 ||= {};
64              
65 3         19 my ($fh1, $fh2) = AnyEvent::Util::portable_socketpair;
66 3         234 AnyEvent::Util::fh_nonblocking($fh1, 1);
67 3         30 AnyEvent::Util::fh_nonblocking($fh2, 1);
68              
69 3         171 my $ch1 = Argon::SecureChannel->new(key => $KEY, fh => $fh1, %$cb1);
70 3         113 my $ch2 = Argon::SecureChannel->new(key => $KEY, fh => $fh2, %$cb2);
71              
72 3         30 return ($ch1, $ch2);
73             }
74              
75             1;
76              
77             __END__
78              
79             =pod
80              
81             =encoding UTF-8
82              
83             =head1 NAME
84              
85             Argon::Test - Utilities used by Argon's tests
86              
87             =head1 VERSION
88              
89             version 0.17
90              
91             =head1 AUTHOR
92              
93             Jeff Ober <sysread@fastmail.fm>
94              
95             =head1 COPYRIGHT AND LICENSE
96              
97             This software is copyright (c) 2017 by Jeff Ober.
98              
99             This is free software; you can redistribute it and/or modify it under
100             the same terms as the Perl 5 programming language system itself.
101              
102             =cut