1 # Copyright (c) 2005-2008 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 Mathlida Ave, Suite 300
17 # Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
19 use Test::More tests => 17;
22 use POSIX qw(WIFEXITED WEXITSTATUS EINTR);
24 use lib "@amperldir@";
25 use Amanda::MainLoop qw( :GIOCondition );
30 my $to = Amanda::MainLoop::timeout_source(200);
31 $to->set_callback(sub {
32 # ignore $src argument
35 Amanda::MainLoop::quit();
39 Amanda::MainLoop::run();
40 is($global, 3, "Timeout source works, calls back repeatedly (using a closure)");
46 my $to = Amanda::MainLoop::timeout_source(200);
47 $to->set_callback(sub {
51 Amanda::MainLoop::quit();
54 $to = undef; # remove the lexical reference to the source
56 Amanda::MainLoop::run();
57 is($global, 3, "Timeout source works, calls back repeatedly (no external reference to the source)");
63 my $id = Amanda::MainLoop::idle_source(5);
64 $id->set_callback(sub {
66 if (++$global >= 30) {
68 Amanda::MainLoop::quit();
72 Amanda::MainLoop::run();
73 is($global, 30, "Idle source works, calls back repeatedly");
80 # to1 is removed before it runs, so it should never
81 # execute its callback
82 my $to1 = Amanda::MainLoop::timeout_source(10);
83 $to1->set_callback(sub { ++$global; });
86 my $to2 = Amanda::MainLoop::timeout_source(300);
87 $to2->set_callback(sub { Amanda::MainLoop::quit(); });
89 Amanda::MainLoop::run();
90 is($global, 0, "A remove()d source doesn't call back");
107 my $cw = Amanda::MainLoop::child_watch_source($pid);
108 $cw->set_callback(sub {
109 my ($src, $got_pid, $got_status) = @_;
110 Amanda::MainLoop::quit();
113 if ($got_pid != $pid) {
114 diag("Got pid $got_pid, but expected $pid");
117 if (!WIFEXITED($got_status)) {
118 diag("Didn't get an 'exited' status");
121 if (WEXITSTATUS($got_status) != 9) {
122 diag("Didn't get exit status 9");
128 my $to = Amanda::MainLoop::timeout_source(3000);
129 $to->set_callback(sub {
134 Amanda::MainLoop::quit();
137 Amanda::MainLoop::run();
138 is($global, 1, "Child watch detects a dead child");
156 my $cw = Amanda::MainLoop::child_watch_source($pid);
157 $cw->set_callback(sub {
158 my ($src, $got_pid, $got_status) = @_;
159 Amanda::MainLoop::quit();
162 if ($got_pid != $pid) {
163 diag("Got pid $got_pid, but expected $pid");
166 if (!WIFEXITED($got_status)) {
167 diag("Didn't get an 'exited' status");
170 if (WEXITSTATUS($got_status) != 11) {
171 diag("Didn't get exit status 11");
177 my $to = Amanda::MainLoop::timeout_source(3000);
178 $to->set_callback(sub { $global = 7; Amanda::MainLoop::quit(); });
180 Amanda::MainLoop::run();
181 is($global, 1, "Child watch detects a dead child that dies before the callback is set");
189 my ($readinfd, $writeinfd) = POSIX::pipe();
190 my ($readoutfd, $writeoutfd) = POSIX::pipe();
198 POSIX::close($readinfd);
199 POSIX::close($writeoutfd);
201 # the read()s here are to synchronize with our parent; the
202 # results are ignored.
203 POSIX::read($readoutfd, $data, 1024);
204 POSIX::write($writeinfd, "HELLO\n", 6);
205 POSIX::read($readoutfd, $data, 1024);
206 POSIX::write($writeinfd, "WORLD\n", 6);
207 POSIX::read($readoutfd, $data, 1024);
213 POSIX::close($writeinfd);
214 POSIX::close($readoutfd);
218 my $to = Amanda::MainLoop::timeout_source(200);
220 $to->set_callback(sub {
221 push @events, "time";
222 POSIX::write($writeoutfd, "A", 1); # wake up the child
228 my $cw = Amanda::MainLoop::child_watch_source($pid);
229 $cw->set_callback(sub {
230 my ($src, $got_pid, $got_status) = @_;
232 Amanda::MainLoop::quit();
234 push @events, "died";
237 my $fd = Amanda::MainLoop::fd_source($readinfd, $G_IO_IN | $G_IO_HUP);
238 $fd->set_callback(sub {
240 if (POSIX::read($readinfd, $str, 1024) == 0) {
242 POSIX::close($readinfd);
243 POSIX::close($writeoutfd);
248 push @events, "read $str";
251 Amanda::MainLoop::run();
256 is_deeply([ @events ],
257 [ "time", "read HELLO", "time", "read WORLD", "time", "died" ],
258 "fd source works for reading from a file descriptor");
261 # see if a "looping" callback with some closure values works. This test teased
262 # out some memory corruption bugs once upon a time.
267 my ($finished_cb) = @_;
278 $to = Amanda::MainLoop::timeout_source($time);
279 $to->set_callback($cb);
282 $to = Amanda::MainLoop::timeout_source($time);
283 $to->set_callback($cb);
287 Amanda::MainLoop::quit();
289 Amanda::MainLoop::run();
290 is($completed, 1, "looping construct terminates with a callback");
293 # Make sure that a die() in a callback correctly kills the process. Such
294 # a die() skips the usual Perl handling, so an eval { } won't do -- we have
298 my ($readfd, $writefd) = POSIX::pipe();
306 # fix up the file descriptors to hook fd 2 (stderr) to
308 POSIX::close($readfd);
309 POSIX::dup2($writefd, 2);
310 POSIX::close($writefd);
312 # and now die in a callback, using an eval {} in case the
313 # exception propagates out of the MainLoop run()
314 my $src = Amanda::MainLoop::timeout_source(10);
315 $src->set_callback(sub { die("Oh, the humanity"); });
316 eval { Amanda::MainLoop::run(); };
322 POSIX::close($writefd);
324 # read from the child and wait for it to die. There's no
325 # need to use MainLoop here.
327 while (!defined(POSIX::read($readfd, $str, 1024))) {
328 # we may be interrupted by a SIGCHLD; keep going
329 next if ($! == EINTR);
330 die ("POSIX::read failed: $!");
332 POSIX::close($readfd);
335 ok($? != 33 && $? != 0, "die() in a callback exits with an error condition");
336 like($str, qr/Oh, the humanity/, "..and displays die message on stderr");
339 # test misc. management of sources. Ideally it won't crash :)
341 my $src = Amanda::MainLoop::idle_source(1);
342 $src->set_callback(sub { 1; });
343 $src->set_callback(sub { 1; });
344 $src->set_callback(sub { 1; });
345 pass("Can call set_callback a few times on the same source");
349 pass("Calling remove twice is ok");
357 ok(Amanda::MainLoop::is_running(),
358 "call_later waits until mainloop runs");
360 "call_later passes arguments correctly");
361 Amanda::MainLoop::call_later($cb2);
362 Amanda::MainLoop::quit();
369 ok(!Amanda::MainLoop::is_running(), "main loop is correctly recognized as not running");
370 Amanda::MainLoop::call_later($cb1, 7, 3);
371 Amanda::MainLoop::run();
372 ok($gothere, "call_later while already running calls immediately");
377 push @actions, "cb1 start";
378 Amanda::MainLoop::call_later($cb2, "hello");
379 push @actions, "cb1 end";
385 push @actions, "cb2 start $greeting";
386 Amanda::MainLoop::quit();
387 push @actions, "cb2 end";
390 Amanda::MainLoop::call_later($cb1);
391 Amanda::MainLoop::run();
392 is_deeply([ @actions ],
393 [ "cb1 start", "cb1 end", "cb2 start hello", "cb2 end" ],
394 "call_later doesn't call its argument immediately");