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   1110 use strict;
  1         1  
  1         23  
3 1     1   3 use warnings;
  1         1  
  1         16  
4 1     1   351 use Class::Accessor::Chained::Fast;
  1         2427  
  1         6  
5 1     1   381 use Expect::Simple;
  1         28199  
  1         27  
6 1     1   10 use Exporter;
  1         1  
  1         28  
7 1     1   698 use Test::Builder;
  1         7299  
  1         29  
8 1     1   8 use base qw(Class::Accessor::Chained::Fast Exporter);
  1         1  
  1         527  
9             __PACKAGE__->mk_accessors(qw(program));
10             our $VERSION = "0.33";
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   4 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         3 $Test->no_ending(0);
36 1         317 $self->export_to_level( 1, $self, $_ ) foreach @EXPORT;
37             }
38              
39             sub expect_run {
40 2     2 1 1074 my (%conf) = @_;
41 2         13 local $ENV{PERL_RL} = "Stub o=0";
42 2         26 $expect = Expect::Simple->new(
43             { Cmd => $conf{command},
44             Prompt => $conf{prompt},
45             DisconnectCmd => $conf{quit},
46             Verbose => 0,
47             Debug => 0,
48             Timeout => 100
49             }
50             );
51 2 50       20753 die $expect->error if $expect->error;
52 2         854 $Test->ok( 1, "expect_run" );
53             }
54              
55 2     2 1 706 sub expect_handle { return $expect->expect_handle(); }
56              
57             sub before {
58 6     6 0 18 my $before = $expect->before;
59 6         146 $before =~ s/\r//g;
60 6 100       30 $before =~ s/^\Q$sent\E// if $sent;
61 6         8 $before =~ s/^\n+//;
62 6         14 $before =~ s/\n+$//;
63 6         25 return $before;
64             }
65              
66             sub expect_like {
67 2     2 1 513 my ( $like, $comment ) = @_;
68 2         8 $Test->like( before(), $like, $comment );
69             }
70              
71             sub expect_is {
72 4     4 1 630 my ( $is, $comment ) = @_;
73 4         8 $Test->is_eq( before(), $is, $comment );
74             }
75              
76             sub expect_send {
77 4     4 1 548 my ( $send, $comment ) = @_;
78 4         17 $expect->send($send);
79 4         962 $sent = $send;
80 4         13 $Test->ok( 1, $comment );
81             }
82              
83             sub expect {
84 2     2 1 355 my ( $send, $is, $label ) = @_;
85 2         4 expect_send( $send, $label );
86 2         358 expect_is( $is, $label );
87             }
88              
89             sub expect_quit {
90 1     1 1 6 undef $expect;
91             }
92              
93             sub END {
94 1     1 0 243 expect_quit;
95             }
96              
97             1;
98              
99             __END__