view release on metacpan or  search on metacpan

script/coverage-gate  view on Meta::CPAN

    return @paths;
}

exit main(@ARGV);

# Purpose: find the git checkout root containing a directory.
# Input:   a directory path.
# Output:  the canonical root, or undef when the path is not inside a checkout.
#
# Walks up looking for .git rather than shelling out to git, so the gate gains no
# subprocess and no PATH dependency. It tests for EXISTENCE, not for a directory:
# a linked worktree carries .git as a FILE, and this project works every ticket in
# a worktree, so a -d test would report every sandbox as "not a checkout" and the
# guard below would never fire where it matters most.
sub _checkout_root {
    my ($dir) = @_;
    return undef if !defined $dir || $dir eq '';

    # CANONICALISE FIRST, and this is not tidiness - it is the whole
    # correctness of the comparison below. $repository arrives as
    # "<root>/script/.." because it is built with File::Spec->updir, and
    # rel2abs does NOT collapse "..". Testing -e on "<root>/script/../.git"
    # succeeds, so without abs_path this returns the uncollapsed string, which
    # then compares UNEQUAL to the caller's "<root>" and the gate refuses to
    # run in its own checkout. Measured exactly that way before this line
    # existed.
    my $here = Cwd::abs_path($dir);
    return undef if !defined $here;
    my %seen;
    while ( defined $here && !$seen{$here}++ ) {
        return $here if -e File::Spec->catfile( $here, '.git' );
        # abs_path, NOT rel2abs, and the difference is a hang. rel2abs does not
        # collapse "..", so the walk produced "/tmp/x/..", then "/tmp/x/../..",
        # then "/tmp/x/../../.." - a string that grows for ever and never equals
        # its predecessor, so the loop never terminated and the %seen guard never
        # fired because every value was new. It only bites when NOTHING is found,
        # which is why a checkout resolved instantly and a temp directory hung.
        my $up = Cwd::abs_path( File::Spec->catdir( $here, File::Spec->updir ) );
        last if !defined $up || $up eq $here;
        $here = $up;
    }
    return undef;
}


# Purpose: run the four-metric coverage gate end to end inside one environment.
# Input: the raw @ARGV list - optional --database, --dry-run and --help, plus
#        optional test paths which default to the whole t/ tree.
# Output: an exit code - 0 every metric at 100.0, 1 a genuine shortfall, 2 the
#         gate could not run or could not read its report, 3 the coverage
#         instrument could not read its own database, 4 another gate already
#         holds the database and this run refused rather than corrupt it, 5 the
#         tree moved while the suite ran so the number describes no single state
#         of it.
sub main {
    my @argv = @_;

    my $database = 'cover_db';
    my ( $dry_run, $help ) = ( 0, 0 );

    local @ARGV = @argv;
    GetOptions(
        'database=s' => \$database,
        'dry-run'    => \$dry_run,
        'help'       => \$help,
    ) or return _usage('unrecognized option');

    if ($help) {
        print _usage_text();
        return EXIT_CLEAN;
    }

    my @tests = @ARGV ? @ARGV : ('t');

    my $script_directory = dirname( File::Spec->rel2abs(__FILE__) );
    my $repository       = File::Spec->catdir( $script_directory, File::Spec->updir );
    my $checker          = File::Spec->catfile( $script_directory, 'check-all-metric-coverage' );
    return _unusable("the coverage checker is missing: $checker") if !-f $checker;

    # WHICH TREE IS ABOUT TO BE GRADED - refuse rather than choose silently (DD-744).
    #
    # This gate derives its repository from its OWN file location, which is
    # deliberate: run from anywhere, "grade the repository I belong to" is the
    # sane reading. It stops being sane when the caller is standing in a
    # DIFFERENT checkout, because then the tool makes a choice the caller never
    # saw - it grades another tree, succeeds, and prints a normal-looking result.
    #
    # THE CONDITION IS NARROW ON PURPOSE, and widening it breaks real specs.
    # Refusing whenever the two paths differ would break every spec that copies
    # this gate into a throwaway directory and runs it from the real checkout -
    # t/151-coverage-gate-launch-boundary.t does exactly that six times. A
    # temp directory is not a checkout, so requiring BOTH sides to be checkouts
    # leaves those runs untouched and still catches the case that matters.
    my $caller_checkout = _checkout_root( File::Spec->curdir );
    my $repo_checkout   = _checkout_root($repository);

    # COMPARE CASE-INSENSITIVELY WHERE THE FILESYSTEM IS. On Windows and on a
    # case-tolerant macOS volume, C:\proj and c:\proj are ONE directory, and
    # abs_path does not promise a canonical case - so a plain `ne` would report
    # a divergence that does not exist and refuse the gate in its OWN checkout.
    # That is a false refusal: safe in direction (it declines rather than
    # grading the wrong tree) but it would block every legitimate run there.
    #
    # File::Spec->case_tolerant() is FALSE on Linux, so this leaves the
    # behaviour on this host exactly as the specs already measure it.
    my $diverged =
      File::Spec->case_tolerant()
      ? ( lc($caller_checkout) ne lc($repo_checkout) )
      : ( $caller_checkout ne $repo_checkout );

    if ( defined $caller_checkout && defined $repo_checkout && $diverged ) {
        return _unusable(
                  "this gate would grade $repo_checkout, but you are standing in "
                . "$caller_checkout - two different checkouts. Run that checkout's own "
                . 'script/coverage-gate instead, or pass --database explicitly if you '
                . 'really mean to grade the other tree' );
    }

    chdir $repository or return _unusable("cannot enter the repository root $repository: $!");

    my $instrument = _instrument_module();