view release on metacpan or  search on metacpan

t/45-options-before-positionals.t  view on Meta::CPAN

require_git_c();
use File::Temp qw( tempdir );
use Cwd qw( abs_path getcwd );
use IPC::Open3 qw( open3 );
use Symbol qw( gensym );
use JSON::MaybeXS qw( decode_json );

# Regression tests for karr board ticket #13.
#
# BUG: options placed before (or interleaved around) positional arguments
#     break arg parsing, sometimes opaquely: `karr archive --json 1` crashes
#     ($args_ref->[0] is "--json", parse_ids/find_task choke on it), `karr
#     handoff --claim X 1` treats "--claim" itself as the ID. MooX::Cmd
#     echoes parsed option flags AND their consumed values back into argv, so
#     every id-taking command that reads $args_ref->[0]/[1] directly (rather
#     than through an extractor that understands which tokens are option
#     values) is exposed to this.
#
# DESIGN (recorded on ticket #13 after sondation, `karr show 13`): cobra
#     parity instead of reject -- flags may appear before, between, or after
#     positionals. A central extractor (landing in Role::BoardAccess, using
#     MooX::Options' _options_data: format=s options consume the following
#     token as a value unless given as --opt=value; flag-only options consume
#     nothing) yields the real positionals. The seven #11 commands (show,
#     archive, delete, edit, handoff, move, create) read positionals only via
#     that extractor; check_positional_args (also from #11/t43) then counts
#     real positionals instead of the leading dash-free run. Config/SetRefs/
#     GetRefs keep their own arg shapes and are out of scope.
#
# None of this is implemented yet (no lib/ changes accompany this test).
#
# Expected colour map, confirmed by hand against the current tree (VERSION
# 0.304, pre-#13-fix) before writing the assertions below:
#
#   RED  (must turn GREEN once #13 lands):
#     - all five "options-first" subtests in section (a)
#     - the "--opt=value" subtest in section (b) -- `handoff --claim=tester 1`
#       *also* currently dies ("Task --claim=tester not found"): MooX::Cmd
#       echoes the unsplit "--claim=tester" token verbatim, it is never
#       recognised as an option at all today.
#     - two of the four "Bestandsgarantien" bullets named on the ticket are
#       NOT actually green on the current tree, contrary to the ticket text
#       (verified by direct CLI probing, see subtests below for detail):
#         * `show --last 2` dies today ("Task --last not found") -- Show
#           unconditionally reads $args_ref->[0] as the id positional even
#           though there are zero real positionals here.
#         * `archive --json 1 99` does not reject 99 today (no
#           "unexpected extra argument" diagnostic fires at all -- it never
#           reaches check_positional_args' reject path); AND
#           `archive 1 --json 99` actively regresses -- it exits 0 and
#           archives task 1, *silently dropping* the extra "99", because
#           today's leading-dash-free-run count stops at "--json" and never
#           sees the trailing "99". Both are pinned here as the desired
#           post-#13 contract (reject, no side effect), not as already-green.
#     These are reported honestly below rather than soft-pedalled to match
#     the ticket's colour claims; only `move 1 --next --claim tester` and
#     `create --title T` / `create T Extra` were confirmed genuinely green
#     on the current tree.
#
#   GREEN today (must stay green -- true "Bestandspins"):
#     - `edit 1 --append-body "--weird"` (value that looks like a flag)
#     - `move 1 --next --claim tester`
#     - `create --title T` / `create T Extra`
#
# STDERR assertions for the extra-args-rejection subtests use the same
# `qr/\bTOKEN\b|usage/i` shape as t/43 (mentions the offending token, or a
# usage-style message).

my $ROOT = abs_path('.');
my $BIN  = "$ROOT/bin/karr";

sub _run_karr {
    my ( $cwd, @argv ) = @_;
    my $old = getcwd();
    chdir $cwd or die "chdir $cwd: $!";

    my $stderr = gensym;
    my $pid = open3(
        undef,
        my $stdout_fh,
        $stderr,
        $^X,
        "-I$ROOT/lib",
        $BIN,
        @argv,
    );

    my $stdout = do { local $/; <$stdout_fh> };
    my $stderr_text = do { local $/; <$stderr> };
    waitpid( $pid, 0 );
    my $exit = $? >> 8;

    chdir $old or die "chdir $old: $!";

    return {
        exit   => $exit,
        stdout => defined $stdout ? $stdout : '',
        stderr => defined $stderr_text ? $stderr_text : '',
    };
}

sub _git_ok {
    my (@cmd) = @_;
    my $rc = system(@cmd);
    is( $rc, 0, "@cmd" );
}

# Fresh isolated temp repo per subtest, never the developer's real board.
sub _setup_repo {
    my $repo = tempdir( CLEANUP => 1 );
    _git_ok( 'git', 'init', '-q', $repo );
    _git_ok( 'git', '-C', $repo, 'config', 'user.email', 'test@example.com' );
    _git_ok( 'git', '-C', $repo, 'config', 'user.name', 'Test User' );

    my $init = _run_karr( $repo, 'init', '--name', 'Options-Before-Positionals Board' );
    is( $init->{exit}, 0, 'karr init succeeds' ) or diag $init->{stderr};

    return $repo;
}

# Seeds tasks 1..$n, titled "Task 1".."Task $n", all in the given status