File Coverage

blib/lib/Protocol/SPDY/Test.pm
Criterion Covered Total %
statement 36 38 94.7
branch 2 2 100.0
condition 2 4 50.0
subroutine 9 9 100.0
pod 1 1 100.0
total 50 54 92.5


line stmt bran cond sub pod time code
1             package Protocol::SPDY::Test;
2             {
3             $Protocol::SPDY::Test::VERSION = '0.999_007';
4             }
5 1     1   341 use strict;
  1         1  
  1         21  
6 1     1   2 use warnings;
  1         1  
  1         19  
7 1     1   3 use Protocol::SPDY::Constants ':all';
  1         1  
  1         122  
8 1     1   5 use Protocol::SPDY::Frame;
  1         1  
  1         16  
9 1     1   3 use Exporter qw(import);
  1         1  
  1         25  
10 1     1   4 use Test::More;
  1         1  
  1         11  
11 1     1   612 use Try::Tiny;
  1         1522  
  1         439  
12              
13             =head1 NAME
14              
15             Protocol::SPDY::Test - helper functions for testing things
16              
17             =head1 VERSION
18              
19             version 0.999_007
20              
21             =head1 SYNOPSIS
22              
23             use Protocol::SPDY::Test qw(:all);
24              
25             =head1 DESCRIPTION
26              
27             Provides a few functions that may help when trying to debug
28             implementations. Not intended for use in production code.
29              
30             =cut
31              
32             our @EXPORT_OK = qw(control_frame_ok);
33             our %EXPORT_TAGS = (
34             all => \@EXPORT_OK
35             );
36              
37             my %frame_test = (
38             SYN_STREAM => sub {
39             my $frame = shift;
40             my $spec = shift || {};
41             subtest "SYN_STREAM" => sub {
42             plan tests => 5 + keys %$spec;
43             try {
44             cmp_ok($frame->length, '>=', 10, 'length must be >= 12');
45             ok($frame->stream_id, 'have a stream identifier');
46             is($frame->stream_id, 0+$frame->stream_id, 'identifier is numeric');
47             cmp_ok($frame->priority, '>=', 0, 'priority >= 0');
48             cmp_ok($frame->priority, '<=', 3, 'priority <= 3');
49             is($frame->$_, $spec->{$_}, $_ . ' matches') for grep exists $spec->{$_}, qw(stream_id priority associated_stream_id);
50             } catch {
51             fail('Had exception during subtest: ' . $_);
52             };
53             done_testing;
54             };
55             }
56             );
57              
58             =head2 control_frame_ok
59              
60             Tests whether the given frame is valid.
61              
62             Takes the following parameters:
63              
64             =over 4
65              
66             =item * $frame - the L object to test
67              
68             =item * $spec - the spec to test against, default empty
69              
70             =item * $msg - message to display in test notes
71              
72             =back
73              
74             =cut
75              
76             sub control_frame_ok($;$$) {
77 6     6 1 11 my $frame = shift;
78 6   50     37 my $spec = shift || {};
79 6   50     28 my $msg = shift || '';
80             subtest "Frame validation - " . $msg => sub {
81             try {
82 6         341 isa_ok($frame, 'Protocol::SPDY::Frame::Control');
83 6         1692 can_ok($frame, qw(is_control is_data length type));
84 6         2272 ok($frame->is_control, 'is_control returns true');
85 6         1400 ok(!$frame->is_data, 'is_data returns false');
86 6         1536 cmp_ok($frame->length, '>=', 0, 'length is nonzero');
87 6         1422 ok(my $type = $frame->type_string, 'have a frame type');
88 6         1573 note 'type is ' . $type;
89             try {
90 2         94 $frame_test{$type}->($frame, $spec)
91             } catch {
92 0         0 fail('Had exception during subtest: ' . $_);
93 6 100       376 } if exists $frame_test{$type};
94             } catch {
95 0         0 fail('Had exception during subtest: ' . $_);
96 6     6   2679 };
97 6         1070 done_testing;
98 6         64 };
99             }
100              
101             1;
102              
103             __END__