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
|
#!/usr/bin/perl
use strict;
use warnings;
use Test::More;
use Tangence::Constants;
use Tangence::Registry;
use lib ".";
use t::TestObj;
use t::TestServerClient;
my $registry = Tangence::Registry->new(
tanfile => "t/TestObj.tan",
);
my $obj = $registry->construct(
"t::TestObj",
);
# generate a second object that exists but we don't tell the client about
my $obj2 = $registry->construct(
"t::TestObj",
);
my ( $server, $client ) = make_serverclient( $registry );
my $proxy = $client->rootobj;
# gutwrench into the objectproxy to make a new one with a different ID
$proxy->{id} == $obj->id or die "ARGH failed to have correct object ID in proxy";
my $proxy2 = { %$proxy, id => $obj2->id };
bless $proxy2, ref $proxy;
# $proxy2 should now not work for anything
# methods
{
my $f = $proxy2->call_method( "method", 0, "" );
like( $f->failure, qr/^Access not allowed to object with id 2/,
'unseen objects inaccessible by method' );
}
# events
{
my $f = $proxy2->subscribe_event( "event", on_fire => sub {} );
like( $f->failure, qr/^Access not allowed to object with id 2/,
'unseen objects inaccessible by event' );
}
# properties
{
my $f = $proxy2->get_property( "scalar" );
like( $f->failure, qr/^Access not allowed to object with id 2/,
'unseen objects inaccessible by property get' );
$f = $proxy2->set_property( "scalar", 123 );
like( $f->failure, qr/^Access not allowed to object with id 2/,
'unseen objects inaccessible by property set' );
$f = $proxy2->watch_property( "scalar", on_set => sub {} );
like( $f->failure, qr/^Access not allowed to object with id 2/,
'unseen objects inaccessible by property watch' );
}
# as argument to otherwise-allowed object
{
$proxy->set_property( "objset", [ $proxy ] )->get; # is allowed
my $f = $proxy->set_property( "objset", [ $proxy2 ] );
like( $f->failure, qr/^Access not allowed to object with id 2/,
'unseen objects not allowed by value' );
}
done_testing;
|
