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

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