1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
|
package MockOutput;
use 5.010;
use strict;
use warnings;
use utf8;
use Test::MockModule 0.05;
our $MOCK = Test::MockModule->new('App::Sqitch');
my @mocked = qw(
trace
trace_literal
debug
debug_literal
info
info_literal
comment
comment_literal
emit
emit_literal
vent
vent_literal
warn
warn_literal
page
page_literal
prompt
ask_yes_no
);
my $INPUT;
sub prompt_returns { $INPUT = $_[1]; }
my $Y_N;
sub ask_yes_no_returns { $Y_N = $_[1]; }
my %CAPTURED;
__PACKAGE__->clear;
for my $meth (@mocked) {
$MOCK->mock($meth => sub {
shift;
push @{ $CAPTURED{$meth} } => [@_];
});
my $get = sub {
my $ret = $CAPTURED{$meth};
$CAPTURED{$meth} = [];
return $ret;
};
no strict 'refs';
*{"get_$meth"} = $get;
}
$MOCK->mock(prompt => sub {
shift;
push @{ $CAPTURED{prompt} } => [@_];
return $INPUT;
});
$MOCK->mock(ask_yes_no => sub {
shift;
push @{ $CAPTURED{ask_yes_no} } => [@_];
return $Y_N;
});
sub clear {
%CAPTURED = map { $_ => [] } @mocked;
}
1;
|
