File Coverage

lib/Test/Expect.pm
Criterion Covered Total %
statement 50 54 92.5
branch 4 6 66.6
condition n/a
subroutine 17 17 100.0
pod 7 9 77.7
total 78 86 90.7


line stmt bran cond sub pod time code
1             package Test::Expect;
2 1     1   1235 use strict;
  1         2  
  1         21  
3 1     1   3 use warnings;
  1         1  
  1         20  
4 1     1   415 use Class::Accessor::Chained::Fast;
  1         2615  
  1         7  
5 1     1   424 use Expect::Simple;
  1         31333  
  1         30  
6 1     1   12 use Exporter;
  1         2  
  1         35  
7 1     1   833 use Test::Builder;
  1         8092  
  1         34  
8 1     1   8 use base qw(Class::Accessor::Chained::Fast Exporter);
  1         1  
  1         495  
9             __PACKAGE__->mk_accessors(qw(program));
10             our $VERSION = "0.34";
11             our @EXPORT = qw(
12             expect_run
13             expect_handle
14             expect_is
15             expect_like
16             expect_send
17             expect_quit
18             expect
19             END
20             );
21              
22             my $Test = Test::Builder->new;
23              
24             my $expect;
25             my $sent;
26              
27             sub import {
28 1     1   5 my $self = shift;
29 1 50       3 if (@_) {
30 0         0 die @_;
31 0         0 my $package = caller;
32 0         0 $Test->exported_to($package);
33 0         0 $Test->plan(@_);
34             }
35 1         5 $Test->no_ending(0);
36 1         318 $self->export_to_level( 1, $self, $_ ) foreach @EXPORT;
37             }
38              
39             sub expect_run {
40 2     2 1 1255 my (%conf) = @_;
41 2         16 local $ENV{PERL_RL} = "Stub o=0";
42             $expect = Expect::Simple->new(
43             { Cmd => $conf{command},
44             Prompt => $conf{prompt},
45             DisconnectCmd => $conf{quit},
46 2         26 Verbose => 0,
47             Debug => 0,
48             Timeout => 100
49             }
50             );
51 2 50       19921 die $expect->error if $expect->error;
52 2         964 $Test->ok( 1, "expect_run" );
53             }
54              
55 2     2 1 909 sub expect_handle { return $expect->expect_handle(); }
56              
57             sub before {
58 8     8 0 20 my $before = $expect->before;
59 8         193 $before =~ s/\r//g;
60 8 100       48 $before =~ s/^\Q$sent\E// if $sent;
61 8         11 $before =~ s/^\n+//;
62 8         16 $before =~ s/\n+$//;
63 8         30 return $before;
64             }
65              
66             sub expect_like {
67 2     2 1 586 my ( $like, $comment ) = @_;
68 2         8 $Test->like( before(), $like, $comment );
69             }
70              
71             sub expect_is {
72 6     6 1 1054 my ( $is, $comment ) = @_;
73 6         10 $Test->is_eq( before(), $is, $comment );
74             }
75              
76             sub expect_send {
77 4     4 1 679 my ( $send, $comment ) = @_;
78 4         22 $expect->send($send);
79 4         1072 $sent = $send;
80 4         14 $Test->ok( 1, $comment );
81             }
82              
83             sub expect {
84 2     2 1 515 my ( $send, $is, $label ) = @_;
85 2         5 expect_send( $send, $label );
86 2         384 expect_is( $is, $label );
87             }
88              
89             sub expect_quit {
90 1     1 1 5 undef $expect;
91             }
92              
93             sub END {
94 1     1 0 219 expect_quit;
95             }
96              
97             1;
98              
99             __END__