view release on metacpan or  search on metacpan

t/43-explicit-coverage-qa.t  view on Meta::CPAN

    open my $named_bin_fh, '>', $named_make_bin or die $!;
    print {$named_bin_fh} "#!/bin/sh\n";
    print {$named_bin_fh} "if [ \"\${1:-default}\" = \"install\" ]; then\n";
    print {$named_bin_fh} "  echo install failed >&2\n";
    print {$named_bin_fh} "  exit 1\n";
    print {$named_bin_fh} "fi\n";
    print {$named_bin_fh} "exit 0\n";
    close $named_bin_fh;
    chmod 0755, $named_make_bin or die $!;
    local $ENV{PATH} = join ':', $named_make_root, ( $ENV{PATH} || '' );
    my $named_make_failure = $manager->_install_skill_makefile($named_make_root);
    like(
        $named_make_failure->{error},
        qr/^Failed to run skill Makefile target 'install' for \Q$named_make_root\E: install failed/m,
        '_install_skill_makefile reports the failing named target explicitly',
    );

    my $winget_root = tempdir( CLEANUP => 1 );
    my $wingetfile = File::Spec->catfile( $winget_root, 'wingetfile' );
    open my $winget_fh, '>', $wingetfile or die $!;
    print {$winget_fh} "Git.Git\n";
    close $winget_fh;
    my $winget_bin = File::Spec->catfile( $winget_root, 'winget' );
    open my $winget_bin_fh, '>', $winget_bin or die $!;
    print {$winget_bin_fh} "#!/bin/sh\n";
    print {$winget_bin_fh} "echo winget-ok\n";
    print {$winget_bin_fh} "echo winget-warn >&2\n";
    print {$winget_bin_fh} "exit 0\n";
    close $winget_bin_fh;
    chmod 0755, $winget_bin or die $!;
    local $ENV{PATH} = join ':', $winget_root, ( $ENV{PATH} || '' );
    local *Developer::Dashboard::SkillManager::_is_windows = sub { 1 };
    my $winget_ok = $manager->_install_skill_wingetfile($winget_root);
    ok( $winget_ok->{success}, '_install_skill_wingetfile succeeds on Windows when winget exits cleanly' );
    is( $winget_ok->{stdout}, "winget-ok\n", '_install_skill_wingetfile returns streamed winget stdout without folding the progress banner into the result payload' );
    like( $winget_ok->{stderr}, qr/winget-warn/, '_install_skill_wingetfile returns combined stderr from winget' );

    open my $winget_fail_fh, '>', $winget_bin or die $!;
    print {$winget_fail_fh} "#!/bin/sh\n";
    print {$winget_fail_fh} "echo broken-winget >&2\n";
    print {$winget_fail_fh} "exit 1\n";
    close $winget_fail_fh;
    chmod 0755, $winget_bin or die $!;
    my $winget_fail = $manager->_install_skill_wingetfile($winget_root);
    like(
        $winget_fail->{error},
        qr/^Failed to install skill winget dependencies for \Q$winget_root\E: broken-winget/m,
        '_install_skill_wingetfile reports failing winget installs explicitly',
    );

    my $cpan_root = tempdir( CLEANUP => 1 );
    my $cpanfile = File::Spec->catfile( $cpan_root, 'cpanfile' );
    open my $cpan_fh, '>', $cpanfile or die $!;
    print {$cpan_fh} "requires 'Test::More';\n";
    close $cpan_fh;
    my $original_cwd = Cwd::getcwd();
    my $cpan_error = do {
        no warnings 'redefine';
        local *Developer::Dashboard::SkillManager::_shared_perl_root = sub { return File::Spec->catdir( $cpan_root, 'perl5-shared' ) };
        local *Developer::Dashboard::SkillManager::_ensure_perl_root = sub { return $_[1] };
        local *Developer::Dashboard::SkillManager::_run_streaming_command = sub {
            return {
                stdout => '',
                stderr => "cpan boom\n",
                exit   => 1,
            };
        };
        eval { $manager->_install_skill_cpanfile($cpan_root); 1 } ? '' : $@;
    };
    is( $cpan_error, '', '_install_skill_cpanfile reports streaming failures as structured errors instead of throwing raw exceptions' );
    my $cpan_failure = do {
        no warnings 'redefine';
        local *Developer::Dashboard::SkillManager::_shared_perl_root = sub { return File::Spec->catdir( $cpan_root, 'perl5-shared' ) };
        local *Developer::Dashboard::SkillManager::_ensure_perl_root = sub { return $_[1] };
        local *Developer::Dashboard::SkillManager::_run_streaming_command = sub {
            return {
                stdout => '',
                stderr => "cpan boom\n",
                exit   => 1,
            };
        };
        $manager->_install_skill_cpanfile($cpan_root);
    };
    like( $cpan_failure->{error}, qr/cpan boom/, '_install_skill_cpanfile surfaces the streamed cpanm failure text in the structured error result' );
    is( Cwd::getcwd(), $original_cwd, '_install_skill_cpanfile restores the original cwd after an in-flight failure' );

    my $cpan_local_root = tempdir( CLEANUP => 1 );
    my $cpanfile_local = File::Spec->catfile( $cpan_local_root, 'cpanfile.local' );
    open my $cpan_local_fh, '>', $cpanfile_local or die $!;
    print {$cpan_local_fh} "requires 'Test::More';\n";
    close $cpan_local_fh;
    my $cpan_local_error = do {
        no warnings 'redefine';
        local *Developer::Dashboard::SkillManager::_skill_local_perl_root = sub { return File::Spec->catdir( $cpan_local_root, 'perl5-local' ) };
        local *Developer::Dashboard::SkillManager::_ensure_perl_root = sub { return $_[1] };
        local *Developer::Dashboard::SkillManager::_run_streaming_command = sub {
            return {
                stdout => '',
                stderr => "cpan local boom\n",
                exit   => 1,
            };
        };
        eval { $manager->_install_skill_cpanfile_local($cpan_local_root); 1 } ? '' : $@;
    };
    is( $cpan_local_error, '', '_install_skill_cpanfile_local reports streaming failures as structured errors instead of throwing raw exceptions' );
    my $cpan_local_failure = do {
        no warnings 'redefine';
        local *Developer::Dashboard::SkillManager::_skill_local_perl_root = sub { return File::Spec->catdir( $cpan_local_root, 'perl5-local' ) };
        local *Developer::Dashboard::SkillManager::_ensure_perl_root = sub { return $_[1] };
        local *Developer::Dashboard::SkillManager::_run_streaming_command = sub {
            return {
                stdout => '',
                stderr => "cpan local boom\n",
                exit   => 1,
            };
        };
        $manager->_install_skill_cpanfile_local($cpan_local_root);
    };
    like( $cpan_local_failure->{error}, qr/cpan local boom/, '_install_skill_cpanfile_local surfaces the streamed cpanm failure text in the structured error result' );
    is( Cwd::getcwd(), $original_cwd, '_install_skill_cpanfile_local restores the original cwd after an in-flight failure' );
};

sub _dies {
    my ($code) = @_;
    my $ok = eval { $code->(); 1 };
    return '' if $ok;
    return $@;
}

done_testing();

__END__

=head1 NAME

43-explicit-coverage-qa.t - focused numeric coverage closure for helper modules

=head1 PURPOSE

This test exercises helper modules that are easy to miss in browser and CLI
smoke tests but still count against the explicit 100 percent library coverage
gate.

=head1 WHY IT EXISTS

It exists because the repository now treats the numeric Devel::Cover report as
a standing QA gate after the normal test gate on every change. That means the
helper modules used behind progress boards, file aliases, and lightweight skill
dispatch need direct unit coverage instead of relying on indirect smoke paths.

=head1 WHEN TO USE

Run this file when changing progress rendering, lightweight file and skills
helpers, compatibility file wrappers, or other direct helper branches that do
not naturally get exercised deeply enough by browser or shell smoke tests.

=head1 HOW TO USE

Run it directly with C<prove -lv t/43-explicit-coverage-qa.t> while iterating.
It uses mocked path, config, file-registry, skill-manager, and dispatcher
objects so helper logic can be exercised without booting the whole runtime.

=head1 WHAT USES IT

The explicit numeric Devel::Cover QA gate, the full C<prove -lr t> suite, and
future contributors who need a direct regression target for the helper modules
covered here all depend on this file.

=head1 EXAMPLES