1 # Copyright (c) 2008-2012 Zmanda, Inc. All Rights Reserved.
3 # This program is free software; you can redistribute it and/or modify it
4 # under the terms of the GNU General Public License version 2 as published
5 # by the Free Software Foundation.
7 # This program is distributed in the hope that it will be useful, but
8 # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
9 # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
12 # You should have received a copy of the GNU General Public License along
13 # with this program; if not, write to the Free Software Foundation, Inc.,
14 # 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
16 # Contact information: Zmanda Inc, 465 S. Mathilda Ave., Suite 300
17 # Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
19 use Test::More tests => 25;
22 use POSIX qw(WIFEXITED WEXITSTATUS EINTR );
25 use lib "@amperldir@";
26 use Amanda::MainLoop qw( :GIOCondition make_cb define_steps step );
32 my $to = Amanda::MainLoop::timeout_source(200);
33 $to->set_callback(sub {
34 # ignore $src argument
37 Amanda::MainLoop::quit();
41 Amanda::MainLoop::run();
42 is($global, 3, "Timeout source works, calls back repeatedly (using a closure)");
48 my $to = Amanda::MainLoop::timeout_source(200);
49 $to->set_callback(sub {
53 Amanda::MainLoop::quit();
56 $to = undef; # remove the lexical reference to the source
58 Amanda::MainLoop::run();
59 is($global, 3, "Timeout source works, calls back repeatedly (no external reference to the source)");
65 my $id = Amanda::MainLoop::idle_source(5);
66 $id->set_callback(sub {
68 if (++$global >= 30) {
70 Amanda::MainLoop::quit();
74 Amanda::MainLoop::run();
75 is($global, 30, "Idle source works, calls back repeatedly");
82 # to1 is removed before it runs, so it should never
83 # execute its callback
84 my $to1 = Amanda::MainLoop::timeout_source(10);
85 $to1->set_callback(sub { ++$global; });
88 my $to2 = Amanda::MainLoop::timeout_source(300);
89 $to2->set_callback(sub { Amanda::MainLoop::quit(); });
91 Amanda::MainLoop::run();
92 is($global, 0, "A remove()d source doesn't call back");
109 my $cw = Amanda::MainLoop::child_watch_source($pid);
110 $cw->set_callback(sub {
111 my ($src, $got_pid, $got_status) = @_;
112 Amanda::MainLoop::quit();
115 if ($got_pid != $pid) {
116 diag("Got pid $got_pid, but expected $pid");
119 if (!WIFEXITED($got_status)) {
120 diag("Didn't get an 'exited' status");
123 if (WEXITSTATUS($got_status) != 9) {
124 diag("Didn't get exit status 9");
130 my $to = Amanda::MainLoop::timeout_source(3000);
131 $to->set_callback(sub {
136 Amanda::MainLoop::quit();
139 Amanda::MainLoop::run();
140 is($global, 1, "Child watch detects a dead child");
158 my $cw = Amanda::MainLoop::child_watch_source($pid);
159 $cw->set_callback(sub {
160 my ($src, $got_pid, $got_status) = @_;
161 Amanda::MainLoop::quit();
164 if ($got_pid != $pid) {
165 diag("Got pid $got_pid, but expected $pid");
168 if (!WIFEXITED($got_status)) {
169 diag("Didn't get an 'exited' status");
172 if (WEXITSTATUS($got_status) != 11) {
173 diag("Didn't get exit status 11");
179 my $to = Amanda::MainLoop::timeout_source(3000);
180 $to->set_callback(sub { $global = "timeout"; Amanda::MainLoop::quit(); });
182 Amanda::MainLoop::run();
183 is($global, "ok", "Child watch detects a dead child that dies before the callback is set");
191 my ($readinfd, $writeinfd) = POSIX::pipe();
192 my ($readoutfd, $writeoutfd) = POSIX::pipe();
200 POSIX::close($readinfd);
201 POSIX::close($writeoutfd);
203 # the read()s here are to synchronize with our parent; the
204 # results are ignored.
205 POSIX::read($readoutfd, $data, 1024);
206 POSIX::write($writeinfd, "HELLO\n", 6);
207 POSIX::read($readoutfd, $data, 1024);
208 POSIX::write($writeinfd, "WORLD\n", 6);
209 POSIX::read($readoutfd, $data, 1024);
215 POSIX::close($writeinfd);
216 POSIX::close($readoutfd);
220 my $to = Amanda::MainLoop::timeout_source(200);
222 $to->set_callback(sub {
223 push @events, "time";
224 POSIX::write($writeoutfd, "A", 1); # wake up the child
230 my $cw = Amanda::MainLoop::child_watch_source($pid);
231 $cw->set_callback(sub {
232 my ($src, $got_pid, $got_status) = @_;
234 Amanda::MainLoop::quit();
236 push @events, "died";
239 my $fd = Amanda::MainLoop::fd_source($readinfd, $G_IO_IN | $G_IO_HUP);
240 $fd->set_callback(sub {
242 if (POSIX::read($readinfd, $str, 1024) == 0) {
244 POSIX::close($readinfd);
245 POSIX::close($writeoutfd);
250 push @events, "read $str";
253 Amanda::MainLoop::run();
258 is_deeply([ @events ],
259 [ "time", "read HELLO", "time", "read WORLD", "time", "died" ],
260 "fd source works for reading from a file descriptor");
263 # see if a "looping" callback with some closure values works. This test teased
264 # out some memory corruption bugs once upon a time.
269 my ($finished_cb) = @_;
280 $to = Amanda::MainLoop::timeout_source($time);
281 $to->set_callback($cb);
284 $to = Amanda::MainLoop::timeout_source($time);
285 $to->set_callback($cb);
289 Amanda::MainLoop::quit();
291 Amanda::MainLoop::run();
292 is($completed, 1, "looping construct terminates with a callback");
295 # Make sure that a die() in a callback correctly kills the process. Such
296 # a die() skips the usual Perl handling, so an eval { } won't do -- we have
300 my ($readfd, $writefd) = POSIX::pipe();
308 # fix up the file descriptors to hook fd 2 (stderr) to
310 POSIX::close($readfd);
311 POSIX::dup2($writefd, 2);
312 POSIX::close($writefd);
314 # and now die in a callback, using an eval {} in case the
315 # exception propagates out of the MainLoop run()
316 my $src = Amanda::MainLoop::timeout_source(10);
317 $src->set_callback(sub { die("Oh, the humanity"); });
318 eval { Amanda::MainLoop::run(); };
324 POSIX::close($writefd);
326 # read from the child and wait for it to die. There's no
327 # need to use MainLoop here.
329 while (!defined(POSIX::read($readfd, $str, 1024))) {
330 # we may be interrupted by a SIGCHLD; keep going
331 next if ($! == EINTR);
332 die ("POSIX::read failed: $!");
334 POSIX::close($readfd);
337 ok($? != 33 && $? != 0, "die() in a callback exits with an error condition");
338 like($str, qr/Oh, the humanity/, "..and displays die message on stderr");
341 # test misc. management of sources. Ideally it won't crash :)
343 my $src = Amanda::MainLoop::idle_source(1);
344 $src->set_callback(sub { 1; });
345 $src->set_callback(sub { 1; });
346 $src->set_callback(sub { 1; });
347 pass("Can call set_callback a few times on the same source");
351 pass("Calling remove twice is ok");
361 ok(Amanda::MainLoop::is_running(),
362 "call_later waits until mainloop runs");
364 "call_later passes arguments correctly");
365 Amanda::MainLoop::call_later($cb2);
366 Amanda::MainLoop::quit();
373 ok(!Amanda::MainLoop::is_running(), "main loop is correctly recognized as not running");
374 Amanda::MainLoop::call_later($cb1, 7, 3);
375 Amanda::MainLoop::run();
376 ok($gothere, "call_later while already running calls immediately");
381 push @actions, "cb1 start";
382 Amanda::MainLoop::call_later($cb2, "hello");
383 push @actions, "cb1 end";
389 push @actions, "cb2 start $greeting";
390 Amanda::MainLoop::quit();
391 push @actions, "cb2 end";
394 Amanda::MainLoop::call_later($cb1);
395 Amanda::MainLoop::run();
396 is_deeply([ @actions ],
397 [ "cb1 start", "cb1 end", "cb2 start hello", "cb2 end" ],
398 "call_later doesn't call its argument immediately");
401 Amanda::MainLoop::call_later(sub { push @calls, "call1"; });
402 Amanda::MainLoop::call_later(sub { push @calls, "call2"; });
403 Amanda::MainLoop::call_later(sub { Amanda::MainLoop::quit(); });
404 Amanda::MainLoop::run();
405 is_deeply([ @calls ],
406 [ "call1", "call2" ],
407 "call_later preserves the order of its invocations");
413 # note: gettimeofday is in usec, but call_after is in msec
415 my ($start, $end) = (Amanda::Util::gettimeofday(), undef );
416 Amanda::MainLoop::call_after(100, sub {
418 is($a+$b, 10, "call_after passes arguments correctly");
419 $end = Amanda::Util::gettimeofday();
420 Amanda::MainLoop::quit();
422 Amanda::MainLoop::run();
424 ok(($end - $start)/1000 > 75,
425 "call_after makes callbacks in the correct order")
426 or diag("only " . (($end - $start)/1000) . "msec elapsed");
433 my $inpipe = IO::Pipe->new();
434 my $outpipe = IO::Pipe->new();
444 $inpipe->autoflush(1);
447 $inpipe->write("HELLO");
448 $outpipe->read($data, 1);
449 $inpipe->write("WORLD");
456 $inpipe->blocking(0);
458 $outpipe->blocking(0);
459 $outpipe->autoflush(1);
461 sub test_async_read {
462 my ($finished_cb) = @_;
464 my $steps = define_steps
465 cb_ref => \$finished_cb;
468 Amanda::MainLoop::async_read(
469 fd => $inpipe->fileno(),
471 async_read_cb => $steps->{'read_hello'});
474 step read_hello => sub {
475 my ($err, $data) = @_;
477 push @events, "read1 '$data'";
479 $outpipe->write("A"); # wake up the child
480 Amanda::MainLoop::async_read(
481 fd => $inpipe->fileno(),
483 async_read_cb => $steps->{'read_world'});
486 step read_world => sub {
487 my ($err, $data) = @_;
489 push @events, "read2 '$data'";
491 Amanda::MainLoop::async_read(
492 fd => $inpipe->fileno(),
494 async_read_cb => $steps->{'read_eof'});
497 step read_eof => sub {
498 my ($err, $data) = @_;
500 push @events, "read3 '$data'";
502 Amanda::MainLoop::quit();
506 test_async_read(sub { Amanda::MainLoop::quit(); });
507 Amanda::MainLoop::run();
510 is_deeply([ @events ],
511 [ "read1 'HELLO'", "read2 'WORLD'", "read3 ''" ],
512 "async_read works for reading from a file descriptor");
522 sub test_async_read_harder {
523 my ($finished_cb) = @_;
525 my $steps = define_steps
526 cb_ref => \$finished_cb;
534 $inpipe = IO::Pipe->new();
535 $outpipe = IO::Pipe->new();
542 $inpipe->autoflush(1);
546 $outpipe->read($data, 1);
547 last if ($data eq 'X');
549 $inpipe->write("a" x 4096);
551 $inpipe->write("GOT=$data");
561 $inpipe->blocking(0);
563 $outpipe->blocking(0);
564 $outpipe->autoflush(1);
566 # trigger two replies
567 $outpipe->write('A');
568 $outpipe->write('B');
570 # give the child time to write GOT=AGOT=B
571 Amanda::MainLoop::call_after(100, $steps->{'do_read_1'});
574 step do_read_1 => sub {
575 Amanda::MainLoop::async_read(
576 fd => $inpipe->fileno(),
577 size => 0, # 0 => all avail
578 async_read_cb => $steps->{'done_read_1'},
579 args => [ "x", "y" ]);
582 step done_read_1 => sub {
583 my ($err, $data, $x, $y) = @_;
588 is_deeply([$x, $y], ["x", "y"], "async_read's args key handled correctly");
590 $outpipe->write('C'); # should trigger a 'GOT=C' for done_read_2
592 $steps->{'do_read_2'}->();
595 step do_read_2 => sub {
596 Amanda::MainLoop::async_read(
597 fd => $inpipe->fileno(),
599 async_read_cb => $steps->{'done_read_2'});
602 step done_read_2 => sub {
603 my ($err, $data) = @_;
607 # request a 4k write and then an EOF
608 $outpipe->write('W');
609 $outpipe->write('X');
611 $steps->{'do_read_block'}->();
614 step do_read_block => sub {
615 Amanda::MainLoop::async_read(
616 fd => $inpipe->fileno(),
618 async_read_cb => $steps->{'got_block'});
621 step got_block => sub {
622 my ($err, $data) = @_;
624 push @events, "block" . length($data);
626 $steps->{'do_read_block'}->();
628 $steps->{'done_reading_blocks'}->();
632 step done_reading_blocks => sub {
633 # one more read that should make an EOF
634 Amanda::MainLoop::async_read(
635 fd => $inpipe->fileno(),
636 # omit size this time -> default of 0
637 async_read_cb => $steps->{'got_eof'});
640 step got_eof => sub {
641 my ($err, $data) = @_;
650 # note: not all operating systems (hi, Solaris) will generate
651 # an error other than EOF on reading from a file descriptor
654 test_async_read_harder(sub { Amanda::MainLoop::quit(); });
655 Amanda::MainLoop::run();
656 waitpid($pid, 0) if defined($pid);
658 is_deeply([ @events ],
659 [ "GOT=AGOT=B", "GOT=C",
660 "block1000", "block1000", "block1000", "block1000", "block96", "block0",
662 ], "more complex async_read");
668 my $inpipe = IO::Pipe->new();
669 my $outpipe = IO::Pipe->new();
673 sub test_async_write {
674 my ($finished_cb) = @_;
676 my $steps = define_steps
677 cb_ref => \$finished_cb;
687 $inpipe->autoflush(1);
691 $outpipe->sysread($data, 1024);
692 last if ($data eq "X");
693 $inpipe->write("$data");
701 $inpipe->blocking(1); # do blocking reads below, for simplicity
703 $outpipe->blocking(0);
704 $outpipe->autoflush(1);
706 Amanda::MainLoop::async_write(
707 fd => $outpipe->fileno(),
709 async_write_cb => $steps->{'wrote_fudge'});
712 step wrote_fudge => sub {
713 my ($err, $bytes) = @_;
715 push @events, "wrote $bytes";
718 $inpipe->read($buf, $bytes);
719 push @events, "read $buf";
721 $steps->{'double_write'}->();
724 step double_write => sub {
725 Amanda::MainLoop::async_write(
726 fd => $outpipe->fileno(),
728 async_write_cb => $steps->{'wrote_icecream'});
729 Amanda::MainLoop::async_write(
730 fd => $outpipe->fileno(),
732 async_write_cb => $steps->{'wrote_brownies'});
735 step wrote_icecream => sub {
736 my ($err, $bytes) = @_;
738 push @events, "wrote $bytes";
741 $inpipe->read($buf, $bytes);
742 push @events, "read $buf";
745 step wrote_brownies => sub {
746 my ($err, $bytes) = @_;
748 push @events, "wrote $bytes";
751 $inpipe->read($buf, $bytes);
752 push @events, "read $buf";
754 $steps->{'send_x'}->();
758 Amanda::MainLoop::async_write(
759 fd => $outpipe->fileno(),
761 async_write_cb => $finished_cb);
765 test_async_write(sub { Amanda::MainLoop::quit(); });
766 Amanda::MainLoop::run();
769 is_deeply([ @events ],
770 [ 'wrote 5', 'read FUDGE',
771 'wrote 8', 'read ICECREAM',
772 'wrote 8', 'read BROWNIES' ],
773 "async_write works");
783 return Amanda::MainLoop::synchronized($lock, $cb, sub {
785 push @messages, "BEG-$msg";
786 Amanda::MainLoop::call_after(10, sub {
787 push @messages, "END-$msg";
793 # add a second syncd function to demonstrate that several functions
794 # can serialize on the same lock
796 my ($msg, $fin_cb) = @_;
797 return Amanda::MainLoop::synchronized($lock, $fin_cb, sub {
799 push @messages, "BEG2-$msg";
800 Amanda::MainLoop::call_after(10, sub {
801 push @messages, "END2-$msg";
809 push @messages, "FIN-$_[0]";
810 if (--$num_running == 0) {
811 Amanda::MainLoop::quit();
815 syncd1("A", $fin_cb);
816 syncd2("B", $fin_cb);
817 syncd1("C", $fin_cb);
819 Amanda::MainLoop::run();
821 is_deeply([ @messages ],
823 "BEG-A", "END-A", "FIN-A",
824 "BEG2-B", "END2-B", "FIN-B",
825 "BEG-C", "END-C", "FIN-C",
826 ], "synchronized works");