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
|
#!/usr/bin/perl -w
use strict;
use warnings;
use Scalar::Util qw/refaddr/;
{
package TestModule;
use Moose;
}
{
package TestComponent;
use Moose;
with "Catalyst::Component::InstancePerContext";
sub build_per_context_instance {
return TestModule->new;
}
}
{
package MyMockContext;
use Moose;
has stash => (isa => 'HashRef', is => 'ro', required => 1, default => sub{{}});
}
use Test::More tests => 7;
my $ctx1 = MyMockContext->new;
isa_ok($ctx1, 'MyMockContext');
my $component = TestComponent->new;
isa_ok($component, 'TestComponent');
can_ok($component, 'ACCEPT_CONTEXT', 'build_per_context_instance');
my $instance = TestComponent->ACCEPT_CONTEXT($ctx1);
is(refaddr( TestComponent->ACCEPT_CONTEXT($ctx1) ), refaddr $instance,
'does not create second instance');
is(refaddr $ctx1->stash->{"__InstancePerContext_TestComponent"}, refaddr $instance,
'Correct key storage');
my $instance2 = $component->ACCEPT_CONTEXT($ctx1);
my $addr = refaddr $component;
is(refaddr $component->ACCEPT_CONTEXT($ctx1), refaddr $instance2,
'does not create second instance');
is(refaddr $ctx1->stash->{"__InstancePerContext_${addr}"}, refaddr $instance2,
'Correct key storage');
|
