1 # Copyright (c) 2008-2012 Zmanda, Inc. All Rights Reserved.
3 # This program is free software; you can redistribute it and/or
4 # modify it under the terms of the GNU General Public License
5 # as published by the Free Software Foundation; either version 2
6 # of the License, or (at your option) any later version.
8 # This program is distributed in the hope that it will be useful, but
9 # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
10 # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
13 # You should have received a copy of the GNU General Public License along
14 # with this program; if not, write to the Free Software Foundation, Inc.,
15 # 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
17 # Contact information: Zmanda Inc, 465 S. Mathilda Ave., Suite 300
18 # Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
20 use Test::More tests => 25;
23 use POSIX qw(WIFEXITED WEXITSTATUS EINTR );
26 use lib "@amperldir@";
27 use Amanda::MainLoop qw( :GIOCondition make_cb define_steps step );
33 my $to = Amanda::MainLoop::timeout_source(200);
34 $to->set_callback(sub {
35 # ignore $src argument
38 Amanda::MainLoop::quit();
42 Amanda::MainLoop::run();
43 is($global, 3, "Timeout source works, calls back repeatedly (using a closure)");
49 my $to = Amanda::MainLoop::timeout_source(200);
50 $to->set_callback(sub {
54 Amanda::MainLoop::quit();
57 $to = undef; # remove the lexical reference to the source
59 Amanda::MainLoop::run();
60 is($global, 3, "Timeout source works, calls back repeatedly (no external reference to the source)");
66 my $id = Amanda::MainLoop::idle_source(5);
67 $id->set_callback(sub {
69 if (++$global >= 30) {
71 Amanda::MainLoop::quit();
75 Amanda::MainLoop::run();
76 is($global, 30, "Idle source works, calls back repeatedly");
83 # to1 is removed before it runs, so it should never
84 # execute its callback
85 my $to1 = Amanda::MainLoop::timeout_source(10);
86 $to1->set_callback(sub { ++$global; });
89 my $to2 = Amanda::MainLoop::timeout_source(300);
90 $to2->set_callback(sub { Amanda::MainLoop::quit(); });
92 Amanda::MainLoop::run();
93 is($global, 0, "A remove()d source doesn't call back");
110 my $cw = Amanda::MainLoop::child_watch_source($pid);
111 $cw->set_callback(sub {
112 my ($src, $got_pid, $got_status) = @_;
113 Amanda::MainLoop::quit();
116 if ($got_pid != $pid) {
117 diag("Got pid $got_pid, but expected $pid");
120 if (!WIFEXITED($got_status)) {
121 diag("Didn't get an 'exited' status");
124 if (WEXITSTATUS($got_status) != 9) {
125 diag("Didn't get exit status 9");
131 my $to = Amanda::MainLoop::timeout_source(3000);
132 $to->set_callback(sub {
137 Amanda::MainLoop::quit();
140 Amanda::MainLoop::run();
141 is($global, 1, "Child watch detects a dead child");
159 my $cw = Amanda::MainLoop::child_watch_source($pid);
160 $cw->set_callback(sub {
161 my ($src, $got_pid, $got_status) = @_;
162 Amanda::MainLoop::quit();
165 if ($got_pid != $pid) {
166 diag("Got pid $got_pid, but expected $pid");
169 if (!WIFEXITED($got_status)) {
170 diag("Didn't get an 'exited' status");
173 if (WEXITSTATUS($got_status) != 11) {
174 diag("Didn't get exit status 11");
180 my $to = Amanda::MainLoop::timeout_source(3000);
181 $to->set_callback(sub { $global = "timeout"; Amanda::MainLoop::quit(); });
183 Amanda::MainLoop::run();
184 is($global, "ok", "Child watch detects a dead child that dies before the callback is set");
192 my ($readinfd, $writeinfd) = POSIX::pipe();
193 my ($readoutfd, $writeoutfd) = POSIX::pipe();
201 POSIX::close($readinfd);
202 POSIX::close($writeoutfd);
204 # the read()s here are to synchronize with our parent; the
205 # results are ignored.
206 POSIX::read($readoutfd, $data, 1024);
207 POSIX::write($writeinfd, "HELLO\n", 6);
208 POSIX::read($readoutfd, $data, 1024);
209 POSIX::write($writeinfd, "WORLD\n", 6);
210 POSIX::read($readoutfd, $data, 1024);
216 POSIX::close($writeinfd);
217 POSIX::close($readoutfd);
221 my $to = Amanda::MainLoop::timeout_source(200);
223 $to->set_callback(sub {
224 push @events, "time";
225 POSIX::write($writeoutfd, "A", 1); # wake up the child
231 my $cw = Amanda::MainLoop::child_watch_source($pid);
232 $cw->set_callback(sub {
233 my ($src, $got_pid, $got_status) = @_;
235 Amanda::MainLoop::quit();
237 push @events, "died";
240 my $fd = Amanda::MainLoop::fd_source($readinfd, $G_IO_IN | $G_IO_HUP);
241 $fd->set_callback(sub {
243 if (POSIX::read($readinfd, $str, 1024) == 0) {
245 POSIX::close($readinfd);
246 POSIX::close($writeoutfd);
251 push @events, "read $str";
254 Amanda::MainLoop::run();
259 is_deeply([ @events ],
260 [ "time", "read HELLO", "time", "read WORLD", "time", "died" ],
261 "fd source works for reading from a file descriptor");
264 # see if a "looping" callback with some closure values works. This test teased
265 # out some memory corruption bugs once upon a time.
270 my ($finished_cb) = @_;
281 $to = Amanda::MainLoop::timeout_source($time);
282 $to->set_callback($cb);
285 $to = Amanda::MainLoop::timeout_source($time);
286 $to->set_callback($cb);
290 Amanda::MainLoop::quit();
292 Amanda::MainLoop::run();
293 is($completed, 1, "looping construct terminates with a callback");
296 # Make sure that a die() in a callback correctly kills the process. Such
297 # a die() skips the usual Perl handling, so an eval { } won't do -- we have
301 my ($readfd, $writefd) = POSIX::pipe();
309 # fix up the file descriptors to hook fd 2 (stderr) to
311 POSIX::close($readfd);
312 POSIX::dup2($writefd, 2);
313 POSIX::close($writefd);
315 # and now die in a callback, using an eval {} in case the
316 # exception propagates out of the MainLoop run()
317 my $src = Amanda::MainLoop::timeout_source(10);
318 $src->set_callback(sub { die("Oh, the humanity"); });
319 eval { Amanda::MainLoop::run(); };
325 POSIX::close($writefd);
327 # read from the child and wait for it to die. There's no
328 # need to use MainLoop here.
330 while (!defined(POSIX::read($readfd, $str, 1024))) {
331 # we may be interrupted by a SIGCHLD; keep going
332 next if ($! == EINTR);
333 die ("POSIX::read failed: $!");
335 POSIX::close($readfd);
338 ok($? != 33 && $? != 0, "die() in a callback exits with an error condition");
339 like($str, qr/Oh, the humanity/, "..and displays die message on stderr");
342 # test misc. management of sources. Ideally it won't crash :)
344 my $src = Amanda::MainLoop::idle_source(1);
345 $src->set_callback(sub { 1; });
346 $src->set_callback(sub { 1; });
347 $src->set_callback(sub { 1; });
348 pass("Can call set_callback a few times on the same source");
352 pass("Calling remove twice is ok");
362 ok(Amanda::MainLoop::is_running(),
363 "call_later waits until mainloop runs");
365 "call_later passes arguments correctly");
366 Amanda::MainLoop::call_later($cb2);
367 Amanda::MainLoop::quit();
374 ok(!Amanda::MainLoop::is_running(), "main loop is correctly recognized as not running");
375 Amanda::MainLoop::call_later($cb1, 7, 3);
376 Amanda::MainLoop::run();
377 ok($gothere, "call_later while already running calls immediately");
382 push @actions, "cb1 start";
383 Amanda::MainLoop::call_later($cb2, "hello");
384 push @actions, "cb1 end";
390 push @actions, "cb2 start $greeting";
391 Amanda::MainLoop::quit();
392 push @actions, "cb2 end";
395 Amanda::MainLoop::call_later($cb1);
396 Amanda::MainLoop::run();
397 is_deeply([ @actions ],
398 [ "cb1 start", "cb1 end", "cb2 start hello", "cb2 end" ],
399 "call_later doesn't call its argument immediately");
402 Amanda::MainLoop::call_later(sub { push @calls, "call1"; });
403 Amanda::MainLoop::call_later(sub { push @calls, "call2"; });
404 Amanda::MainLoop::call_later(sub { Amanda::MainLoop::quit(); });
405 Amanda::MainLoop::run();
406 is_deeply([ @calls ],
407 [ "call1", "call2" ],
408 "call_later preserves the order of its invocations");
414 # note: gettimeofday is in usec, but call_after is in msec
416 my ($start, $end) = (Amanda::Util::gettimeofday(), undef );
417 Amanda::MainLoop::call_after(100, sub {
419 is($a+$b, 10, "call_after passes arguments correctly");
420 $end = Amanda::Util::gettimeofday();
421 Amanda::MainLoop::quit();
423 Amanda::MainLoop::run();
425 ok(($end - $start)/1000 > 75,
426 "call_after makes callbacks in the correct order")
427 or diag("only " . (($end - $start)/1000) . "msec elapsed");
434 my $inpipe = IO::Pipe->new();
435 my $outpipe = IO::Pipe->new();
445 $inpipe->autoflush(1);
448 $inpipe->write("HELLO");
449 $outpipe->read($data, 1);
450 $inpipe->write("WORLD");
457 $inpipe->blocking(0);
459 $outpipe->blocking(0);
460 $outpipe->autoflush(1);
462 sub test_async_read {
463 my ($finished_cb) = @_;
465 my $steps = define_steps
466 cb_ref => \$finished_cb;
469 Amanda::MainLoop::async_read(
470 fd => $inpipe->fileno(),
472 async_read_cb => $steps->{'read_hello'});
475 step read_hello => sub {
476 my ($err, $data) = @_;
478 push @events, "read1 '$data'";
480 $outpipe->write("A"); # wake up the child
481 Amanda::MainLoop::async_read(
482 fd => $inpipe->fileno(),
484 async_read_cb => $steps->{'read_world'});
487 step read_world => sub {
488 my ($err, $data) = @_;
490 push @events, "read2 '$data'";
492 Amanda::MainLoop::async_read(
493 fd => $inpipe->fileno(),
495 async_read_cb => $steps->{'read_eof'});
498 step read_eof => sub {
499 my ($err, $data) = @_;
501 push @events, "read3 '$data'";
503 Amanda::MainLoop::quit();
507 test_async_read(sub { Amanda::MainLoop::quit(); });
508 Amanda::MainLoop::run();
511 is_deeply([ @events ],
512 [ "read1 'HELLO'", "read2 'WORLD'", "read3 ''" ],
513 "async_read works for reading from a file descriptor");
523 sub test_async_read_harder {
524 my ($finished_cb) = @_;
526 my $steps = define_steps
527 cb_ref => \$finished_cb;
535 $inpipe = IO::Pipe->new();
536 $outpipe = IO::Pipe->new();
543 $inpipe->autoflush(1);
547 $outpipe->read($data, 1);
548 last if ($data eq 'X');
550 $inpipe->write("a" x 4096);
552 $inpipe->write("GOT=$data");
562 $inpipe->blocking(0);
564 $outpipe->blocking(0);
565 $outpipe->autoflush(1);
567 # trigger two replies
568 $outpipe->write('A');
569 $outpipe->write('B');
571 # give the child time to write GOT=AGOT=B
572 Amanda::MainLoop::call_after(100, $steps->{'do_read_1'});
575 step do_read_1 => sub {
576 Amanda::MainLoop::async_read(
577 fd => $inpipe->fileno(),
578 size => 0, # 0 => all avail
579 async_read_cb => $steps->{'done_read_1'},
580 args => [ "x", "y" ]);
583 step done_read_1 => sub {
584 my ($err, $data, $x, $y) = @_;
589 is_deeply([$x, $y], ["x", "y"], "async_read's args key handled correctly");
591 $outpipe->write('C'); # should trigger a 'GOT=C' for done_read_2
593 $steps->{'do_read_2'}->();
596 step do_read_2 => sub {
597 Amanda::MainLoop::async_read(
598 fd => $inpipe->fileno(),
600 async_read_cb => $steps->{'done_read_2'});
603 step done_read_2 => sub {
604 my ($err, $data) = @_;
608 # request a 4k write and then an EOF
609 $outpipe->write('W');
610 $outpipe->write('X');
612 $steps->{'do_read_block'}->();
615 step do_read_block => sub {
616 Amanda::MainLoop::async_read(
617 fd => $inpipe->fileno(),
619 async_read_cb => $steps->{'got_block'});
622 step got_block => sub {
623 my ($err, $data) = @_;
625 push @events, "block" . length($data);
627 $steps->{'do_read_block'}->();
629 $steps->{'done_reading_blocks'}->();
633 step done_reading_blocks => sub {
634 # one more read that should make an EOF
635 Amanda::MainLoop::async_read(
636 fd => $inpipe->fileno(),
637 # omit size this time -> default of 0
638 async_read_cb => $steps->{'got_eof'});
641 step got_eof => sub {
642 my ($err, $data) = @_;
651 # note: not all operating systems (hi, Solaris) will generate
652 # an error other than EOF on reading from a file descriptor
655 test_async_read_harder(sub { Amanda::MainLoop::quit(); });
656 Amanda::MainLoop::run();
657 waitpid($pid, 0) if defined($pid);
659 is_deeply([ @events ],
660 [ "GOT=AGOT=B", "GOT=C",
661 "block1000", "block1000", "block1000", "block1000", "block96", "block0",
663 ], "more complex async_read");
669 my $inpipe = IO::Pipe->new();
670 my $outpipe = IO::Pipe->new();
674 sub test_async_write {
675 my ($finished_cb) = @_;
677 my $steps = define_steps
678 cb_ref => \$finished_cb;
688 $inpipe->autoflush(1);
692 $outpipe->sysread($data, 1024);
693 last if ($data eq "X");
694 $inpipe->write("$data");
702 $inpipe->blocking(1); # do blocking reads below, for simplicity
704 $outpipe->blocking(0);
705 $outpipe->autoflush(1);
707 Amanda::MainLoop::async_write(
708 fd => $outpipe->fileno(),
710 async_write_cb => $steps->{'wrote_fudge'});
713 step wrote_fudge => sub {
714 my ($err, $bytes) = @_;
716 push @events, "wrote $bytes";
719 $inpipe->read($buf, $bytes);
720 push @events, "read $buf";
722 $steps->{'double_write'}->();
725 step double_write => sub {
726 Amanda::MainLoop::async_write(
727 fd => $outpipe->fileno(),
729 async_write_cb => $steps->{'wrote_icecream'});
730 Amanda::MainLoop::async_write(
731 fd => $outpipe->fileno(),
733 async_write_cb => $steps->{'wrote_brownies'});
736 step wrote_icecream => sub {
737 my ($err, $bytes) = @_;
739 push @events, "wrote $bytes";
742 $inpipe->read($buf, $bytes);
743 push @events, "read $buf";
746 step wrote_brownies => sub {
747 my ($err, $bytes) = @_;
749 push @events, "wrote $bytes";
752 $inpipe->read($buf, $bytes);
753 push @events, "read $buf";
755 $steps->{'send_x'}->();
759 Amanda::MainLoop::async_write(
760 fd => $outpipe->fileno(),
762 async_write_cb => $finished_cb);
766 test_async_write(sub { Amanda::MainLoop::quit(); });
767 Amanda::MainLoop::run();
770 is_deeply([ @events ],
771 [ 'wrote 5', 'read FUDGE',
772 'wrote 8', 'read ICECREAM',
773 'wrote 8', 'read BROWNIES' ],
774 "async_write works");
784 return Amanda::MainLoop::synchronized($lock, $cb, sub {
786 push @messages, "BEG-$msg";
787 Amanda::MainLoop::call_after(10, sub {
788 push @messages, "END-$msg";
794 # add a second syncd function to demonstrate that several functions
795 # can serialize on the same lock
797 my ($msg, $fin_cb) = @_;
798 return Amanda::MainLoop::synchronized($lock, $fin_cb, sub {
800 push @messages, "BEG2-$msg";
801 Amanda::MainLoop::call_after(10, sub {
802 push @messages, "END2-$msg";
810 push @messages, "FIN-$_[0]";
811 if (--$num_running == 0) {
812 Amanda::MainLoop::quit();
816 syncd1("A", $fin_cb);
817 syncd2("B", $fin_cb);
818 syncd1("C", $fin_cb);
820 Amanda::MainLoop::run();
822 is_deeply([ @messages ],
824 "BEG-A", "END-A", "FIN-A",
825 "BEG2-B", "END2-B", "FIN-B",
826 "BEG-C", "END-C", "FIN-C",
827 ], "synchronized works");