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

   1 # Copyright (c) 2008, 2009, 2010 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. Mathilda Ave., Suite 300
  17 # Sunnyvale, CA 94086, USA, or: http://www.zmanda.com
  18
  19 use Test::More tests => 25;
  20 use strict;
  21 use warnings;
  22 use POSIX qw(WIFEXITED WEXITSTATUS EINTR );
  23 use IO::Pipe;
  24
  25 use lib "@amperldir@";
  26 use Amanda::MainLoop qw( :GIOCondition make_cb define_steps step );
  27 use Amanda::Util;
  28
  29 {
  30     my $global = 0;
  31
  32     my $to = Amanda::MainLoop::timeout_source(200);
  33     $to->set_callback(sub {
  34         # ignore $src argument
  35         if (++$global >= 3) {
  36             $to->remove();
  37             Amanda::MainLoop::quit();
  38         }
  39     });
  40
  41     Amanda::MainLoop::run();
  42     is($global, 3, "Timeout source works, calls back repeatedly (using a closure)");
  43 }
  44
  45 {
  46     my $global = 0;
  47
  48     my $to = Amanda::MainLoop::timeout_source(200);
  49     $to->set_callback(sub {
  50         my ($src) = @_;
  51         if (++$global >= 3) {
  52             $src->remove();
  53             Amanda::MainLoop::quit();
  54         }
  55     });
  56     $to = undef; # remove the lexical reference to the source
  57
  58     Amanda::MainLoop::run();
  59     is($global, 3, "Timeout source works, calls back repeatedly (no external reference to the source)");
  60 }
  61
  62 {
  63     my $global = 0;
  64
  65     my $id = Amanda::MainLoop::idle_source(5);
  66     $id->set_callback(sub {
  67         my ($src) = @_;
  68         if (++$global >= 30) {
  69             $src->remove();
  70             Amanda::MainLoop::quit();
  71         }
  72     });
  73
  74     Amanda::MainLoop::run();
  75     is($global, 30, "Idle source works, calls back repeatedly");
  76     $id->remove();
  77 }
  78
  79 {
  80     my $global = 0;
  81
  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; });
  86     $to1->remove();
  87
  88     my $to2 = Amanda::MainLoop::timeout_source(300);
  89     $to2->set_callback(sub { Amanda::MainLoop::quit(); });
  90
  91     Amanda::MainLoop::run();
  92     is($global, 0, "A remove()d source doesn't call back");
  93
  94     $to2->remove();
  95 }
  96
  97 {
  98     my $global = 0;
  99
 100     my $pid = fork();
 101     if ($pid == 0) {
 102         ## child
 103         sleep(1);
 104         exit(9);
 105     }
 106
 107     ## parent
 108
 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();
 113         $src->remove();
 114
 115         if ($got_pid != $pid) {
 116             diag("Got pid $got_pid, but expected $pid");
 117             return;
 118         }
 119         if (!WIFEXITED($got_status)) {
 120             diag("Didn't get an 'exited' status");
 121             return;
 122         }
 123         if (WEXITSTATUS($got_status) != 9) {
 124             diag("Didn't get exit status 9");
 125             return;
 126         }
 127         $global = 1;
 128     });
 129
 130     my $to = Amanda::MainLoop::timeout_source(3000);
 131     $to->set_callback(sub {
 132         my ($src) = @_;
 133         $global = 7;
 134
 135         $src->remove();
 136         Amanda::MainLoop::quit();
 137     });
 138
 139     Amanda::MainLoop::run();
 140     is($global, 1, "Child watch detects a dead child");
 141
 142     $cw->remove();
 143     $to->remove();
 144 }
 145
 146 {
 147     my $global = 0;
 148
 149     my $pid = fork();
 150     if ($pid == 0) {
 151         ## child
 152         exit(11);
 153     }
 154
 155     ## parent
 156
 157     sleep(1);
 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();
 162         $src->remove();
 163
 164         if ($got_pid != $pid) {
 165             diag("Got pid $got_pid, but expected $pid");
 166             return;
 167         }
 168         if (!WIFEXITED($got_status)) {
 169             diag("Didn't get an 'exited' status");
 170             return;
 171         }
 172         if (WEXITSTATUS($got_status) != 11) {
 173             diag("Didn't get exit status 11");
 174             return;
 175         }
 176         $global = "ok";
 177     });
 178
 179     my $to = Amanda::MainLoop::timeout_source(3000);
 180     $to->set_callback(sub { $global = "timeout"; Amanda::MainLoop::quit(); });
 181
 182     Amanda::MainLoop::run();
 183     is($global, "ok", "Child watch detects a dead child that dies before the callback is set");
 184
 185     $cw->remove();
 186     $to->remove();
 187 }
 188
 189 {
 190     my $global = 0;
 191     my ($readinfd, $writeinfd) = POSIX::pipe();
 192     my ($readoutfd, $writeoutfd) = POSIX::pipe();
 193
 194     my $pid = fork();
 195     if ($pid == 0) {
 196         ## child
 197
 198         my $data;
 199
 200         POSIX::close($readinfd);
 201         POSIX::close($writeoutfd);
 202
 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);
 210         exit(33);
 211     }
 212
 213     ## parent
 214
 215     POSIX::close($writeinfd);
 216     POSIX::close($readoutfd);
 217
 218     my @events;
 219
 220     my $to = Amanda::MainLoop::timeout_source(200);
 221     my $times = 3;
 222     $to->set_callback(sub {
 223         push @events, "time";
 224         POSIX::write($writeoutfd, "A", 1); # wake up the child
 225         if (--$times == 0) {
 226             $to->remove();
 227         }
 228     });
 229
 230     my $cw = Amanda::MainLoop::child_watch_source($pid);
 231     $cw->set_callback(sub {
 232         my ($src, $got_pid, $got_status) = @_;
 233         $cw->remove();
 234         Amanda::MainLoop::quit();
 235
 236         push @events, "died";
 237     });
 238
 239     my $fd = Amanda::MainLoop::fd_source($readinfd, $G_IO_IN | $G_IO_HUP);
 240     $fd->set_callback(sub {
 241         my $str;
 242         if (POSIX::read($readinfd, $str, 1024) == 0) {
 243             # EOF
 244             POSIX::close($readinfd);
 245             POSIX::close($writeoutfd);
 246             $fd->remove();
 247             return;
 248         }
 249         chomp $str;
 250         push @events, "read $str";
 251     });
 252
 253     Amanda::MainLoop::run();
 254     $to->remove();
 255     $cw->remove();
 256     $fd->remove();
 257
 258     is_deeply([ @events ],
 259         [ "time", "read HELLO", "time", "read WORLD", "time", "died" ],
 260         "fd source works for reading from a file descriptor");
 261 }
 262
 263 # see if a "looping" callback with some closure values works.  This test teased
 264 # out some memory corruption bugs once upon a time.
 265
 266 {
 267     my $completed = 0;
 268     sub loop {
 269         my ($finished_cb) = @_;
 270         my $time = 700;
 271         my $to;
 272
 273         my $cb;
 274         $cb = sub {
 275             $time -= 300;
 276             $to->remove();
 277             if ($time <= 0) {
 278                 $finished_cb->();
 279             } else {
 280                 $to = Amanda::MainLoop::timeout_source($time);
 281                 $to->set_callback($cb);
 282             }
 283         };
 284         $to = Amanda::MainLoop::timeout_source($time);
 285         $to->set_callback($cb);
 286     };
 287     loop(sub {
 288         $completed = 1;
 289         Amanda::MainLoop::quit();
 290     });
 291     Amanda::MainLoop::run();
 292     is($completed, 1, "looping construct terminates with a callback");
 293 }
 294
 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
 297 # to fork a child.
 298 {
 299     my $global = 0;
 300     my ($readfd, $writefd) = POSIX::pipe();
 301
 302     my $pid = fork();
 303     if ($pid == 0) {
 304         ## child
 305
 306         my $data;
 307
 308         # fix up the file descriptors to hook fd 2 (stderr) to
 309         # the pipe
 310         POSIX::close($readfd);
 311         POSIX::dup2($writefd, 2);
 312         POSIX::close($writefd);
 313
 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(); };
 319         exit(33);
 320     }
 321
 322     ## parent
 323
 324     POSIX::close($writefd);
 325
 326     # read from the child and wait for it to die.  There's no
 327     # need to use MainLoop here.
 328     my $str;
 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: $!");
 333     }
 334     POSIX::close($readfd);
 335     waitpid($pid, 0);
 336
 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");
 339 }
 340
 341 # test misc. management of sources.  Ideally it won't crash :)
 342
 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");
 348
 349 $src->remove();
 350 $src->remove();
 351 pass("Calling remove twice is ok");
 352
 353 # call_later
 354
 355 {
 356     my ($cb1, $cb2);
 357     my $gothere = 0;
 358
 359     $cb1 = sub {
 360         my ($a, $b) = @_;
 361         ok(Amanda::MainLoop::is_running(),
 362             "call_later waits until mainloop runs");
 363         is($a+$b, 10,
 364             "call_later passes arguments correctly");
 365         Amanda::MainLoop::call_later($cb2);
 366         Amanda::MainLoop::quit();
 367     };
 368
 369     $cb2 = sub {
 370         $gothere = 1;
 371     };
 372
 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");
 377
 378     my @actions = ();
 379
 380     $cb1 = sub {
 381         push @actions, "cb1 start";
 382         Amanda::MainLoop::call_later($cb2, "hello");
 383         push @actions, "cb1 end";
 384     };
 385
 386     $cb2 = sub {
 387         my ($greeting) = @_;
 388
 389         push @actions, "cb2 start $greeting";
 390         Amanda::MainLoop::quit();
 391         push @actions, "cb2 end";
 392     };
 393
 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");
 399
 400     my @calls;
 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");
 408 }
 409
 410 # call_after
 411
 412 {
 413     # note: gettimeofday is in usec, but call_after is in msec
 414
 415     my ($start, $end) = (Amanda::Util::gettimeofday(), undef );
 416     Amanda::MainLoop::call_after(100, sub {
 417         my ($a, $b) = @_;
 418         is($a+$b, 10, "call_after passes arguments correctly");
 419         $end = Amanda::Util::gettimeofday();
 420         Amanda::MainLoop::quit();
 421     }, 2, 8);
 422     Amanda::MainLoop::run();
 423
 424     ok(($end - $start)/1000 > 75,
 425         "call_after makes callbacks in the correct order")
 426         or diag("only " . (($end - $start)/1000) . "msec elapsed");
 427 }
 428
 429 # async_read
 430
 431 {
 432     my $global = 0;
 433     my $inpipe = IO::Pipe->new();
 434     my $outpipe = IO::Pipe->new();
 435     my @events;
 436
 437     my $pid = fork();
 438     if ($pid == 0) {
 439         ## child
 440
 441         my $data;
 442
 443         $inpipe->writer();
 444         $inpipe->autoflush(1);
 445         $outpipe->reader();
 446
 447         $inpipe->write("HELLO");
 448         $outpipe->read($data, 1);
 449         $inpipe->write("WORLD");
 450         exit(33);
 451     }
 452
 453     ## parent
 454
 455     $inpipe->reader();
 456     $inpipe->blocking(0);
 457     $outpipe->writer();
 458     $outpipe->blocking(0);
 459     $outpipe->autoflush(1);
 460
 461     sub test_async_read {
 462         my ($finished_cb) = @_;
 463
 464         my $steps = define_steps
 465             cb_ref => \$finished_cb;
 466
 467         step start => sub {
 468             Amanda::MainLoop::async_read(
 469                 fd => $inpipe->fileno(),
 470                 size => 0,
 471                 async_read_cb => $steps->{'read_hello'});
 472         };
 473
 474         step read_hello => sub {
 475             my ($err, $data) = @_;
 476             die $err if $err;
 477             push @events, "read1 '$data'";
 478
 479             $outpipe->write("A"); # wake up the child
 480             Amanda::MainLoop::async_read(
 481                 fd => $inpipe->fileno(),
 482                 size => 5,
 483                 async_read_cb => $steps->{'read_world'});
 484         };
 485
 486         step read_world => sub {
 487             my ($err, $data) = @_;
 488             die $err if $err;
 489             push @events, "read2 '$data'";
 490
 491             Amanda::MainLoop::async_read(
 492                 fd => $inpipe->fileno(),
 493                 size => 5,
 494                 async_read_cb => $steps->{'read_eof'});
 495         };
 496
 497         step read_eof => sub {
 498             my ($err, $data) = @_;
 499             die $err if $err;
 500             push @events, "read3 '$data'";
 501
 502             Amanda::MainLoop::quit();
 503         };
 504     }
 505
 506     test_async_read(sub { Amanda::MainLoop::quit(); });
 507     Amanda::MainLoop::run();
 508     waitpid($pid, 0);
 509
 510     is_deeply([ @events ],
 511         [ "read1 'HELLO'", "read2 'WORLD'", "read3 ''" ],
 512         "async_read works for reading from a file descriptor");
 513 }
 514
 515 {
 516     my $inpipe;
 517     my $outpipe;
 518     my $pid;
 519     my $thunk;
 520     my @events;
 521
 522     sub test_async_read_harder {
 523         my ($finished_cb) = @_;
 524
 525         my $steps = define_steps
 526             cb_ref => \$finished_cb;
 527
 528         step start => sub {
 529             if (defined $pid) {
 530                 waitpid($pid, 0);
 531                 $pid = undef;
 532             }
 533
 534             $inpipe = IO::Pipe->new();
 535             $outpipe = IO::Pipe->new();
 536
 537             $pid = fork();
 538             if ($pid == 0) {
 539                 my $data;
 540
 541                 $inpipe->writer();
 542                 $inpipe->autoflush(1);
 543                 $outpipe->reader();
 544
 545                 while (1) {
 546                     $outpipe->read($data, 1);
 547                     last if ($data eq 'X');
 548                     if ($data eq 'W') {
 549                         $inpipe->write("a" x 4096);
 550                     } else {
 551                         $inpipe->write("GOT=$data");
 552                     }
 553                 }
 554
 555                 exit(0);
 556             }
 557
 558             # parent
 559
 560             $inpipe->reader();
 561             $inpipe->blocking(0);
 562             $outpipe->writer();
 563             $outpipe->blocking(0);
 564             $outpipe->autoflush(1);
 565
 566             # trigger two replies
 567             $outpipe->write('A');
 568             $outpipe->write('B');
 569
 570             # give the child time to write GOT=AGOT=B
 571             Amanda::MainLoop::call_after(100, $steps->{'do_read_1'});
 572         };
 573
 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" ]);
 580         };
 581
 582         step done_read_1 => sub {
 583             my ($err, $data, $x, $y) = @_;
 584             die $err if $err;
 585             push @events, $data;
 586
 587             # test the @args
 588             is_deeply([$x, $y], ["x", "y"], "async_read's args key handled correctly");
 589
 590             $outpipe->write('C'); # should trigger a 'GOT=C' for done_read_2
 591
 592             $steps->{'do_read_2'}->();
 593         };
 594
 595         step do_read_2 => sub {
 596             Amanda::MainLoop::async_read(
 597                 fd => $inpipe->fileno(),
 598                 size => 5,
 599                 async_read_cb => $steps->{'done_read_2'});
 600         };
 601
 602         step done_read_2 => sub {
 603             my ($err, $data) = @_;
 604             die $err if $err;
 605             push @events, $data;
 606
 607             # request a 4k write and then an EOF
 608             $outpipe->write('W');
 609             $outpipe->write('X');
 610
 611             $steps->{'do_read_block'}->();
 612         };
 613
 614         step do_read_block => sub {
 615             Amanda::MainLoop::async_read(
 616                 fd => $inpipe->fileno(),
 617                 size => 1000,
 618                 async_read_cb => $steps->{'got_block'});
 619         };
 620
 621         step got_block => sub {
 622             my ($err, $data) = @_;
 623             die $err if $err;
 624             push @events, "block" . length($data);
 625             if ($data ne '') {
 626                 $steps->{'do_read_block'}->();
 627             } else {
 628                 $steps->{'done_reading_blocks'}->();
 629             }
 630         };
 631
 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'});
 638         };
 639
 640         step got_eof => sub {
 641             my ($err, $data) = @_;
 642             die $err if $err;
 643             if ($data eq '') {
 644                 push @events, "EOF";
 645             }
 646
 647             $finished_cb->();
 648         };
 649
 650         # note: not all operating systems (hi, Solaris) will generate
 651         # an error other than EOF on reading from a file descriptor
 652     }
 653
 654     test_async_read_harder(sub { Amanda::MainLoop::quit(); });
 655     Amanda::MainLoop::run();
 656     waitpid($pid, 0) if defined($pid);
 657
 658     is_deeply([ @events ],
 659         [ "GOT=AGOT=B", "GOT=C",
 660           "block1000", "block1000", "block1000", "block1000", "block96", "block0",
 661           "EOF", # got_eof
 662         ], "more complex async_read");
 663 }
 664
 665 # async_write
 666
 667 {
 668     my $inpipe = IO::Pipe->new();
 669     my $outpipe = IO::Pipe->new();
 670     my @events;
 671     my $pid;
 672
 673     sub test_async_write {
 674         my ($finished_cb) = @_;
 675
 676         my $steps = define_steps
 677             cb_ref => \$finished_cb;
 678
 679         step start => sub {
 680             $pid = fork();
 681             if ($pid == 0) {
 682                 ## child
 683
 684                 my $data;
 685
 686                 $inpipe->writer();
 687                 $inpipe->autoflush(1);
 688                 $outpipe->reader();
 689
 690                 while (1) {
 691                     $outpipe->sysread($data, 1024);
 692                     last if ($data eq "X");
 693                     $inpipe->write("$data");
 694                 }
 695                 exit(0);
 696             }
 697
 698             ## parent
 699
 700             $inpipe->reader();
 701             $inpipe->blocking(1);   # do blocking reads below, for simplicity
 702             $outpipe->writer();
 703             $outpipe->blocking(0);
 704             $outpipe->autoflush(1);
 705
 706             Amanda::MainLoop::async_write(
 707                 fd => $outpipe->fileno(),
 708                 data => 'FUDGE',
 709                 async_write_cb => $steps->{'wrote_fudge'});
 710         };
 711
 712         step wrote_fudge => sub {
 713             my ($err, $bytes) = @_;
 714             die $err if $err;
 715             push @events, "wrote $bytes";
 716
 717             my $buf;
 718             $inpipe->read($buf, $bytes);
 719             push @events, "read $buf";
 720
 721             $steps->{'double_write'}->();
 722         };
 723
 724         step double_write => sub {
 725             Amanda::MainLoop::async_write(
 726                 fd => $outpipe->fileno(),
 727                 data => 'ICECREAM',
 728                 async_write_cb => $steps->{'wrote_icecream'});
 729             Amanda::MainLoop::async_write(
 730                 fd => $outpipe->fileno(),
 731                 data => 'BROWNIES',
 732                 async_write_cb => $steps->{'wrote_brownies'});
 733         };
 734
 735         step wrote_icecream => sub {
 736             my ($err, $bytes) = @_;
 737             die $err if $err;
 738             push @events, "wrote $bytes";
 739
 740             my $buf;
 741             $inpipe->read($buf, $bytes);
 742             push @events, "read $buf";
 743         };
 744
 745         step wrote_brownies => sub {
 746             my ($err, $bytes) = @_;
 747             die $err if $err;
 748             push @events, "wrote $bytes";
 749
 750             my $buf;
 751             $inpipe->read($buf, $bytes);
 752             push @events, "read $buf";
 753
 754             $steps->{'send_x'}->();
 755         };
 756
 757         step send_x => sub {
 758             Amanda::MainLoop::async_write(
 759                 fd => $outpipe->fileno(),
 760                 data => 'X',
 761                 async_write_cb => $finished_cb);
 762         };
 763     }
 764
 765     test_async_write(sub { Amanda::MainLoop::quit(); });
 766     Amanda::MainLoop::run();
 767     waitpid($pid, 0);
 768
 769     is_deeply([ @events ],
 770         [ 'wrote 5', 'read FUDGE',
 771           'wrote 8', 'read ICECREAM',
 772           'wrote 8', 'read BROWNIES' ],
 773         "async_write works");
 774 }
 775
 776 # test synchronized
 777 {
 778     my $lock = [];
 779     my @messages;
 780
 781     sub syncd1 {
 782         my ($msg, $cb) = @_;
 783         return Amanda::MainLoop::synchronized($lock, $cb, sub {
 784             my ($ser_cb) = @_;
 785             push @messages, "BEG-$msg";
 786             Amanda::MainLoop::call_after(10, sub {
 787                 push @messages, "END-$msg";
 788                 $ser_cb->($msg);
 789             });
 790         });
 791     };
 792
 793     # add a second syncd function to demonstrate that several functions
 794     # can serialize on the same lock
 795     sub syncd2 {
 796         my ($msg, $fin_cb) = @_;
 797         return Amanda::MainLoop::synchronized($lock, $fin_cb, sub {
 798             my ($ser_cb) = @_;
 799             push @messages, "BEG2-$msg";
 800             Amanda::MainLoop::call_after(10, sub {
 801                 push @messages, "END2-$msg";
 802                 $ser_cb->($msg);
 803             });
 804         });
 805     };
 806
 807     my $num_running = 3;
 808     my $fin_cb = sub {
 809         push @messages, "FIN-$_[0]";
 810         if (--$num_running == 0) {
 811             Amanda::MainLoop::quit();
 812         }
 813     };
 814
 815     syncd1("A", $fin_cb);
 816     syncd2("B", $fin_cb);
 817     syncd1("C", $fin_cb);
 818
 819     Amanda::MainLoop::run();
 820
 821     is_deeply([ @messages ],
 822         [
 823             "BEG-A", "END-A", "FIN-A",
 824             "BEG2-B", "END2-B", "FIN-B",
 825             "BEG-C", "END-C", "FIN-C",
 826         ], "synchronized works");
 827 }