git.gag.com Git - debian/amanda/blob - installcheck/Amanda_MainLoop.pl

   1 # Copyright (c) 2005-2008 Zmanda Inc.  All Rights Reserved.
   2 #
   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.
   6 #
   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
  10 # for more details.
  11 #
  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
  15 #
  16 # Contact information: Zmanda Inc, 465 S Mathlida Ave, Suite 300
  17 # Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
  18
  19 use Test::More tests => 17;
  20 use strict;
  21 use warnings;
  22 use POSIX qw(WIFEXITED WEXITSTATUS EINTR);
  23
  24 use lib "@amperldir@";
  25 use Amanda::MainLoop qw( :GIOCondition );
  26
  27 {
  28     my $global = 0;
  29
  30     my $to = Amanda::MainLoop::timeout_source(200);
  31     $to->set_callback(sub {
  32         # ignore $src argument
  33         if (++$global >= 3) {
  34             $to->remove();
  35             Amanda::MainLoop::quit();
  36         }
  37     });
  38
  39     Amanda::MainLoop::run();
  40     is($global, 3, "Timeout source works, calls back repeatedly (using a closure)");
  41 }
  42
  43 {
  44     my $global = 0;
  45
  46     my $to = Amanda::MainLoop::timeout_source(200);
  47     $to->set_callback(sub {
  48         my ($src) = @_;
  49         if (++$global >= 3) {
  50             $src->remove();
  51             Amanda::MainLoop::quit();
  52         }
  53     });
  54     $to = undef; # remove the lexical reference to the source
  55
  56     Amanda::MainLoop::run();
  57     is($global, 3, "Timeout source works, calls back repeatedly (no external reference to the source)");
  58 }
  59
  60 {
  61     my $global = 0;
  62
  63     my $id = Amanda::MainLoop::idle_source(5);
  64     $id->set_callback(sub {
  65         my ($src) = @_;
  66         if (++$global >= 30) {
  67             $src->remove();
  68             Amanda::MainLoop::quit();
  69         }
  70     });
  71
  72     Amanda::MainLoop::run();
  73     is($global, 30, "Idle source works, calls back repeatedly");
  74     $id->remove();
  75 }
  76
  77 {
  78     my $global = 0;
  79
  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; });
  84     $to1->remove();
  85
  86     my $to2 = Amanda::MainLoop::timeout_source(300);
  87     $to2->set_callback(sub { Amanda::MainLoop::quit(); });
  88
  89     Amanda::MainLoop::run();
  90     is($global, 0, "A remove()d source doesn't call back");
  91
  92     $to2->remove();
  93 }
  94
  95 {
  96     my $global = 0;
  97
  98     my $pid = fork();
  99     if ($pid == 0) {
 100         ## child
 101         sleep(1);
 102         exit(9);
 103     }
 104
 105     ## parent
 106
 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();
 111         $src->remove();
 112
 113         if ($got_pid != $pid) {
 114             diag("Got pid $got_pid, but expected $pid");
 115             return;
 116         }
 117         if (!WIFEXITED($got_status)) {
 118             diag("Didn't get an 'exited' status");
 119             return;
 120         }
 121         if (WEXITSTATUS($got_status) != 9) {
 122             diag("Didn't get exit status 9");
 123             return;
 124         }
 125         $global = 1;
 126     });
 127
 128     my $to = Amanda::MainLoop::timeout_source(3000);
 129     $to->set_callback(sub {
 130         my ($src) = @_;
 131         $global = 7;
 132
 133         $src->remove();
 134         Amanda::MainLoop::quit();
 135     });
 136
 137     Amanda::MainLoop::run();
 138     is($global, 1, "Child watch detects a dead child");
 139
 140     $cw->remove();
 141     $to->remove();
 142 }
 143
 144 {
 145     my $global = 0;
 146
 147     my $pid = fork();
 148     if ($pid == 0) {
 149         ## child
 150         exit(11);
 151     }
 152
 153     ## parent
 154
 155     sleep(1);
 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();
 160         $src->remove();
 161
 162         if ($got_pid != $pid) {
 163             diag("Got pid $got_pid, but expected $pid");
 164             return;
 165         }
 166         if (!WIFEXITED($got_status)) {
 167             diag("Didn't get an 'exited' status");
 168             return;
 169         }
 170         if (WEXITSTATUS($got_status) != 11) {
 171             diag("Didn't get exit status 11");
 172             return;
 173         }
 174         $global = 1;
 175     });
 176
 177     my $to = Amanda::MainLoop::timeout_source(3000);
 178     $to->set_callback(sub { $global = 7; Amanda::MainLoop::quit(); });
 179
 180     Amanda::MainLoop::run();
 181     is($global, 1, "Child watch detects a dead child that dies before the callback is set");
 182
 183     $cw->remove();
 184     $to->remove();
 185 }
 186
 187 {
 188     my $global = 0;
 189     my ($readinfd, $writeinfd) = POSIX::pipe();
 190     my ($readoutfd, $writeoutfd) = POSIX::pipe();
 191
 192     my $pid = fork();
 193     if ($pid == 0) {
 194         ## child
 195
 196         my $data;
 197
 198         POSIX::close($readinfd);
 199         POSIX::close($writeoutfd);
 200
 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);
 208         exit(33);
 209     }
 210
 211     ## parent
 212
 213     POSIX::close($writeinfd);
 214     POSIX::close($readoutfd);
 215
 216     my @events;
 217
 218     my $to = Amanda::MainLoop::timeout_source(200);
 219     my $times = 3;
 220     $to->set_callback(sub {
 221         push @events, "time";
 222         POSIX::write($writeoutfd, "A", 1); # wake up the child
 223         if (--$times == 0) {
 224             $to->remove();
 225         }
 226     });
 227
 228     my $cw = Amanda::MainLoop::child_watch_source($pid);
 229     $cw->set_callback(sub {
 230         my ($src, $got_pid, $got_status) = @_;
 231         $cw->remove();
 232         Amanda::MainLoop::quit();
 233
 234         push @events, "died";
 235     });
 236
 237     my $fd = Amanda::MainLoop::fd_source($readinfd, $G_IO_IN | $G_IO_HUP);
 238     $fd->set_callback(sub {
 239         my $str;
 240         if (POSIX::read($readinfd, $str, 1024) == 0) {
 241             # EOF
 242             POSIX::close($readinfd);
 243             POSIX::close($writeoutfd);
 244             $fd->remove();
 245             return;
 246         }
 247         chomp $str;
 248         push @events, "read $str";
 249     });
 250
 251     Amanda::MainLoop::run();
 252     $to->remove();
 253     $cw->remove();
 254     $fd->remove();
 255
 256     is_deeply([ @events ],
 257         [ "time", "read HELLO", "time", "read WORLD", "time", "died" ],
 258         "fd source works for reading from a file descriptor");
 259 }
 260
 261 # see if a "looping" callback with some closure values works.  This test teased
 262 # out some memory corruption bugs once upon a time.
 263
 264 {
 265     my $completed = 0;
 266     sub loop {
 267         my ($finished_cb) = @_;
 268         my $time = 700;
 269         my $to;
 270
 271         my $cb;
 272         $cb = sub {
 273             $time -= 300;
 274             $to->remove();
 275             if ($time <= 0) {
 276                 $finished_cb->();
 277             } else {
 278                 $to = Amanda::MainLoop::timeout_source($time);
 279                 $to->set_callback($cb);
 280             }
 281         };
 282         $to = Amanda::MainLoop::timeout_source($time);
 283         $to->set_callback($cb);
 284     };
 285     loop(sub {
 286         $completed = 1;
 287         Amanda::MainLoop::quit();
 288     });
 289     Amanda::MainLoop::run();
 290     is($completed, 1, "looping construct terminates with a callback");
 291 }
 292
 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
 295 # to fork a child.
 296 {
 297     my $global = 0;
 298     my ($readfd, $writefd) = POSIX::pipe();
 299
 300     my $pid = fork();
 301     if ($pid == 0) {
 302         ## child
 303
 304         my $data;
 305
 306         # fix up the file descriptors to hook fd 2 (stderr) to
 307         # the pipe
 308         POSIX::close($readfd);
 309         POSIX::dup2($writefd, 2);
 310         POSIX::close($writefd);
 311
 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(); };
 317         exit(33);
 318     }
 319
 320     ## parent
 321
 322     POSIX::close($writefd);
 323
 324     # read from the child and wait for it to die.  There's no
 325     # need to use MainLoop here.
 326     my $str;
 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: $!");
 331     }
 332     POSIX::close($readfd);
 333     waitpid($pid, 0);
 334
 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");
 337 }
 338
 339 # test misc. management of sources.  Ideally it won't crash :)
 340
 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");
 346
 347 $src->remove();
 348 $src->remove();
 349 pass("Calling remove twice is ok");
 350
 351 {
 352     my ($cb1, $cb2);
 353     my $gothere = 0;
 354
 355     $cb1 = sub {
 356         my ($a, $b) = @_;
 357         ok(Amanda::MainLoop::is_running(),
 358             "call_later waits until mainloop runs");
 359         is($a+$b, 10,
 360             "call_later passes arguments correctly");
 361         Amanda::MainLoop::call_later($cb2);
 362         Amanda::MainLoop::quit();
 363     };
 364
 365     $cb2 = sub {
 366         $gothere = 1;
 367     };
 368
 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");
 373
 374     my @actions = ();
 375
 376     $cb1 = sub {
 377         push @actions, "cb1 start";
 378         Amanda::MainLoop::call_later($cb2, "hello");
 379         push @actions, "cb1 end";
 380     };
 381
 382     $cb2 = sub {
 383         my ($greeting) = @_;
 384
 385         push @actions, "cb2 start $greeting";
 386         Amanda::MainLoop::quit();
 387         push @actions, "cb2 end";
 388     };
 389
 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");
 395 }