diff options
Diffstat (limited to 'test.pl')
-rwxr-xr-x | test.pl | 47 |
1 files changed, 36 insertions, 11 deletions
@@ -7,6 +7,14 @@ use AnyEvent; use AnyEvent::Handle; use Socket; +my $DEBUG = 0; +if($DEBUG) { + no warnings 'once'; + require Data::Dumper; + $Data::Dumper::Indent = 0; + $Data::Dumper::Terse = 1; +} + use_ok 'Tanja'; @@ -61,25 +69,30 @@ ok !Tanja::match([2], [1]); # Simple double-session test with return-path sub t_double { - my($sa, $sb) = @_; + my($sa, $sb, $link) = @_; my $a = $sa->session; my $b = $sb->session; my $done = AnyEvent->condvar; + my $msgn = 0; $a->reg(["msg"], sub { my($t, $r) = @_; + ok !$msgn++; isa_ok $r, 'Tanja::ReturnPath'; ok !$r->null; $r->reply(['b', 9]); is_deeply $t, ["msg", 'a']; $a->send(["b"]); }); + my $bn = 0; $b->reg(["b"], sub { my($t, $r) = @_; + ok !$bn++; isa_ok $r, 'Tanja::ReturnPath'; ok $r->null; is_deeply $t, ["b"]; $done->send; }); + $link && $link->(); my $n = 0; $b->send(["msg", 'a'], sub { !$n++ ? is_deeply $_[0], ['b', 9] : ok !@_; @@ -90,19 +103,31 @@ sub t_double { { # same server my $s = Tanja::Server->new; + note 'Same server'; t_double($s, $s); } -TODO: { # different servers, linked - local $TODO = 'Fundamental flaw in the protocol'; - - my $sa = Tanja::Server->new; - my $sb = Tanja::Server->new; - socketpair my $socka, my $sockb, AF_UNIX, SOCK_STREAM, PF_UNSPEC; - $sa->link(0, AnyEvent::Handle->new(fh => $socka), sub { }); - $sb->link(1, AnyEvent::Handle->new(fh => $sockb), sub { }); - # Currently hangs - #t_double($sa, $sb); +{ # different servers, linked. (With various combinations of the 'sync' flag) + for my $f (0..3) { + note "Linked servers, $f"; + my $sa = Tanja::Server->new; + my $sb = Tanja::Server->new; + t_double($sa, $sb, sub { + socketpair my $socka, my $sockb, AF_UNIX, SOCK_STREAM, PF_UNSPEC; + my $done = AnyEvent->condvar; + $done->begin; + $done->begin; + $sa->link(AnyEvent::Handle->new(fh => $socka), sync => $f&1, + on_ready => sub { $done->end }, + $DEBUG ? (on_write => sub { note 'A: ',Data::Dumper::Dumper(\@_) }) : (), + ); + $sb->link(AnyEvent::Handle->new(fh => $sockb), sync => $f&2, init => 1, + on_ready => sub { $done->end }, + $DEBUG ? (on_write => sub { note 'B: ',Data::Dumper::Dumper(\@_) }) : (), + ); + $done->recv; + }); + } } |