The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w
# DESCRIPTION: Perl ExtUtils: Type 'make test' to test this package
#
# Copyright 2003-2017 by Wilson Snyder.  This program is free software;
# you can redistribute it and/or modify it under the terms of either the GNU
# Lesser General Public License Version 3 or the Perl Artistic License Version 2.0.
######################################################################

use Test::More;
use strict;

BEGIN { plan tests => 12 }
BEGIN { require "./t/test_utils.pl"; }

BEGIN { $Parallel::Forker::Debug = 1; }

use Parallel::Forker;
ok(1, "use");

######################################################################

a_test(0);
a_test(1);

my %Didit;
sub didit { $Didit{$_[0]->name} = 1 }

sub a_test {
    my $failit = shift;

    my $fork = new Parallel::Forker (use_sig_child=>1);
    $SIG{CHLD} = sub { Parallel::Forker::sig_child($fork); };
    $SIG{TERM} = sub { $fork->kill_tree_all('TERM') if $fork && $fork->in_parent; die "Quitting...\n"; };
    ok(1, "sig");

    # Test use of -'s in run_afters
    %Didit = ();

    $fork->schedule(name => 'a',
		    run_on_start => sub {
			if ($failit) {exit(13);} # Intentional bad status
			exit(0);
		    },
		    run_on_finish => sub {
			my ($procref, $status) = @_;
			#print "Stat = $status\n";
			if ($failit) {
			    if (($status>>8) == 13) { $Didit{a} = 1 }
			} else { $Didit{a} = 1; }
		    },
		    run_after => ['-doesnt_exist'],
		    label => 'a',
		    );
    $fork->schedule(name => 'b',
		    run_on_start => sub { },
		    run_on_finish => \&didit,
		    run_after => ['| a'],
		    label => 'd2',
		    );
    my $na =
    $fork->schedule(name => 'c',
		    run_on_start => sub { },
		    run_on_finish => \&didit,
		    run_after => ['!a'],
		    label => 'd3',
		    );
    $fork->schedule(name => 'd',
		    run_on_start => sub { },
		    run_on_finish => \&didit,
		    run_after => ['^a'],
		    );
    $fork->schedule(name => 'e',
		    run_on_start => sub { },
		    run_on_finish => \&didit,
		    run_after => [$na],
		    );
    $fork->schedule(name => 'e2',
		    run_on_start => sub { },
		    run_on_finish => \&didit,
		    run_after => ['e'],
		    );
    $fork->schedule(name => 'f',
		    run_on_start => sub { },
		    run_on_finish => \&didit,
		    run_after => ["d2 | d3"],
		    );

    # Check implicit and'ing (will never run)
    $fork->schedule(name => 'g',
      run_on_start => sub {},
      run_on_finish => \&didit,
      run_after => ['b', $na],
    );

    # Check implicit and'ing (will run if NOT $failit)
    $fork->schedule(name => 'h',
      run_on_start => sub {},
      run_on_finish => \&didit,
      run_after => ['d', $na],
    );

    # Run them
    $fork->ready_all();
    $fork->wait_all();

    # Check right procs died
    print " Didit: ", (join ' ',(sort (keys %Didit))), "\n";
    if ($failit) {
	ok($Didit{a} && !$Didit{b} && $Didit{c} && $Didit{d} && $Didit{f}
          && !$Didit{g} && $Didit{h});
    } else {
	ok($Didit{a} && $Didit{b} && !$Didit{c} && $Didit{d} && $Didit{f}
          && !$Didit{g} && !$Didit{h});
    }
    ok( (($Didit{e}||-1) == ($Didit{c}||-1))
	&& (($Didit{e}||-1) == ($Didit{e2}||-1)));

    # Check all marked appropriately
    sub names_are {
      my ($fork, $method) = @_;
      return join('', map { $_->name }
        grep { $_->$method } $fork->processes_sorted);
    }

    if ($failit) {
      ok( names_are($fork, 'is_parerr'), 'bg' );
      ok( names_are($fork, 'is_done'), 'acdee2fh' );
    } else {
      ok( names_are($fork, 'is_parerr'), 'cee2gh' );
      ok( names_are($fork, 'is_done'), 'abdf' );
    }
}

# Full ordering test (simple tree with one diamond, so there's just two possibilities)
#         a
#         |
#         b
#        / \
#       c  d
#       \ /
#        e
#        |
#        f
{
  my $fork = new Parallel::Forker (use_sig_child=>1);
  $SIG{CHLD} = sub { Parallel::Forker::sig_child($fork); };
  $SIG{TERM} = sub { $fork->kill_tree_all('TERM') if $fork && $fork->in_parent; die "Quitting...\n"; };

  my @done_order;
  sub done { push @done_order, $_[0]->name }
  my %args = (
    run_on_start => sub {},
    run_on_finish => \&done,
  );

  $fork->schedule(name => 'a', %args);
  $fork->schedule(name => 'b', %args,
    run_after => ['a'],
  );
  $fork->schedule(name => 'c', %args,
    run_after => ['b'],
  );
  $fork->schedule(name => 'd', %args,
    run_after => ['b'],
  );
  $fork->schedule(name => 'e', %args,
    run_after => ['d', 'c'],
  );
  $fork->schedule(name => 'f', %args,
    run_after => ['e'],
  );

  $fork->ready_all;
  $fork->wait_all;

  ok(("@done_order" eq "a b c d e f"
      || "@done_order" eq "a b d c e f"),
     "done_order");
}