view release on metacpan or  search on metacpan

t/14-coverage-closure-extra.t  view on Meta::CPAN

        cwd        => $timeout_dir,
        timeout_ms => 50,
    );
    is( $exit_code, 124, 'collector command timeout returns 124' );
    ok( $timed_out, 'collector command timeout is marked as timed out' );
    is( $stdout, '', 'collector timeout leaves stdout empty' );
    is( $stderr, '', 'collector timeout leaves stderr empty' );
    ok( Developer::Dashboard::CollectorRunner::_cron_match( '*/5', 10 ), 'collector cron step matches divisible values' );
    ok( !Developer::Dashboard::CollectorRunner::_cron_match( '*/5', 3 ), 'collector cron step does not match unrelated values' );
    ok( !Developer::Dashboard::CollectorRunner::_cron_match( '9', 3 ), 'collector cron exact value can fail to match' );

    my ( $code_stdout, $code_stderr, $code_exit, $code_timed_out ) = $runner->_run_code(
        source     => q{sleep 2; return 0;},
        cwd        => $timeout_dir,
        timeout_ms => 50,
    );
    is( $code_exit, 124, 'collector perl-code timeout returns 124' );
    ok( $code_timed_out, 'collector perl-code timeout is marked as timed out' );
    is( $code_stdout, '', 'collector perl-code timeout leaves stdout empty' );
    is( $code_stderr, '', 'collector perl-code timeout leaves stderr empty' );

    my $mode_error = eval { $runner->_run_job( mode => 'bogus', source => '1', cwd => $timeout_dir ); 1 } ? '' : $@;
    like( $mode_error, qr/Unknown collector mode 'bogus'/, 'collector runner rejects unknown execution modes' );

    no warnings 'redefine';
    local *Developer::Dashboard::CollectorRunner::_run_job = sub { die "outer run wrapper failure\n" };
    my $wrapped = $runner->run_once(
        {
            name    => 'wrapped.failure',
            command => q{printf wrapped},
            cwd     => $timeout_dir,
        }
    );
    is( $wrapped->{exit_code}, 255, 'run_once maps outer execution wrapper failures to exit 255' );
    like( $wrapped->{stderr}, qr/outer run wrapper failure/, 'run_once appends outer execution wrapper failures to stderr' );
    is( $collector_store->read_status('wrapped.failure')->{active_runs}, 0, 'run_once clears active_runs after an outer execution wrapper failure' );
    ok( !$collector_store->read_status('wrapped.failure')->{running}, 'run_once clears running after an outer execution wrapper failure' );
}

{
    my $loop_name = 'coverage.loop';
    my $pidfile   = $runner->_pidfile($loop_name);
    my $statefile = $runner->_statefile($loop_name);

    my $managed_child = fork();
    die "fork failed: $!" if !defined $managed_child;
    if ( !$managed_child ) {
        $ENV{DEVELOPER_DASHBOARD_LOOP_NAME} = $loop_name;
        $0 = $runner->_process_title($loop_name);
        $SIG{TERM} = 'IGNORE';
        sleep 30;
        exit 0;
    }
    open my $fh, '>', $pidfile or die $!;
    print {$fh} $managed_child;
    close $fh;
    # Wait BEFORE the first running_loops call, not around it. This pidfile has
    # no loop state, so the child's process title is the only evidence of its
    # identity, and running_loops deletes the pidfile of any same-namespace pid it
    # cannot recognize. A poll loop therefore destroys its own fixture on the
    # first iteration and can never recover, however many iterations it is given.
    ok(
        wait_for_managed_loop( $runner, $managed_child, $loop_name ),
        'managed loop child becomes identifiable before running_loops reads the collectors root',
    );
    my @loops = $runner->running_loops;
    is( scalar @loops, 1, 'running_loops lists active managed loop pids' );
    is( $loops[0]{name}, $loop_name, 'running_loops returns the managed loop name' );

    $collector_store->mark_run_started( $loop_name, {} );
    ok( $collector_store->read_status($loop_name)->{running}, 'collector status reports running before the loop is stopped' );

    my $stopped_pid = $runner->stop_loop($loop_name);
    is( $stopped_pid, $managed_child, 'stop_loop returns managed loop pid' );
    waitpid( $managed_child, 0 );
    ok( !-e $pidfile, 'stop_loop removes loop pid files after forced kill' );
    ok( !-e $statefile, 'stop_loop removes loop state files after forced kill' );

    my $status_after_stop = $collector_store->read_status($loop_name) || {};
    ok( !$status_after_stop->{running}, 'stop_loop resets the consumer-facing running flag so a stopped collector is no longer reported as running' );
    is( $status_after_stop->{active_runs}, 0, 'stop_loop clears active_runs when the loop is stopped so in-flight counters do not linger' );
}

{
    is( $collector_store->mark_stopped('never.seeded.collector'), undef, 'mark_stopped is a no-op when the collector has no status file yet' );

    $collector_store->mark_run_started( 'reset.direct.collector', {} );
    ok( $collector_store->read_status('reset.direct.collector')->{running}, 'seeded collector status reports running' );
    is( $collector_store->read_status('reset.direct.collector')->{active_runs}, 1, 'seeded collector status reports one active run' );

    $collector_store->mark_stopped('reset.direct.collector');
    my $reset = $collector_store->read_status('reset.direct.collector');
    ok( !$reset->{running}, 'mark_stopped clears the running flag directly' );
    is( $reset->{active_runs}, 0, 'mark_stopped clears active_runs directly' );
    ok( defined $reset->{stopped_at} && $reset->{stopped_at} ne '', 'mark_stopped records when the collector was stopped' );
}

{
    # Fix A: a just-spawned worker must be persisted to active_worker_pids
    # immediately, not only at the top of the next iteration, so a crash cannot
    # orphan a worker that is invisible to the persisted state.
    my $persist_name = 'coverage.persist.on.spawn';
    my $child = fork();
    die "fork failed: $!" if !defined $child;
    if ( !$child ) {
        no warnings 'redefine';
        local *Developer::Dashboard::CollectorRunner::_job_is_due = sub { return 1 };
        my $ok = $runner->_run_loop_child(
            daemonize     => 0,
            interval      => 1,
            job           => { command => 'sleep 30', cwd => $home },
            name          => $persist_name,
            schedule_mode => 'interval',
            single_tick   => 1,
            title         => $runner->_process_title($persist_name),
        );
        exit( $ok ? 0 : 1 );
    }
    waitpid( $child, 0 );
    my @persisted = $runner->_state_active_worker_pids($persist_name);
    ok( scalar(@persisted) >= 1, 'loop persists active_worker_pids immediately on spawn so a just-started worker survives a crash-and-stop' );