big-code-analysis 2.3.0

#![allow(
    clippy::enum_glob_use,
    clippy::too_many_lines,
    clippy::wildcard_imports
)]
#![allow(
    clippy::cast_precision_loss,
    clippy::cast_possible_truncation,
    clippy::cast_sign_loss
)]

use super::{Abc, Stats};
use crate::macros::perl_bool_terminal_kinds;
use crate::*;

// Fitzpatrick's ABC rules adapted for Perl.
//
// - Assignments: every assignment operator token — plain `=` plus the
//   compound forms `+=`, `-=`, `*=`, `/=`, `%=`, `**=`, `.=`, `x=`,
//   `&=`, `|=`, `^=`, `<<=`, `>>=`, `&&=`, `||=`, `//=`, and the
//   bitstring forms `&.=`, `|.=`, `^.=`. Each token fires exactly
//   once per textual occurrence inside a `binary_expression`.
// - Branches: every call expression dispatch — `call_expression_with_*`
//   (bareword / spaced args / args-with-brackets / sub / variable /
//   recursive) plus `method_invocation`. The grammar nests an inner
//   `call_expression_with_bareword` (just the function name)
//   underneath the wrapper kinds carrying argument lists, so we only
//   count `CallExpressionWithBareword` when it stands on its own;
//   when its parent is another call form, the outer wrapper has
//   already contributed the branch.
// - Conditions: numeric and string comparison operators (`==`, `!=`,
//   `<`, `>`, `<=`, `>=`, `<=>`, `eq`, `ne`, `lt`, `gt`, `le`, `ge`,
//   `cmp`, `=~`, `!~`), the ternary operator (`TernaryExpression`),
//   and each `elsif` / `else` clause of an `if` / `unless`
//   statement. Bare predicates that have no comparison (e.g.
//   `if ($x)`) are not separately counted; we let the comparison
//   tokens carry the metric, mirroring the Bash / Python token-
//   level approach.
//
//   The short-circuit and low-precedence logical operators (`&&`,
//   `||`, `//`, `and`, `or`, `xor`) are deliberately NOT counted.
//   See the module-level `Stats` doc-comment for the cross-
//   language policy (Fitzpatrick rules mapped from Figure 2 for C,
//   the closest analogue since the paper does not define rules for
//   Perl; issue #395, walker tracked in #403).
// Perl ABC unary-conditional walker (Fitzpatrick Rule 9 mapped from
// Figure 2 for C — the closest analogue, since the paper does not
// define rules for Perl; issue #403). Logical-operator triggers cover
// both the high-precedence punctuation (`&&`, `||`, `//`) and the
// low-precedence keyword forms (`and`, `or`, `xor`). Terminal-bool
// kinds: `Identifier`, `Boolean`, `True`, `False`, the call-expression
// wrappers (every kind already counted as a branch), and the variable
// wrappers (`ScalarVariable`, `ArrayVariable`, `HashVariable` plus the
// access shapes).
fn perl_inspect_container(container_node: &Node, parent: &Node, conditions: &mut f64) {
    // bca: suppress(cognitive, halstead) — wrapper-peeling state machine, clearest whole
    // See `cpp_inspect_container` for the shared rationale: one loop peels
    // `(...)` / `!...` layers while carrying a single boolean-context flag.
    // `halstead` joined the marker in #1464: the five statement-modifier
    // kinds added to the boolean-context seed list took `effort` past the
    // 50000 limit. Every one of those operands is a distinct grammar enum
    // variant in one flat `matches!`, so the number counts node kinds the
    // parser can hand us, not reasoning a reader must do — the same
    // artifact `PerlCode::compute` below already carries the marker for.
    use Perl as P;

    let mut node = *container_node;
    let mut node_kind = node.kind_id().into();
    let parent_kind = parent.kind_id().into();
    // The `*SimpleStatement` kinds are the statement-modifier forms
    // (`return 1 if $x;`), whose `condition` slot is as boolean as the
    // block form's (issue #1464). `ForSimpleStatement` is absent for
    // the same reason `ForStatement2` is: its slot is a list to
    // iterate, not a predicate — the grammar even names that field
    // `list` rather than `condition`.
    let mut has_boolean_content = matches!(
        parent_kind,
        P::BinaryExpression
            | P::IfStatement
            | P::UnlessStatement
            | P::WhileStatement
            | P::UntilStatement
            | P::ForStatement1
            | P::IfSimpleStatement
            | P::UnlessSimpleStatement
            | P::WhileSimpleStatement
            | P::UntilSimpleStatement
            | P::WhenSimpleStatement
    ) || (matches!(parent_kind, P::TernaryExpression)
        && parent
            .child_by_field_name("condition")
            .is_some_and(|condition| condition.id() == node.id()));

    loop {
        // `Array` is tree-sitter-perl's name for the `(...)` shape
        // used BOTH as the if/while/unless/until condition wrapper
        // AND as list literals `(1, 2, 3)` (and `(x, y)` operand
        // groupings). In Perl's scalar context — which every walker
        // call site here operates in — a list expression evaluates
        // to its LAST element, so descending via the last named
        // child gives the semantically correct operand for both
        // shapes: `($a)` → `$a`, `($x, $y)` → `$y`, `if ($a)` →
        // `$a`. `ParenthesizedArgument` (the other paren-wrap kind)
        // has only one inner expression, so child(1) and last-named
        // are equivalent.
        let is_parens = matches!(node_kind, P::ParenthesizedArgument | P::Array);
        // Both spellings of the same negation — see `ruby_inspect_container`
        // for the rationale; Perl has the identical gap (#1182). Read
        // through the grammar's `operator` field, whose type list is
        // `! + ++ - -- and not ~`. Do NOT match the hidden `_unary_not`
        // supertype (`P::UnaryNot`), which the parser never emits
        // (grammar-dispatch item 2).
        let is_not = matches!(node_kind, P::UnaryExpression)
            && node
                .child_by_field_name("operator")
                .is_some_and(|op| matches!(op.kind_id().into(), P::BANG | P::Not));

        if !is_parens && !is_not {
            break;
        }
        if !has_boolean_content && is_not {
            has_boolean_content = true;
        }

        // Descend through the wrapper to the value. Array uses
        // last-named-child (Perl scalar-context value); other
        // wrappers store their inner expression at child(1).
        let next = if matches!(node_kind, P::Array) {
            perl_last_named_child(&node)
        } else {
            node.child(1)
        };
        let Some(child) = next else { break };
        node = child;
        node_kind = node.kind_id().into();

        if matches!(node_kind, perl_bool_terminal_kinds!()) {
            if has_boolean_content {
                *conditions += 1.;
            }
            break;
        }
    }
}

// Phase-2B (issue #403): pass `node.child(idx)` through
// `perl_inspect_container`. Perl wraps `if (cond)` / `while (cond)` /
// `unless (cond)` / `until (cond)` conditions in a
// `parenthesized_argument`, so the paren unwrap handles the
// boolean-literal case.
fn perl_inspect_child(node: &Node, idx: usize, conditions: &mut f64) {
    if let Some(child) = node.child(idx) {
        perl_inspect_container(&child, node, conditions);
    }
}

// Phase-2B helper (issue #403): Perl's `Array` node serves double
// duty as the `(...)` wrapper around `if` / `while` / `unless` /
// `until` conditions AND as the call-argument-list wrapper. The
// dispatcher routes call-argument Arrays through
// `perl_count_unary_conditions`; condition-slot Arrays are
// already unwrapped by `perl_inspect_container`. This predicate
// disambiguates by checking the parent kind.
// Returns the last named child of a node, or None if there are no
// named children. Used by `perl_inspect_container` to descend through
// the `Array` `(...)` wrapper: for a single-element grouping
// `($a)` the last named child is `$a`; for a multi-element list
// literal `($x, $y)` the last named child is `$y` (the value the
// expression evaluates to in Perl's scalar context, which is the
// only context the walker operates in).
fn perl_last_named_child<'a>(node: &Node<'a>) -> Option<Node<'a>> {
    let mut cursor = node.cursor();
    let mut last_named = None;
    if cursor.goto_first_child() {
        loop {
            let child = cursor.node();
            if child.is_named() {
                last_named = Some(child);
            }
            if !cursor.goto_next_sibling() {
                break;
            }
        }
    }
    last_named
}

// Phase-2B (issues #403 / #1102): a ternary's condition and its two
// branch operands are each a Fitzpatrick Rule 9 unary condition, exactly
// as `java_walk_ternary` already counts them. Without this Perl scored
// `$a ? !$b : !$c` as 1 (the `ternary_expression` node alone) against
// Java's 4, and `perl_inspect_container`'s `TernaryExpression`
// boolean-context seed was unreachable.
//
// Slots are addressed by grammar FIELD, not by child index.
// tree-sitter-perl names the branches `true` / `false` rather than the
// C-family `consequence` / `alternative`, and all three slots are
// mandatory — Perl has no short-ternary elision.
//
// The condition goes through `perl_count_condition`, whose top-level
// terminal check is what stops a bare `$a ? … : …` scoring zero:
// `perl_inspect_container` alone only counts *after* unwrapping a
// `(...)` / `!...` layer. Branch operands get no such check: an
// unnegated branch is type-free and contributes nothing, which is what
// keeps `($a > 0) ? $b : -$b` at 2 (the ternary node and the `>`).
fn perl_walk_ternary(node: &Node, conditions: &mut f64) {
    if let Some(condition) = node.child_by_field_name("condition") {
        perl_count_condition(&condition, node, conditions);
    }
    for field in ["true", "false"] {
        if let Some(branch) = node.child_by_field_name(field) {
            perl_inspect_container(&branch, node, conditions);
        }
    }
}

// Classifies one condition-slot expression: a bare boolean terminal
// counts directly, anything else is offered to the `(...)` / `!...`
// unwrap chain. Shared by the ternary condition slot and the C-style
// `for` header's condition slot — the two places a Perl condition
// arrives *unwrapped*. `if` / `while` / `unless` / `until` hand
// `perl_inspect_container` the `(...)` wrapper that supplies the unwrap
// step itself, so they must not take the top-level terminal count.
// Mirrors `cpp_count_condition`.
fn perl_count_condition(condition: &Node, parent: &Node, conditions: &mut f64) {
    if matches!(condition.kind_id().into(), perl_bool_terminal_kinds!()) {
        *conditions += 1.;
    } else {
        perl_inspect_container(condition, parent, conditions);
    }
}

// Phase-2B (issues #403 / #1276): the C-style `for (init; condition;
// update)` header's condition slot is a Fitzpatrick Rule 9 unary
// condition, exactly like the `if` / `while` slots the dispatcher
// already walks. Without this Perl scored `for (my $i = 0; $ok; $i++)`
// zero where `if ($ok)` scores one. Comparison-shaped conditions
// (`$i < $n`) were never affected — the `<` token arm counts those.
//
// The slot is addressed by grammar FIELD (`condition`, beside
// `initializer` and `incrementor`), and an empty condition exposes no
// field, so `for (;;)` counts zero with no special case — see the
// `Stats` doc comment's cross-language empty-`for`-condition policy.
// tree-sitter-perl does not parse an empty *initializer* (`for (; $ok;
// )` becomes an `ERROR`-laden `for_statement_2`), so the three-clause
// spelling is the only one this reaches. `for_statement_2` is the
// `foreach` form and carries no condition.
fn perl_walk_for_statement(node: &Node, conditions: &mut f64) {
    if let Some(condition) = node.child_by_field_name("condition") {
        perl_count_condition(&condition, node, conditions);
    }
}

// Phase-2B (issue #1464): the statement-modifier forms
// `EXPR if COND;` / `unless` / `while` / `until`. Each is its own node
// whose `condition` field is the predicate, so the slot is read by
// grammar FIELD rather than by child index (`.claude/rules/grammar-
// dispatch.md` §3). Perl's cyclomatic dispatcher already counts all
// six modifier kinds, so before this Perl scored `return 1 if $x;`
// zero conditions against `if ($x) { return 1; }`'s one — a straight
// undercount on the idiomatic spelling, not a metric disagreement.
//
// `for_simple_statement` — the sixth modifier kind — is deliberately
// absent: `print $_ for @list;` iterates a list and has no boolean
// test, and the grammar names its field `list`, not `condition`. That
// mirrors the block forms, where `ForStatement1` contributes only its
// C-style header *condition* and the `foreach` shape `ForStatement2`
// contributes nothing.
//
// `when_simple_statement` is listed for parity with the cyclomatic
// dispatcher, which counts all six, but it is untested and unreachable
// from valid Perl: `when` is a statement inside a `given` / `for`
// topicalizer, never a modifier, and `perl -c` rejects
// `print 6 when $x;`. Only error recovery can produce the node, so a
// fixture would pin the grammar's present over-permissiveness as the
// contract (`.claude/rules/grammar-dispatch.md` §6).
//
// `_if_simple` (`Perl::IfSimple`) is a hidden rule and gets no arm —
// the parser inlines it, emitting the `if` token directly beneath
// `if_simple_statement` (§2, verified with `bca dump`).
//
// The `condition` field holds an `_argument_choice`: either a
// `parenthesized_argument`, which `perl_inspect_container` already
// peels, or a bare `arguments` wrapper, which it does not. Peel the
// `arguments` layer here — via the same last-named-child rule the
// `Array` `(...)` wrapper uses, since a Perl comma list evaluates to
// its last element in the scalar context a condition imposes — and
// hand what it holds to the shared condition classifier.
//
// Three of the four paths below are unreachable or unobservable at the
// pinned grammar, and are spelled as `Option` rather than as an
// `expect` because `AGENTS.md` bans the latter outside tests. Do not
// try to cover them:
//
// - `condition` is a required field on all five modifier productions
//   (node-types.json), so the early `return` needs error recovery.
// - The `else` arm takes a `parenthesized_argument`, which the parser
//   emits in this slot only for the *empty* spelling `EXPR if ();`
//   (valid Perl; anything with content resolves to `arguments`
//   wrapping an `array`). An empty wrapper peels to nothing, so that
//   arm and a bare `None` score alike — measured by perturbation, not
//   assumed. A test would pin a value neither branch decides.
// - `perl_last_named_child` returns `None` only for an `arguments`
//   node with no named child, which the grammar's comma-separated
//   one-or-more list cannot produce.
fn perl_walk_statement_modifier(node: &Node, conditions: &mut f64) {
    let Some(condition) = node.child_by_field_name("condition") else {
        return;
    };
    let slot = if matches!(condition.kind_id().into(), Perl::Arguments) {
        perl_last_named_child(&condition)
    } else {
        Some(condition)
    };
    if let Some(slot) = slot {
        perl_count_condition(&slot, node, conditions);
    }
}

fn perl_is_call_argument_parent(parent: Node) -> bool {
    use Perl as P;
    matches!(
        parent.kind_id().into(),
        P::CallExpressionWithArgsWithBrackets
            | P::CallExpressionWithSpacedArgs
            | P::CallExpressionWithSub
            | P::CallExpressionWithVariable
            | P::CallExpressionRecursive
            | P::MethodInvocation
    )
}

fn perl_count_unary_conditions(list_node: &Node, conditions: &mut f64) {
    use Perl as P;

    let list_kind = list_node.kind_id().into();
    let mut cursor = list_node.cursor();

    if cursor.goto_first_child() {
        loop {
            let node = cursor.node();
            let node_kind = node.kind_id().into();

            if matches!(node_kind, perl_bool_terminal_kinds!())
                && matches!(list_kind, P::BinaryExpression)
            {
                *conditions += 1.;
            } else if node.is_named() {
                perl_inspect_container(&node, list_node, conditions);
            }

            if !cursor.goto_next_sibling() {
                break;
            }
        }
    }
}

impl Abc for PerlCode {
    fn compute<'a>(
        node: &Node<'a>,
        _code: &'a [u8],
        ancestors: Ancestors<'a, '_>,
        stats: &mut Stats,
    ) {
        // bca: suppress(halstead, cyclomatic)
        // Exhaustive one-arm-per-grammar-kind dispatch table; see the
        // rationale on `CppCode::compute`, which carries both markers
        // for the same construct, as do `CCode`, `ObjcCode` and
        // `MozcppCode`. Perl's arm list is the longest of the family —
        // tree-sitter-perl tokenises all nineteen assignment operators
        // and all six call-expression wrappers separately — so
        // `halstead.effort` here is a count of distinct enum operands,
        // and the cyclomatic count is the number of node kinds the
        // grammar can hand us, neither being reasoning a reader must
        // do. Adding the guarded `<` / `>` arm for #1297 took the
        // count from 14 to 15, and the statement-modifier arm for
        // #1464 from 15 to 16; each arm is independent and
        // self-describing like every other, and there is no semantic
        // boundary to split this lookup on.
        use Perl as P;

        match node.kind_id().into() {
            // Plain `=` and every compound assignment operator. The
            // grammar tokenises each operator separately, so one
            // textual `+=` produces exactly one token and there is no
            // double-counting via a wrapper.
            P::EQ
            | P::PLUSEQ
            | P::DASHEQ
            | P::STAREQ
            | P::SLASHEQ
            | P::PERCENTEQ
            | P::STARSTAREQ
            | P::DOTEQ
            | P::XEQ
            | P::AMPEQ
            | P::PIPEEQ
            | P::CARETEQ
            | P::LTLTEQ
            | P::GTGTEQ
            | P::AMPAMPEQ
            | P::PIPEPIPEEQ
            | P::SLASHSLASHEQ
            | P::AMPDOTEQ
            | P::PIPEDOTEQ
            | P::CARETDOTEQ => {
                stats.assignments += 1.;
            }
            // Argument-bearing call wrappers always count.
            P::CallExpressionWithSpacedArgs
            | P::CallExpressionWithSub
            | P::CallExpressionWithArgsWithBrackets
            | P::CallExpressionWithVariable
            | P::CallExpressionRecursive
            | P::MethodInvocation => {
                stats.branches += 1.;
            }
            // Bareword-only call (`shift`, `time`, …) — count only
            // when this node is the outermost dispatch site. When the
            // bareword sits inside one of the wrappers above, the
            // outer node has already been counted and this child
            // would double the branch tally.
            P::CallExpressionWithBareword
                if !ancestors.parent(node).is_some_and(|p| {
                    matches!(
                        p.kind_id().into(),
                        P::CallExpressionWithSpacedArgs
                            | P::CallExpressionWithSub
                            | P::CallExpressionWithArgsWithBrackets
                            | P::CallExpressionWithVariable
                            | P::CallExpressionRecursive
                    )
                }) =>
            {
                stats.branches += 1.;
            }
            // Numeric, string, and pattern-match comparison operators
            // plus the spaceship / `cmp` three-way comparisons, and each
            // `elsif` / `else` clause of an `if` / `unless` chain.
            P::EQEQ
            | P::BANGEQ
            | P::LTEQ
            | P::GTEQ
            | P::LTEQGT
            | P::Eq
            | P::Ne
            | P::Lt
            | P::Gt
            | P::Le
            | P::Ge
            | P::Cmp
            | P::EQTILDE
            | P::BANGTILDE
            | P::ElsifClause
            | P::ElseClause => {
                stats.conditions += 1.;
            }
            // Counts `<` / `>` only as the operator token of a
            // `binary_expression`, the allowlist polarity the rest of
            // the workspace uses. Ungated, a readline scored two
            // conditions: `<FH>` and `<$fh>` are
            // `standard_input_to_identifier` and
            // `standard_input_to_variable`, each a plain three-token
            // sequence whose brackets are the same bare `<` / `>` a
            // comparison uses. A `grammar.json` sweep of
            // tree-sitter-perl 1.1.2 finds them in exactly three
            // productions — `binary_expression` plus those two — so the
            // gate is closed (`.claude/rules/grammar-dispatch.md` §1).
            //
            // `<STDIN>` is *not* among them: the grammar lexes it as a
            // single `standard_input` token, which is why #1297's sweep
            // measured Perl at 0 and wrongly cleared it. The filehandle
            // and lexical-handle forms are the reachable ones.
            // `<=` / `>=`, the spaceship `<=>` and the word-form `lt` /
            // `gt` are distinct tokens counted above, and a heredoc
            // opener is its own token, so none reaches this arm.
            P::LT | P::GT if ancestors.parent_has_kind(node, P::BinaryExpression as u16) => {
                stats.conditions += 1.;
            }
            // Fitzpatrick Rule 9 walker: each operand of a Perl
            // short-circuit / low-precedence logical chain is one
            // condition (issue #403). Covers `&&`, `||`, `//`,
            // `and`, `or`, `xor`.
            P::AMPAMP | P::PIPEPIPE | P::SLASHSLASH | P::And | P::Or | P::Xor => {
                if let Some(parent) = ancestors.parent(node) {
                    perl_count_unary_conditions(&parent, &mut stats.conditions);
                }
            }
            // Phase-2B (issue #403): condition slots. Perl wraps
            // `if (cond)` / `while (cond)` / `unless (cond)` /
            // `until (cond)` in the `Array` `(...)` shape (the
            // grammar's name for parenthesized expressions in
            // statement-modifier slots) — the paren unwrap handles
            // boolean-literal cases. Condition sits at child(1)
            // (child(0) is the `if` / `while` keyword).
            // `return value`'s value also sits at child(1); merged
            // into the same arm body to satisfy `match_same_arms`.
            P::IfStatement
            | P::UnlessStatement
            | P::WhileStatement
            | P::UntilStatement
            | P::ReturnExpression => {
                perl_inspect_child(node, 1, &mut stats.conditions);
            }
            // `call(!$a, !$b)` — argument list walker. Perl wraps
            // call-argument lists in an `Array` node (same kind name
            // as the `(...)` wrapper around `if` / `while`
            // conditions). To avoid re-handling condition slots that
            // were already walked through inspect_container, only
            // dispatch when the parent is a call-expression form.
            P::Array
                if ancestors
                    .parent(node)
                    .is_some_and(perl_is_call_argument_parent) =>
            {
                perl_count_unary_conditions(node, &mut stats.conditions);
            }
            // `$a ? !$b : !$c`. Unlike the C family, this dispatcher
            // has no `?`-token arm — the grammar emits the token, but
            // the `ternary_expression` node is what carries the
            // condition tally's +1 — so this arm keeps that increment
            // and adds the three operand slots (issue #1102).
            P::TernaryExpression => {
                stats.conditions += 1.;
                perl_walk_ternary(node, &mut stats.conditions);
            }
            // `for (init; cond; update)` — the condition slot, read by
            // grammar field (issue #1276). `for (;;)` has no condition
            // field and counts nothing.
            P::ForStatement1 => {
                perl_walk_for_statement(node, &mut stats.conditions);
            }
            // Statement modifiers — `return 1 if $x;`, `next unless $ok;`
            // (issue #1464). See `perl_walk_statement_modifier` for why
            // `for_simple_statement` is not in this list.
            P::IfSimpleStatement
            | P::UnlessSimpleStatement
            | P::WhileSimpleStatement
            | P::UntilSimpleStatement
            | P::WhenSimpleStatement => {
                perl_walk_statement_modifier(node, &mut stats.conditions);
            }
            _ => {}
        }
    }
}