#!/usr/bin/perl use strict; use warnings; use Test::More; 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'; # Simple matching tests. # (Doesn't test a whole lot, since the semantics aren't final yet anyway). ok Tanja::match([], []); ok Tanja::match([], [1, 2, 3]); ok Tanja::match([], [undef]); ok !Tanja::match([undef], []); ok Tanja::match([undef], [1]); ok Tanja::match([1], [1]); ok Tanja::match([1], [1, "b"]); ok Tanja::match([1], [undef, 3]); ok !Tanja::match([2], [1]); # Simple single-session test { my $serv = Tanja::Server->new; isa_ok $serv, 'Tanja::Server'; my $ses = $serv->session; isa_ok $ses, 'Tanja::Session'; my $done = AnyEvent->condvar; my $n = 0; my $n2 = 0; $ses->reg([], sub { my($t, $r) = @_; isa_ok $r, 'Tanja::ReturnPath'; ok $r->null; is_deeply $t, [$n]; ok $n <= 5; if(++$n == 5) { $ses->close; $done->send; } }); $ses->reg_once([undef], sub { my($t, $r) = @_; isa_ok $r, 'Tanja::ReturnPath'; ok $r->null; is_deeply $t, [0]; $n2++; }); $ses->send([$_]) for (0..10); is $n, 0; # Make sure that ->send() doesn't run the callbacks. The event system should. is $n2, 0; $done->recv; is $n, 5; is $n2, 1; } # Simple double-session test with return-path sub t_double { 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 !@_; }); $done->recv; is $n, 2; } { # same server my $s = Tanja::Server->new; note 'Same server'; t_double($s, $s); } { # 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; }); } } done_testing(); # vim:noet:sw=4:ts=4