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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
|
#! perl
use strict;
use warnings;
use Test::More tests => 18;
use Test::MockObject;
use Scalar::Util 'weaken';
{
my $mock = Test::MockObject->new();
local $@ = '';
eval { $mock->called( 1, 'foo' ) };
is( $@, '', 'called() should not die from no array ref object' );
}
{
my $mock = Test::MockObject->new();
$mock->{_calls} = [ 1 .. 4 ];
$mock->_call( 5 );
is( @{ $mock->{_calls} }, 4,
'_call() should not autovivify extra calls on the stack' );
}
{
my $mock = Test::MockObject->new();
my $warn = '';
local $SIG{__WARN__} = sub {
$warn = shift;
};
$mock->fake_module( 'Foo', bar => sub {} );
$mock->fake_module( 'Foo', bar => sub {} );
is( $warn, '', 'fake_module() should catch redefined sub warnings' );
}
{
my ($ok, $warn, @diag) = ('') x 2;
{
local (*Test::Builder::ok, *Test::Builder::diag);
*Test::Builder::ok = sub {
$ok = $_[1];
};
*Test::Builder::diag = sub {
push @diag, $_[1];
};
my $mock = Test::MockObject->new();
$mock->{_calls} = [ [ 4, 4 ], [ 5, 5 ] ];
$mock->called_pos_ok( 2, 8 );
local $SIG{__WARN__} = sub {
$warn = shift;
};
$mock->called_pos_ok( 888, 'foo' );
}
ok( ! $ok, 'called_pos_ok() should return false if name does not match' );
like( $diag[0], qr/Got.+Expected/s, '... printing a helpful diagnostic' );
unlike( $warn, qr/uninitialized value/,
'called_pos_ok() should throw no uninitialized warnings on failure');
like( $diag[1], qr/'undef'/, '... faking it with the word in the error' );
}
{
my $mock = Test::MockObject->new();
$mock->set_true( 'foo' );
$_ = 'bar';
$mock->foo( $1 ) if /(\w+)/;
is( $mock->call_args_pos( -1, 2 ), 'bar',
'$1 should be preserved through AUTOLOAD invocation' );
}
{
my $mock = Test::MockObject->new();
$mock->fake_module( 'fakemodule' );
no strict 'refs';
ok( %{ 'fakemodule::' },
'fake_module() should create a symbol table entry for the module' );
}
# respect list context at the end of a series
{
my $mock = Test::MockObject->new();
$mock->set_series( count => 2, 3 );
my $i;
while (my ($count) = $mock->count())
{
$i++;
last if $i > 2;
}
is( $i, 2, 'set_series() should return false at the end of a series' );
}
# Jay Bonci discovered false positives in called_ok() in 0.11
{
local *Test::Builder::ok;
*Test::Builder::ok = sub {
$_[1];
};
my $new_mock = Test::MockObject->new();
my $result = $new_mock->called_ok( 'foo' );
is( $result, 0, 'called_ok() should not report false positives' );
}
package Override;
my $id = 'default';
use base 'Test::MockObject';
use overload '""' => sub { return $id };
package main;
my $o = Override->new();
$o->set_always( foo => 'foo' );
is( "$o", 'default', 'default overloadings should work' );
$id = 'my id';
is( "$o", 'my id', '... and not be static' );
is( $o->foo(), 'foo', '... but should not interfere with method finding' );
# no overload '""';
# David Pisoni found memory leak condition
{
# Setup MOs with 2 references
my ($obj1, $obj2, $obj1prime, $obj2prime);
$obj1 = $obj1prime = Test::MockObject->new();
$obj2 = $obj2prime = Test::MockObject->new();
# Weaken one of the references each
weaken $obj1prime;
weaken $obj2prime;
# test for memory leak condition
$obj1->set_true('this');
$obj1->this($obj2);
undef $obj2;
is( ref($obj2prime), 'Test::MockObject',
'MO cached by another MO log should not be garbage collected' );
undef $obj1;
ok( !ref($obj2prime), '... but should go away when caching MO does' );
ok( !ref($obj1prime),
'... and the caching MO better go away too!' );
}
# Mutant reported RT #21049 - lack of new() in fake_module() may be a problem
{
my $mock = Test::MockObject->new();
local $@;
$INC{'Some/Module.pm'} = 1;
eval { $mock->fake_module( 'Some::Module' ) };
like( $@, qr/No mocked subs for loaded module 'Some::Module'/,
'fake_module() should throw exception for loaded module without mocks');
}
# Adam Kennedy reported RT #19448 - typo in check_class_loaded()
{
my $mock = Test::MockObject->new();
package Foo::Bar;
sub foo {}
package main;
ok( $mock->check_class_loaded( 'Foo::Bar' ),
'check_class_loaded() should work for nested class names' );
}
|
