diff --git a/Cargo.lock b/Cargo.lock index e882dd65..48246950 100644 --- a/Cargo.lock +++ b/Cargo.lock @@ -676,6 +676,7 @@ dependencies = [ "paredit-feature-lint-build-system", "paredit-feature-lint-call-shape", "paredit-feature-lint-clojure-idiom", + "paredit-feature-lint-compile-time", "paredit-feature-lint-concurrency", "paredit-feature-lint-condition-system", "paredit-feature-lint-conditional", @@ -1010,6 +1011,17 @@ dependencies = [ "serde_json", ] +[[package]] +name = "paredit-feature-lint-compile-time" +version = "1.4.0" +dependencies = [ + "clap", + "paredit-core-cli", + "paredit-core-lint-engine", + "paredit-core-syntax", + "serde_json", +] + [[package]] name = "paredit-feature-lint-concurrency" version = "1.4.0" diff --git a/Cargo.toml b/Cargo.toml index 2d4d60cd..8dfcbc93 100644 --- a/Cargo.toml +++ b/Cargo.toml @@ -144,6 +144,7 @@ paredit-feature-lint-clojure-idiom = { path = "packages/feature/lint-clojure-idi paredit-feature-lint-scheme-idiom = { path = "packages/feature/lint-scheme-idiom" } paredit-feature-lint-fennel-janet-idiom = { path = "packages/feature/lint-fennel-janet-idiom" } paredit-feature-lint-type-declaration = { path = "packages/feature/lint-type-declaration" } +paredit-feature-lint-compile-time = { path = "packages/feature/lint-compile-time" } paredit-feature-emacs-lisp = { path = "packages/feature/emacs-lisp" } paredit-feature-conditional-conversion = { path = "packages/feature/conditional-conversion" } paredit-feature-external-check = { path = "packages/feature/external-check" } diff --git a/docs/src/guide/agents.md b/docs/src/guide/agents.md index 277ffbda..3bacfa65 100644 --- a/docs/src/guide/agents.md +++ b/docs/src/guide/agents.md @@ -30,7 +30,7 @@ paredit mcp --read-only # …that refuses every command which would write The server offers a handful of tools — `paredit_check`, `paredit_outline`, `paredit_lint`, `paredit_format`, `paredit_diff`, `paredit_capabilities` — plus `paredit_run`, which takes any command's argument vector. **It deliberately does -not expose one tool per command.** There are 460 of them; that many descriptions +not expose one tool per command.** There are 463 of them; that many descriptions costs thousands of tokens of context before the agent has read a line of code, and it makes selection harder rather than easier. The catalog is available as the `paredit://capabilities` resource, and `paredit_run` reaches everything in @@ -113,8 +113,8 @@ Each cell carries one of four statuses: `silent` is the one worth reading carefully. Almost every `inspect` command exits `0` for every dialect, so a `finding_count` of `0` looks identical -whether the code is clean or the tool has nothing to say about it. 281 of the -460 commands are `silent` for at least one dialect outside Common Lisp, and +whether the code is clean or the tool has nothing to say about it. 284 of the +463 commands are `silent` for at least one dialect outside Common Lisp, and fourteen of those are `silent` for Common Lisp *itself*, because their subject is another dialect entirely: `inspect elisp-file` and `inspect division-result-precision-loss` (Emacs Lisp); diff --git a/docs/src/reference/api.md b/docs/src/reference/api.md index cb9ce1e1..aae4a732 100644 --- a/docs/src/reference/api.md +++ b/docs/src/reference/api.md @@ -407,6 +407,9 @@ discovery, impact analysis, and preflight checks. | `scheme-let-star-independent-bindings` | Report a `let*` of two or more bindings whose initializers are all literals or free references, so no binding can see another and the sequential scope buys nothing. Scheme and Racket, **fixable** (only the head symbol is rewritten). | | `scheme-memq-assq-literal-key` | Report a `memq` or `assq` searching for a number or character literal, which R7RS 6.4 leaves unspecified: `(memq 101 '(100 101 102))` ⟹ *unspecified* while `(memv 101 …)` ⟹ `(101 102)`. Scheme only — Racket specifies both cases, so a finding there would complain about code the language promises will work. **Fixable** (`memq`→`memv`, `assq`→`assv`, which cannot break a working search). | | `scheme-named-let-never-recurs` | Report a named `let` whose loop name is never mentioned in its body, so it can never iterate and is an ordinary `let` wearing a loop's clothes. Scheme and Racket, **fixable** where the name can simply be deleted. | +| `eval-when-execute-only` | Report a **top-level** `eval-when` naming `:execute` but neither `:compile-toplevel` nor `:load-toplevel`, wrapping a definition: `compile-file` discards the body entirely, so the file loads from source and the compiled fasl is missing the definition. Error severity, Common Lisp only, report-only (which situations were meant is not recoverable from the source). | +| `eval-when-body-never-runs` | Report a **non**-top-level `eval-when` naming only situations the standard ignores there, so its body runs in no phase at all. CLHS 3.2.3.1 makes such a form equivalent to `nil`, and SBCL emits no diagnostic. Error severity, Common Lisp only, report-only (whether `:execute` was meant, or the form wanted hoisting, or deleting, is a judgement). | +| `defconstant-non-eql-value` | Report a `defconstant` whose initform allocates (a string, list, vector or structure literal), so the compile-time and load-time values are not `eql` and a fresh image that compiles and loads the file signals `DEFCONSTANT-UNEQL`. Error severity, Common Lisp only, report-only (`defparameter`, or `define-constant` with which `:test`, is the author's call). | | `lint` | Run every within-file logic-bug lint at once and report all findings, tagged by rule and category. Each finding is self-describing — it carries its `severity`, `category`, and a `fixable` flag inline (so an agent can triage and decide whether to run `--fix` without cross-referencing `--list-rules`). `--list-rules` prints the rule catalog with categories, descriptions, a `severity` (`error` for likely/certain bugs, `warning` for redundant/non-idiomatic style), and a `fixable` flag marking the rules `--fix` can repair — and it honors the same `--rule`/`--exclude`/`--category` selectors, so `--list-rules --category dead-code` lists just that group; `--rule`/`--exclude` select rules; `--category` selects a whole group (see `--list-rules` for the current set); `--sarif` emits a SARIF 2.1.0 log for CI code scanning (with stable fingerprints and one-click `fixes` for every rule `--list-rules` marks fixable); `--github` emits GitHub Actions `::error::` annotations for inline PR review; `--fix` applies those auto-fixes in place, iterating to a fixpoint (so nested redundancies collapse fully) and reporting the per-file/per-rule counts; add `--diff` to preview the changes as a unified diff without writing, or `--check` to write nothing and exit 3 when any auto-fix is still pending (a CI gate that stays green only when fixable lint has been cleaned up — distinct from `--fail-on-finding`, which also gates on report-only findings). `--check` and `--diff` combine (show the diff and fail). `--fix-plan` instead emits the machine-readable fix plan — each fixable finding's exact byte-region replacements as JSON (or tab-separated text) — without writing, so an editor or agent can preview or apply fixes one at a time (honoring the same suppressions and `--baseline` as `--fix`). Findings can be silenced in source with an inline `; paredit:ignore [rule…]` comment: on its own line it suppresses the next line, trailing after code it suppresses that line, and with no rule names it suppresses every rule — honored uniformly across the report, SARIF, GitHub, and `--fix` outputs. `--fail-on ` gates only on findings at or above a severity (so CI can block on bugs while still reporting style warnings), and SARIF `level` reflects each finding's severity. `--stats` prints a lint-debt rollup instead of individual findings — finding counts by severity, by category, and by rule, plus files-scanned/files-with-findings — honoring the same `--rule`/`--category`/`--baseline` filters. `--suggest-severity` instead prints advisory severity suggestions: for each rule that fired, its findings-per-file density across the scanned workspace (`very high`/`high`/`moderate`/`low`/`very low`), and — only when that disagrees with the rule's current severity — the severity it suggests instead (a currently-`error` rule firing on nearly every file is likely too noisy to gate a build on; a currently-`warning` rule that never fired at all may be rare enough to be worth failing over). This is guidance only: it never writes `paredit.toml`, never changes a rule's declared severity, and never affects this or any later run's exit code. `--report-unused-suppressions` instead reports any `; paredit:ignore` that silences no finding (a stale ignore or a typo'd rule name) and exits 3 if any are found, keeping the ignore list honest in CI. A directive may also carry `-until `; `--report-expired-suppressions` reports any past its date (used or not) and exits 3 if any are found, and `--report-suppressions` lists every directive, used or not, with its scope, rules, reason, and expiry, and always exits 0. `--suppress-path ` (repeatable) silences every finding under a path as if it carried `paredit:ignore-file`, for generated/vendored code that cannot hold an inline directive. For adopting the linter on an existing codebase, `--write-baseline ` snapshots today's findings and `--baseline ` then suppresses those known findings (matched by rule and trimmed-line content, so they survive line shifts) — reporting and gating only on new findings, across the default, `--sarif`, and `--github` outputs. `--fixable` narrows `--list-rules` to just the rules that carry an auto-fix — `paredit fix list` is this pair under a name that says so. | Most reports accept `--output json` for machine-readable results. Reports whose @@ -421,7 +424,7 @@ adds each finding's full field set as indented lines under its row. ### Choosing and tuning lint rules -With 313 rules, `inspect lint` needs more than an on/off switch per rule. The +With 316 rules, `inspect lint` needs more than an on/off switch per rule. The flags below are about the rule *set* rather than about any one rule, and all of them work with `--list-rules` as well as with a scan — so a run can be inspected before it is made. @@ -446,7 +449,7 @@ key for baselines and suppression tooling. ### Rules a project writes for itself -The 313 shipped rules are the ones everybody gets. A rule like "in *this* +The 316 shipped rules are the ones everybody gets. A rule like "in *this* codebase, `defentity` must always be given a `:table`" is the majority of what a mature project wants and none of what a linter can ship, so a project writes those itself, in Lisp, in `.paredit/rules/*.lisp`: diff --git a/docs/src/reference/architecture.md b/docs/src/reference/architecture.md index a971ebc5..1bd1cecb 100644 --- a/docs/src/reference/architecture.md +++ b/docs/src/reference/architecture.md @@ -1,6 +1,6 @@ # Architecture -`paredit-cli` is a Cargo workspace: a thin composition root plus 64 packages +`paredit-cli` is a Cargo workspace: a thin composition root plus 65 packages under `packages/core/` and `packages/feature/`. Knowing which package owns a thing is the fastest way to know where a change belongs. @@ -17,7 +17,7 @@ core/syntax ──▶ core/semantics ──▶ core/edit ──▶ core/cli └──▶ core/workspace core/lint-engine ──┘ │ ▼ - feature/* (55 packages, mostly independent of each other) + feature/* (56 packages, mostly independent of each other) │ ▼ paredit-cli (command tree, dispatch, REGISTRY) @@ -65,10 +65,10 @@ src/ A contract test walks `src/` and refuses anything else. The lint `REGISTRY` is the canonical example of what *must* live here. It names -all 313 rules, and every rule depends on the engine; putting the registry in +all 316 rules, and every rule depends on the engine; putting the registry in either would be a cycle. So the engine takes a `RuleCatalog` as an argument and never learns which rules exist, the rules never learn the registry does, and -the registry sits in the root reaching thirty feature packages for their +the registry sits in the root reaching thirty-one feature packages for their `META` and `RULE`. That is the criterion: **a module that enumerates or aggregates several features** belongs in neither core nor any one feature. @@ -127,7 +127,7 @@ semantic enum (`ReportLimit::{Complete, Limited(NonZeroUsize)}`, Derive redundant presentation values (booleans, counts) at the serialization boundary instead of storing them. -## Lint rules: one trait, one registry line, thirty packages +## Lint rules: one trait, one registry line, thirty-one packages The lint suite is the clearest example of the split's shape, and the most frequently extended part of the tree. @@ -141,8 +141,8 @@ frequently extended part of the tree. | `policy` | Dialect scope, rule selection and gate decisions: logic that needs no tree. | | `engine` | The single pass, which walks the document once and dispatches each node to every rule whose `head_filter` matches. | -308 of the 313 shipped rules live in twenty-nine themed packages, split seven -ways. A thirtieth, `feature/lint-custom`, holds no rules at all: it is the +311 of the 316 shipped rules live in thirty themed packages, split seven +ways. A thirty-first, `feature/lint-custom`, holds no rules at all: it is the pattern language and the second pass that run the rules a *project* writes for itself. @@ -321,7 +321,7 @@ specifies the two cases R7RS 6.4 leaves open — fixnums compare `eq?` by guarantee and characters have been normatively `eq?` since 9.0.0.10 — so every finding there would complain about code the language promises will work. -**`REGISTRY` is in neither.** It names all 313 rules, and every rule depends on +**`REGISTRY` is in neither.** It names all 316 rules, and every rule depends on the engine, so putting it in the engine or in a rule package would be a cycle. It sits in the root crate, and the engine receives a `RuleCatalog` as an argument — which is why the engine can be a package at all. diff --git a/docs/src/reference/configuration.md b/docs/src/reference/configuration.md index fa22da54..fffb16d9 100644 --- a/docs/src/reference/configuration.md +++ b/docs/src/reference/configuration.md @@ -1,6 +1,6 @@ # Configuration -With 313 lint rules and 460 commands, passing every knob as a flag +With 316 lint rules and 463 commands, passing every knob as a flag stopped scaling. `paredit.toml` is the answer: a small, strictly validated file that sets the defaults a repository wants, so a command line carries only what is unusual about *this* invocation. @@ -194,7 +194,7 @@ and the dropped keys are named. | `--from ` | — | Resolve discovery from this directory instead of the working one | The flags exist on the `config` namespace; the variables work everywhere, -which is why they exist — 460 commands do not each need three more flags. +which is why they exist — 463 commands do not each need three more flags. `PAREDIT_NO_CONFIG=1 PAREDIT_NO_CONFIG_ENV=1` is the reproducible-CI combination: it pins the run to the built-in defaults plus whatever the command diff --git a/packages/feature/lint-compile-time/Cargo.toml b/packages/feature/lint-compile-time/Cargo.toml new file mode 100644 index 00000000..ac16878c --- /dev/null +++ b/packages/feature/lint-compile-time/Cargo.toml @@ -0,0 +1,22 @@ +[package] +name = "paredit-feature-lint-compile-time" +description = "Lint rules for the Common Lisp compile-time / load-time phase distinction" +readme = "README.md" +publish = false +version.workspace = true +edition.workspace = true +rust-version.workspace = true +license.workspace = true +repository.workspace = true + +[dependencies] +paredit-core-syntax = { path = "../../core/syntax" } +paredit-core-lint-engine = { path = "../../core/lint-engine" } +paredit-core-cli = { path = "../../core/cli" } +clap.workspace = true +serde_json.workspace = true + +# Mandatory: without it this package silently opts out of the workspace lint +# table, including `unsafe_code = "deny"`, with no error at all. +[lints] +workspace = true diff --git a/packages/feature/lint-compile-time/README.md b/packages/feature/lint-compile-time/README.md new file mode 100644 index 00000000..bc8e41c2 --- /dev/null +++ b/packages/feature/lint-compile-time/README.md @@ -0,0 +1,257 @@ +# paredit-feature-lint-compile-time + +Lint rules for the Common Lisp compile-time / load-time phase distinction. + +## Responsibilities + +Three rules about the gap between what a file does when you `load` it and what +it does when you `compile-file` it — the gap the phrase "it works in the REPL +but not from a compiled file" names. + +| Rule | Flags | +| --- | --- | +| `eval-when-execute-only` | a **top level** `eval-when` naming `:execute` but neither `:compile-toplevel` nor `:load-toplevel`, wrapping a definition — `compile-file` discards the body entirely | +| `eval-when-body-never-runs` | a **non**-top-level `eval-when` naming only situations the standard ignores there, so its body never runs in any phase | +| `defconstant-non-eql-value` | a `defconstant` whose initform allocates, so the compile-time and load-time values are not `eql` | + +That list is the package's real specification: §5.2.2 splits by subject matter, +so naming the rules is the only way to say why one belongs here. + +Every rule is Common Lisp only (the default `RuleDialectScope`), every rule is +`Fixability::ReportOnly`, and every rule is `HeadFilter::Heads` — never +`WholeTree`, never `AllNodes`. No rule touches +`RuleContext::binding_table`/`value_table`/`type_table`, and none touches +`RuleContext::scratch_cache` (see below). + +| Rule | Category | Severity | Heads | +| --- | --- | --- | --- | +| `eval-when-execute-only` | `Suspicious` | `Error` | `["eval-when"]` | +| `eval-when-body-never-runs` | `DeadCode` | `Error` | `["eval-when"]` | +| `defconstant-non-eql-value` | `Suspicious` | `Error` | `["defconstant"]` | + +The two `eval-when` rules share a head and are complements, not duplicates: one +fires only at top level and only when both top-level situations are absent, the +other only away from top level and only when `:execute` is absent. No form can +satisfy both, and `eval_when_body_never_runs/rule.rs` pins that with a test +that runs both rules over nine shapes and asserts at most one finding each. + +## What every claim here was checked against + +Every premise was run through SBCL 2.6.0 under **both** `load` of the source and +`compile-file` followed by `load` of the fasl, in a fresh subprocess per case. +The three rules that shipped are the ones where those two phases disagree, or +where the form is dead in both and nothing says so. + +| shape | `load` source | `compile-file` + load fasl | +| --- | --- | --- | +| `(eval-when (:execute) (defmacro m …))` | works | **undefined function** at run time | +| `(eval-when (:load-toplevel :execute) (defmacro m …))` | works | works | +| `(eval-when (:compile-toplevel :load-toplevel :execute) …)` | works | works | +| `(defun f () (eval-when (:compile-toplevel) (setf *m* :fired)))` | **never runs** | **never runs** | +| `(defconstant +x+ #("a" "b"))` | works | **`DEFCONSTANT-UNEQL`** | + +The third row is why neither rule keys on "the situation list is missing +`:compile-toplevel`", which is the obvious predicate and is wrong: `defmacro`'s +own expansion carries an inner `(eval-when (:compile-toplevel) …)`, and CLHS +3.2.3.1 keeps the body of a top-level `eval-when` top level, so the inner one +runs at compile time regardless. A rule written against the obvious predicate +would fire on every `(eval-when (:load-toplevel :execute) …)` in the world. + +## Top level is a recursion, not a depth + +CLHS 3.2.3.1 defines a top level form by recursion: the body of a top-level +`progn`, `locally`, `macrolet`, `symbol-macrolet` or `eval-when` is itself +processed as top level. `support::is_top_level_form` enumerates those five +operators, and enumerates the child index at which each one's *body* begins — +an `eval-when`'s situations list and a `macrolet`'s bindings list are inside the +form but are not body, and a candidate found in one of them is not a top level +form. + +Both halves matter. Getting the operator list wrong produces false positives on +`(locally …)` and `(macrolet () …)`, which is a failure an earlier batch in this +repository shipped. Getting the body index wrong is subtler: it only shows up +when a non-body position happens to contain a list whose head is itself one of +the five, and mutation testing caught that the obvious test cases never reach +it. + +## Cost + +`HeadFilter::Heads` throughout, so the `clean/forms/*` benchmark — whose 10% +threshold has failed this project five times — dispatches **nothing**. Measured: +0 invocations of all three rules over a 200-unit and a 400-unit clean corpus +containing no `eval-when` and no `defconstant`. That is a structural result, not +a timing one: the head index answers before `check` is reached. + +Inside `check`, every rule answers a **node-local** question first — the +situation list, or the initform's shape — and only a node that has already +failed that reaches `is_top_level_form`, which materializes the enclosing +top-level form. That ordering is the whole cost model. A sibling package +measured 450843 ns/call against 28 ns/call purely from asking the tree question +before the cheap one, and each rule's `rule.rs` restates its own ordering. + +`is_top_level_form` binary-searches the top level using +`SyntaxTree::root_child_span`, which is an index into a slice and a field read. +The equivalent-looking `select_path(&Path::root_child(i))?.span()` builds an +`ExpressionPath`, which owns a `Vec`, so it would heap-allocate on every step of +the search rather than once at the end. + +Measured on a 131050-byte file with 400 `eval-when` and 400 `defconstant` forms, +debug profile, against shipped rules on the identical file: + +| rule | ns/invocation | doubling ratio | +| --- | --- | --- | +| `defconstant-non-eql-value` | 195 | ×1.94 | +| `eval-when-body-never-runs` | 518 | ×1.96 | +| `eval-when-execute-only` | 547 | ×1.94 | +| *shipped* `self-recursive-tail-call` | 244 | — | +| *shipped* `macro-deep-quasiquote-nesting` | 13445 | — | +| *shipped* `duplicate-defmethod-signature` | 1248688 | — | + +## `RuleContext::scratch_cache` is not available to this package + +It looks like the right home for a shared per-file computation. It is not +usable: the slot holds **one type per file's pass**, and +`paredit-feature-lint-repl-debug` already stores its evaluated-forms walk there +(`packages/feature/lint-repl-debug/src/support.rs:612`). A second caller with a +different `T` *panics* rather than missing the cache, and `inspect lint` runs +every rule on every file, so the two would meet on the first file with both a +candidate here and a REPL-debug candidate. Any future rule here that wants a +per-file table must pay its own way or promote the slot to a `TypeId`-keyed map +first. + +## What this package does not own, and four rules deliberately not written + +Each of these was proposed, investigated against SBCL 2.6.0, and **dropped** on +the evidence. + +- **No `macro-used-before-defined-in-file` rule.** The premise was that a + `defmacro` below its call site works under `load` and breaks under + `compile-file`. Measured: it breaks under **both**, identically, and SBCL + names the cause precisely in both — `MY-MAC is being redefined as a macro when + it was previously assumed to be a function`, followed by a hard + `UNDEFINED-FUNCTION` at run time. A lint rule would restate a diagnostic the + compiler already gives at the exact source location, and would have to guess + whether a call names a same-file macro or a function from another file. +- **No `defmacro-without-eval-when` rule.** This one is real and is decidable in + a narrow form — a helper called from a macro body's *evaluated* position, as + opposed to its quasiquote template, which the two-counter quote model + separates exactly. It was dropped on value, not on soundness: SBCL raises a + hard `ERROR` that *fails the compilation* and says `The function HELPER is + undefined. It is defined earlier in the file but is not available at + compile-time.` The defect is also unobservable unless the macro is used in the + same file — across files the helper's fasl is already loaded — and when it is + used in the same file, the compiler always sees it. Its true-positive set is + exactly the set already caught loudly. +- **No `defpackage-not-first-form` rule.** Premise refuted. `(defun early () 1)` + before `(defpackage #:p (:export #:early))` still interns `P:EARLY` as + `:EXTERNAL` in both phases — the earlier `defun` interned into a *different* + package, and `defpackage` creates a new one. "Not the first form" is not the + question; there is no defect here to ask about. `defpackage-without-in-package` + in `feature/lint-build-system` owns the file-scope question that is real. +- **No `read-time-eval-with-side-effect` rule.** Measured: `#.` fires exactly + once in each phase and produces the same value in both. There is no phase + disagreement to report, and `#.` is deliberate by construction. A rule whose + advice is "do not do that" is not worth a name. (`load-time-value` in a macro + body was investigated with it and dropped for the same reason: it fails + loudly and identically in both phases.) + +Beyond those: + +- **No registry.** `REGISTRY` stays in the root and names each rule's `META` and + `RULE` across this boundary. A registry here would be the cycle §4.2 exists to + prevent. **This package is deliberately unregistered**; a separate pass wires + it. +- **No engine.** The single pass, head index and rule trait are + `paredit-core-lint-engine`'s. +- **No rule about `declaim` placement.** `declaim-inside-body` in + `feature/lint-type-declaration` owns that, and it is a question about + declaration scope rather than about evaluation phase. + +## Dependencies + +| Crate | Why | +| --- | --- | +| `paredit-core-lint-engine` | `LintRule`, `RuleMeta`, `HeadFilter`, `RuleContext`. | +| `paredit-core-syntax` | Rules match on parsed forms and on the shared `definition` classifier. | +| `paredit-core-cli` | Input reading, shared argument types, the report envelope. | +| `clap`, `serde_json` | Arguments and JSON output for each rule's own subcommand. | + +No `paredit-feature-*` dependency, not even a dev one: +`tests/cli/feature_dependency_contract.rs` scans manifests as whole text, so a +dev-dependency on another feature package would fail that contract exactly like +a real one. + +## Layout + +One rule, one directory — the four files a rule is made of, plus two shared +modules: + +```text +src/ +├── support.rs quote model, CLHS 3.2.3.1 top level, eval-when situations +├── corpus_tests.rs the permanent correct/dangerous corpus pair +└── / + ├── rule.rs META, RULE, the head filter: what the registry registers + ├── domain.rs the detection itself + ├── usecase.rs + └── cli/ the `inspect ` subcommand +``` + +`support.rs`'s quote machinery is a deliberate **copy** of +`feature/lint-condition-system`'s, not a dependency on it — the same copy +`feature/lint-build-system` keeps, and for the same reason: two packages of lint +rules should not couple, and the semantics are the part worth sharing. Two +independent counters, because `'` and `` ` `` are not the same thing. + +That is not incidental here. A `defmacro` whose template emits +`(eval-when (:compile-toplevel) …)` for the *caller's* file is +`eval-when-body-never-runs`'s exact shape and is correct code; the audit found +**30** such forms, and every one is a false positive for any implementation that +walks data. All five quote shapes are pinned by tests in `support.rs` and again +in each rule's own tests, and mutation testing confirms that collapsing the two +counters into one breaks them. + +## The corpus audit + +Run over 1619 files of Common Lisp nobody involved here wrote — SBCL 2.6.0's own +sources and every unpacked release under `~/quicklisp/dists/`. + +| | | +| --- | --- | +| files scanned | 1588 | +| files that failed to parse (reported, not skipped) | 31 | +| `eval-when` forms reached as code | 347 | +| `eval-when` nodes suppressed as quoted data | 133 | +| `defconstant` forms reached as code | 1079 | +| findings | **9**, all `defconstant-non-eql-value` | +| false positives | **0** | +| false positives the quote model prevented | 30 | + +All 9 findings were adjudicated by extracting the exact form into a standalone +file and running `compile-file` + `load` of the fasl in a fresh SBCL: every one +reproduces `DEFCONSTANT-UNEQL`. The two `eval-when` rules found nothing because +the corpus contains no `execute`-only `eval-when` at all and exactly one nested +one, which correctly names `:execute` — a true clean over a real denominator, +not a silent rule. + +the findings precisely because a zero-finding sweep over zero candidates is a +false clean. + +## When you change this package + +| You are… | and it belongs here because… | +| --- | --- | +| adding a rule about when a form is evaluated relative to `compile-file` | it is a new slice here, plus one line in the root's REGISTRY | +| changing what one of the three flags, or how it phrases it | that rule's `domain.rs` | +| changing which forms a rule is shown | that rule's `rule.rs` head filter | +| teaching the rules a new allocating constructor or `eval-when` spelling | `support.rs`, or `defconstant_non_eql_value`'s `ALWAYS_FRESH` table | + +| You are… | and it does **not** belong here because… | +| --- | --- | +| writing a rule about where `declaim` may appear | that is `feature/lint-type-declaration` | +| writing a rule about a file that declares a package and never enters it | that is `feature/lint-build-system` | +| writing a rule about macro hygiene or variable capture | that is `feature/lisp-analysis`'s `macro_hygiene_report` | +| changing how rules are dispatched or ordered | that is `core/lint-engine` | +| changing `inspect lint` itself | that is the root, which owns the registry | + +Adding a dependency to `Cargo.toml` means adding a row to the table above. diff --git a/packages/feature/lint-compile-time/src/corpus_tests.rs b/packages/feature/lint-compile-time/src/corpus_tests.rs new file mode 100644 index 00000000..a323e2e7 --- /dev/null +++ b/packages/feature/lint-compile-time/src/corpus_tests.rs @@ -0,0 +1,226 @@ +//! The permanent corpus test: one file of realistic **correct** Common Lisp +//! that must produce nothing, and its dangerous twin that must fire each rule +//! exactly once. +//! +//! # Why the candidate count is asserted too +//! +//! "Zero findings" is worthless on its own. A rule whose head list is wrong, or +//! whose byte-scan guard is inverted, is silent on *everything* and passes a +//! zero-findings assertion perfectly. This repository has already been burned by +//! a sweep harness that errored out on every batch and reported a clean run. +//! +//! So the clean corpus asserts a **non-zero denominator** as well: the file +//! really does contain `eval-when` and `defconstant` forms, they really were +//! reached and examined, and the rules really did decline them. +//! +//! # Where the negative cases come from +//! +//! Not invented. Every shape in [`CORRECT`] is one the audit over 1588 +//! third-party files (SBCL 2.6.0's own sources plus `~/quicklisp/dists/`) +//! actually produced, including the two that would be false positives without +//! the quote model: +//! +//! - a `defmacro` whose template emits `(eval-when (:compile-toplevel) …)` for +//! the *caller's* file, where the situation is correct — 30 occurrences in the +//! corpus, the shape at +//! `closer-mop-20260101-git/closer-mop-shared.lisp:509`, and a false positive +//! for `eval-when-body-never-runs` in any implementation that walks data; +//! - `(eval-when (:compile-toplevel :execute) …)` and +//! `(eval-when (:load-toplevel :execute) …)`, both common and both correct. + +use std::path::Path; + +use paredit_core_syntax::dialect::Dialect; +use paredit_core_syntax::sexpr::SyntaxTree; + +use crate::defconstant_non_eql_value::domain::build_defconstant_non_eql_value_report; +use crate::eval_when_body_never_runs::domain::build_eval_when_body_never_runs_report; +use crate::eval_when_execute_only::domain::build_eval_when_execute_only_report; + +/// Realistic, idiomatic, **correct** Common Lisp. Every form here loads and +/// compiles identically; nothing in it is a phase mistake. +const CORRECT: &str = r#" +(defpackage #:inventory + (:use #:cl) + (:export #:reorder-level #:describe-item)) + +(in-package #:inventory) + +;;; The full three situations: the ordinary spelling for a macro helper that the +;;; rest of the file expands against. +(eval-when (:compile-toplevel :load-toplevel :execute) + (defun slot-reader-name (slot) + (intern (format nil "~a-OF" (symbol-name slot))))) + +(eval-when (:compile-toplevel :load-toplevel :execute) + (defmacro define-reader (slot) + `(defun ,(slot-reader-name slot) (item) (getf item ,(intern (symbol-name slot) :keyword))))) + +(define-reader name) +(define-reader sku) + +;;; :load-toplevel :execute, with no :compile-toplevel. Correct, and measured +;;; against SBCL 2.6.0 as behaving identically to the full three situations -- +;;; defmacro's own expansion carries an inner (eval-when (:compile-toplevel) ..) +;;; and CLHS 3.2.3.1 keeps an eval-when body top level. +(eval-when (:load-toplevel :execute) + (defmacro with-item ((var item) &body body) + `(let ((,var ,item)) ,@body))) + +;;; :compile-toplevel :execute, also common and also correct. +(eval-when (:compile-toplevel :execute) + (defparameter *known-units* '(:each :case :pallet))) + +;;; A macro whose TEMPLATE emits an eval-when for the caller's file. The +;;; situation list omits :execute and the form is lexically inside a defmacro +;;; body -- which is exactly `eval-when-body-never-runs`'s shape. It is data, +;;; not a form, and flagging it is a false positive. 30 occurrences of this +;;; shape appear in the audited corpus. +(defmacro define-both (name args &body body) + `(progn + (eval-when (:compile-toplevel) + (cl:defgeneric ,name ,args)) + (eval-when (:load-toplevel :execute) + (defun ,name ,args ,@body)))) + +;;; A nested eval-when naming :execute: correct, because outside a top level +;;; form the standard considers only that situation. +(defun rebuild-cache (force) + (when force + (eval-when (:execute) + (clrhash *cache*))) + t) + +;;; Constants whose values are eql to themselves. +(defconstant +reorder-level+ 25) +(defconstant +max-sku-length+ 32) +(defconstant +default-unit+ :each) +(defconstant +unset+ nil) +(defconstant +pi-ish+ 3.14159d0) +(defconstant +separator+ #\-) + +;;; The idiom for an aggregate constant. Its head is `define-constant`, not +;;; `defconstant`, so it is never even dispatched. +(alexandria:define-constant +unit-names+ #("each" "case" "pallet") + :test #'equalp) + +;;; A defconstant whose initform is a call this package does not model. Whether +;;; it conses is not a question the source answers, so nothing is said. +(defconstant +build-stamp+ (compute-build-stamp)) + +(defun describe-item (item) + (with-item (i item) + (format nil "~a (~a)" (name-of i) (sku-of i)))) +"#; + +/// The dangerous twin. Each rule must fire exactly once, and no rule may fire +/// on another's form. +const DANGEROUS: &str = r#" +(defpackage #:inventory-broken + (:use #:cl)) + +(in-package #:inventory-broken) + +;;; 1. eval-when-execute-only. Loads fine as source; compile-file discards the +;;; body entirely and the fasl has no REORDER-P at all. +(eval-when (:execute) + (defmacro reorder-p (level) `(< ,level +reorder-level+))) + +;;; 2. defconstant-non-eql-value. A fresh vector each evaluation, so +;;; compile-file + load of the fasl signals DEFCONSTANT-UNEQL on a first +;;; build. Verified against SBCL 2.6.0 through asdf:load-system. +(defconstant +unit-names+ #("each" "case" "pallet")) + +;;; 3. eval-when-body-never-runs. Not a top level form, so CLHS 3.2.3.1 +;;; considers only :execute here -- which is not named, so the body never +;;; runs, in any phase, with no diagnostic from the compiler. +(defun warm-cache () + (eval-when (:compile-toplevel :load-toplevel) + (setf *warmed* t)) + :done) +"#; + +fn reports(source: &str) -> (usize, usize, usize, u64, u64) { + let tree = SyntaxTree::parse_with_dialect(source, Dialect::CommonLisp).expect("parse corpus"); + let path = Path::new("corpus.lisp"); + let execute_only = build_eval_when_execute_only_report(path, Dialect::CommonLisp, &tree) + .expect("execute-only report"); + let ignored = build_eval_when_body_never_runs_report(path, Dialect::CommonLisp, &tree) + .expect("body-never-runs report"); + let non_eql = build_defconstant_non_eql_value_report(path, Dialect::CommonLisp, &tree) + .expect("non-eql report"); + + let summary = |report: &[(&'static str, serde_json::Value)], key: &str| { + report + .iter() + .find(|(name, _)| *name == key) + .and_then(|(_, value)| value.as_u64()) + .unwrap_or_default() + }; + + ( + execute_only.findings.len(), + ignored.findings.len(), + non_eql.findings.len(), + summary(&execute_only.summary, "eval_when_count"), + summary(&non_eql.summary, "defconstant_count"), + ) +} + +#[test] +fn realistic_correct_common_lisp_produces_no_findings() { + let (execute_only, ignored, non_eql, _, _) = reports(CORRECT); + assert_eq!( + execute_only, 0, + "eval-when-execute-only fired on correct code" + ); + assert_eq!( + ignored, 0, + "eval-when-body-never-runs fired on correct code" + ); + assert_eq!( + non_eql, 0, + "defconstant-non-eql-value fired on correct code" + ); +} + +/// The half that makes the assertion above mean something. A rule that is +/// silent because it was never invoked passes a zero-findings test perfectly. +#[test] +fn the_correct_corpus_really_does_contain_candidates() { + let (_, _, _, eval_whens, defconstants) = reports(CORRECT); + assert!( + eval_whens >= 5, + "the clean corpus examined only {eval_whens} eval-when forms; a zero-findings result \ + over no candidates is a false clean" + ); + assert!( + defconstants >= 6, + "the clean corpus examined only {defconstants} defconstant forms; a zero-findings result \ + over no candidates is a false clean" + ); +} + +#[test] +fn the_dangerous_twin_fires_each_rule_exactly_once() { + let (execute_only, ignored, non_eql, eval_whens, defconstants) = reports(DANGEROUS); + assert_eq!(execute_only, 1, "eval-when-execute-only"); + assert_eq!(ignored, 1, "eval-when-body-never-runs"); + assert_eq!(non_eql, 1, "defconstant-non-eql-value"); + assert!(eval_whens >= 2 && defconstants >= 1); +} + +/// The two corpora must differ only in the defect, not in which forms exist at +/// all: a twin that simply deleted the correct code would prove nothing about +/// the rules' ability to tell the two apart. +#[test] +fn both_corpora_exercise_both_heads() { + for (label, source) in [("correct", CORRECT), ("dangerous", DANGEROUS)] { + let (_, _, _, eval_whens, defconstants) = reports(source); + assert!(eval_whens > 0, "{label} corpus has no eval-when candidate"); + assert!( + defconstants > 0, + "{label} corpus has no defconstant candidate" + ); + } +} diff --git a/packages/feature/lint-compile-time/src/defconstant_non_eql_value/cli/args.rs b/packages/feature/lint-compile-time/src/defconstant_non_eql_value/cli/args.rs new file mode 100644 index 00000000..0d70531a --- /dev/null +++ b/packages/feature/lint-compile-time/src/defconstant_non_eql_value/cli/args.rs @@ -0,0 +1,25 @@ +use std::path::PathBuf; + +use clap::Args; + +use paredit_core_cli::args::{DialectArg, ReportFormat}; +use paredit_core_cli::runtime::Verbosity; + +#[derive(Debug, Args)] +pub struct DefconstantNonEqlValueReportArgs { + /// Files or directories to scan. + #[arg(required = true)] + pub files: Vec, + /// Override extension-based dialect detection for every file. + #[arg(long)] + pub dialect: Option, + /// Exit with failure when any file defines such a constant. + #[arg(long)] + pub fail_on_violation: bool, + /// Output format for agent consumption. + #[arg(long, value_enum, default_value_t = ReportFormat::Json)] + pub output: ReportFormat, + /// How much detail the report includes. + #[arg(long, value_enum, default_value_t = Verbosity::Normal)] + pub verbosity: Verbosity, +} diff --git a/packages/feature/lint-compile-time/src/defconstant_non_eql_value/cli/mod.rs b/packages/feature/lint-compile-time/src/defconstant_non_eql_value/cli/mod.rs new file mode 100644 index 00000000..c5257b37 --- /dev/null +++ b/packages/feature/lint-compile-time/src/defconstant_non_eql_value/cli/mod.rs @@ -0,0 +1,3 @@ +pub mod args; +mod render; +pub mod workflow; diff --git a/packages/feature/lint-compile-time/src/defconstant_non_eql_value/cli/render.rs b/packages/feature/lint-compile-time/src/defconstant_non_eql_value/cli/render.rs new file mode 100644 index 00000000..0f807122 --- /dev/null +++ b/packages/feature/lint-compile-time/src/defconstant_non_eql_value/cli/render.rs @@ -0,0 +1,23 @@ +use paredit_core_cli::CliResult; + +use paredit_core_cli::args::ReportFormat; +use paredit_core_cli::runtime::Verbosity; + +use crate::defconstant_non_eql_value::usecase::DefconstantNonEqlValueItem; +use paredit_core_cli::report::render::print_report; +use paredit_core_cli::report::{FileFindings, ReportPolicy}; + +pub fn print_defconstant_non_eql_value_report( + reports: &[FileFindings], + policy: &ReportPolicy, + output: ReportFormat, + verbosity: Verbosity, +) -> CliResult<()> { + print_report( + "inspect defconstant-non-eql-value", + reports, + policy, + output, + verbosity, + ) +} diff --git a/packages/feature/lint-compile-time/src/defconstant_non_eql_value/cli/workflow.rs b/packages/feature/lint-compile-time/src/defconstant_non_eql_value/cli/workflow.rs new file mode 100644 index 00000000..35bb763d --- /dev/null +++ b/packages/feature/lint-compile-time/src/defconstant_non_eql_value/cli/workflow.rs @@ -0,0 +1,34 @@ +use paredit_core_cli::CommandResult; + +use crate::defconstant_non_eql_value::cli::args::DefconstantNonEqlValueReportArgs; +use crate::defconstant_non_eql_value::cli::render::print_defconstant_non_eql_value_report; +use crate::defconstant_non_eql_value::usecase::{ + build_defconstant_non_eql_value_report, evaluate_fail_on_violation_policy, +}; +use paredit_core_cli::shared::{expand_input_files, read_input_dialect_and_tree}; + +pub fn defconstant_non_eql_value_report(args: DefconstantNonEqlValueReportArgs) -> CommandResult { + let files = expand_input_files(&args.files, args.dialect)?; + + let mut reports = Vec::with_capacity(files.len()); + for file in &files { + let (_, dialect, tree) = read_input_dialect_and_tree(Some(file.clone()), args.dialect)?; + reports.push(build_defconstant_non_eql_value_report( + file, dialect, &tree, + )?); + } + + let policy = evaluate_fail_on_violation_policy(args.fail_on_violation, &reports); + let passed = policy.passed; + let message = policy.violations.join("; "); + + print_defconstant_non_eql_value_report(&reports, &policy, args.output, args.verbosity)?; + + if !passed { + return Err(paredit_core_cli::gate::gate_failure(format!( + "defconstant-non-eql-value-report policy failed: {message}" + ))); + } + + Ok(()) +} diff --git a/packages/feature/lint-compile-time/src/defconstant_non_eql_value/domain.rs b/packages/feature/lint-compile-time/src/defconstant_non_eql_value/domain.rs new file mode 100644 index 00000000..2b1dbcee --- /dev/null +++ b/packages/feature/lint-compile-time/src/defconstant_non_eql_value/domain.rs @@ -0,0 +1,648 @@ +//! `(defconstant +x+ (list 1 2))` — a constant whose value is a freshly +//! allocated object, and so is not `eql` to itself across the +//! compile-time/load-time boundary. +//! +//! CLHS `defconstant` is explicit: *"If defconstant is used to redefine a name +//! ... the consequences are undefined unless the new value is eql to the old."* +//! `defconstant` also has an implicit compile-time effect, so `compile-file` +//! evaluates the initform once at compile time and the fasl evaluates it again +//! at load time. When the initform allocates, those are two distinct objects and +//! the second `defconstant` is a redefinition to a non-`eql` value. +//! +//! # This fires on the *first* build, not on a re-evaluation +//! +//! The proposal for this rule described the failure as "re-evaluating the file +//! signals". Measured against SBCL 2.6.0, it is worse than that: a **fresh +//! image**, compiling and loading the file exactly once, already signals. +//! +//! ```text +//! (load "src.lisp") => no error, no warning +//! (load (compile-file "src.lisp")) => DEFCONSTANT-UNEQL +//! "The constant +LIST+ is being redefined (from (1 2) to (1 2))" +//! ``` +//! +//! Note the message: the two values *print identically*. Nothing about the +//! error tells the reader that identity rather than value is the problem, and +//! `compile-file` itself reported `warnings-p = NIL, failure-p = NIL` before the +//! load failed. That is the ASDF workflow — compile then load, in one image — so +//! this is not an exotic path. +//! +//! # Which initforms are flagged, and why the list is short +//! +//! Every entry below was run through `compile-file` + `load` of the fasl in a +//! fresh SBCL 2.6.0, defining a **uniquely named** constant per case. (A first +//! version of that probe reused one constant name and reported *every* initform +//! as unequal, including `42` and `nil` — an all-positive harness is as broken +//! as an all-negative one, and the controls below are what caught it.) +//! +//! | initform | result | flagged | +//! | --- | --- | --- | +//! | `(list 1 2)` | `DEFCONSTANT-UNEQL` | yes | +//! | `'(1 2)` | `DEFCONSTANT-UNEQL` | yes | +//! | `"hello"` | `DEFCONSTANT-UNEQL` | yes | +//! | `#(1 2 3)` | `DEFCONSTANT-UNEQL` | yes | +//! | `(vector 1 2)` | `DEFCONSTANT-UNEQL` | yes | +//! | `(make-array 3)` | `DEFCONSTANT-UNEQL` | yes | +//! | `(copy-seq "ab")` | `DEFCONSTANT-UNEQL` | yes | +//! | `42`, `12345678901234567890`, `1.5d0`, `1/3` | ok | no | +//! | `'foo`, `:foo`, `#\a`, `nil`, `t` | ok | no | +//! | `(+ 1 2)`, `(if t 1 2)`, `most-positive-fixnum` | ok | no | +//! | `(coerce 1 'double-float)` | ok | no | +//! +//! The last row of "ok" results is the important one for the rule's shape: an +//! arbitrary *call* is not evidence of anything. `(+ 1 2)` returns a fixnum and +//! is fine; `(list 1 2)` returns a fresh cons and is not. So the rule cannot key +//! on "the initform is a call" — it keys on a **closed list of constructors +//! that provably allocate**, and says nothing about any other call. A +//! `(defconstant +x+ (compute-it))` is left alone, because whether `compute-it` +//! conses is not a question the source answers. +//! +//! Literals are classified the same way and for the same reason: a string, a +//! `#(…)` vector and a quoted *list* are freshly constructed by the fasl loader, +//! while a number, a character, a symbol, a keyword, `t` and `nil` are not. +//! `'()` is `nil` and is therefore stable — which is why the quoted-list test +//! asks for a non-empty list rather than for a `(…)` shape. +//! +//! # Deliberate limits +//! +//! - **Top level only**, in the CLHS 3.2.3.1 sense. A `defconstant` nested +//! inside a `defun` has no compile-time effect, so there is no second +//! evaluation and no collision. +//! - **No fix.** The repair is a judgement: `alexandria:define-constant` with +//! an appropriate `:test`, or `defparameter`, or hoisting the value into a +//! `load-time-value`. Which one depends on whether the constant is compared, +//! mutated, or merely read. The message names `define-constant` because that +//! is what the idiom exists for, but choosing the `:test` is the author's. +//! - **`alexandria:define-constant` is not flagged**, and needs no exclusion: +//! its head normalizes to `define-constant`, which is not this rule's head. +//! +//! Scope: Common Lisp only. + +use std::path::Path; + +use paredit_core_cli::report::{FileFindings, Finding}; +use paredit_core_lint_engine::LintResult; +use paredit_core_syntax::dialect::Dialect; +use paredit_core_syntax::sexpr::{ByteSpan, ExpressionView, ReaderPrefix, SyntaxTree}; +use paredit_core_syntax::view_query::{atom_text, is_paren_list, list_head}; +use serde_json::{Value, json}; + +use crate::support::{ + carries_reader_conditional, for_each_evaluated_subview, is_top_level_form, mentions, + normalized_symbol, +}; + +/// The byte-scan needle, and the head this rule anchors on. +pub const DEFCONSTANT: &str = "defconstant"; + +/// Operators that **always** return a freshly allocated object of a type `eql` +/// compares by identity. +/// +/// Closed and deliberately short. Every entry has to be true of *every* call to +/// it, including degenerate ones, which is why several plausible candidates are +/// absent: +/// +/// - `append` — `(append)` is `nil` and `(append x)` is `x`; neither allocates. +/// - `make-list` — `(make-list 0)` is `nil`. +/// - `list*` — `(list* x)` is `x`. +/// - `concatenate` — `(concatenate 'list)` is `nil`. +/// - `coerce` — measured returning a `double-float` that compares `eql`. +/// - `reverse`, `sort`, `remove`, `subseq`, `mapcar` — all can return an +/// argument, or `nil`, for an empty or degenerate input. +/// +/// `list` and `cons` are the two that survive with a guard rather than +/// unconditionally: `(list)` is `nil`, so `list` needs at least one argument; +/// `cons` always conses. +const ALWAYS_FRESH: [&str; 8] = [ + "cons", + "vector", + "make-array", + "make-string", + "copy-seq", + "copy-list", + "copy-tree", + "copy-alist", +]; + +/// What the source says about whether an initform's value is `eql` to itself +/// across the compile/load boundary. +#[derive(Debug, Clone, Copy, PartialEq, Eq)] +pub enum ValueStability { + /// Provably a fresh object each time it is evaluated. + Fresh, + /// Provably `eql` to itself: a number, character, symbol, keyword, `t`, + /// `nil`. + Stable, + /// Not decidable from the source. Never reported. + Unknown, +} + +/// Whether an atom's printed representation is one of the self-`eql` types. +/// +/// Numbers, characters, keywords, `t`, `nil` and bare symbols all read as atoms +/// whose value is `eql` to itself. A *string* is an atom too, and is not. +fn classify_atom(text: &str) -> ValueStability { + if carries_reader_conditional(text) { + return ValueStability::Unknown; + } + // A string literal is freshly constructed by the loader. + if text.starts_with('"') { + return ValueStability::Fresh; + } + // `#(…)` and `#*…` read as self-evaluating aggregates, freshly built. + if text.starts_with("#(") || text.starts_with("#*") { + return ValueStability::Fresh; + } + // `#\a`, and every numeric or symbolic atom, is stable. A bare symbol is a + // *variable reference* rather than a literal, so it is not decidable — but + // a reference to another constant is the overwhelmingly common case and was + // measured stable (`most-positive-fixnum`). Being wrong here would mean + // staying silent, since `Stable` is never reported. + ValueStability::Stable +} + +/// How stable the value of `view` is, read from the source alone. +#[must_use] +pub fn classify(view: &ExpressionView) -> ValueStability { + // A reader prefix decides the question before the node's own shape does, + // and the *outermost* one settles it: in `'#(1 2)` the quote already makes + // the whole thing a literal, and in `#(1 2)` there is only one prefix to + // read. So this is a first-prefix test, not a fold over all of them. + if let Some(prefix) = view.reader_prefixes.first() { + match prefix { + ReaderPrefix::Quote => { + // `'(1 2)` is a fresh list; `'foo` is a symbol; `'()` is nil. + return if is_paren_list(view) && !view.children.is_empty() { + ValueStability::Fresh + } else { + ValueStability::Stable + }; + } + // `#(1 2 3)` is a *prefixed list*, not an atom: the reader keeps the + // bare `#` attached to the following collection as `HashLiteral`. + // In Common Lisp that is a vector literal, which the fasl loader + // builds fresh. (Clojure's `#{…}` set and `#(…)` lambda share the + // prefix, which is why this rule is Common Lisp only.) + ReaderPrefix::HashLiteral => return ValueStability::Fresh, + // A backquote may or may not allocate depending on its unquotes, and + // `#.` was already resolved by the reader into whatever it produced. + ReaderPrefix::Quasiquote => return ValueStability::Unknown, + _ => return ValueStability::Unknown, + } + } + if let Some(text) = atom_text(view) { + return classify_atom(text); + } + if !is_paren_list(view) { + return ValueStability::Unknown; + } + let Some(head) = list_head(view) else { + // `()` reads as nil. + return ValueStability::Stable; + }; + let head = normalized_symbol(head); + // `(quote (1 2))`, the long-hand spelling. + if head == "quote" { + return view.children.get(1).map_or(ValueStability::Unknown, |q| { + if is_paren_list(q) && !q.children.is_empty() { + ValueStability::Fresh + } else { + ValueStability::Stable + } + }); + } + if ALWAYS_FRESH.contains(&head.as_str()) { + return ValueStability::Fresh; + } + // `(list)` is nil; `(list x …)` is a fresh cons. + if head == "list" { + return if view.children.len() > 1 { + ValueStability::Fresh + } else { + ValueStability::Stable + }; + } + // `(format nil …)` always builds a fresh string; `(format t …)` returns nil + // and `(format stream …)` is not decidable. + if head == "format" { + return view.children.get(1).map_or( + ValueStability::Unknown, + |destination| match atom_text(destination).map(normalized_symbol).as_deref() { + Some("nil") => ValueStability::Fresh, + Some("t") => ValueStability::Stable, + _ => ValueStability::Unknown, + }, + ); + } + // Any other call: the source does not say. + ValueStability::Unknown +} + +#[derive(Debug, Clone)] +pub struct DefconstantNonEqlValueItem { + /// The span of the whole `defconstant`. + pub span: ByteSpan, + /// The constant's name as written. + pub name: String, + /// The initform as written, so the reader can see what allocates. + pub initform: String, +} + +impl Finding for DefconstantNonEqlValueItem { + fn kind(&self) -> &'static str { + "defconstant-non-eql-value" + } + + fn span(&self) -> ByteSpan { + self.span + } + + fn text_columns(&self) -> Vec { + vec![ + format!("name={}", self.name), + format!("initform={}", self.initform), + ] + } + + fn json_fields(&self) -> Vec<(&'static str, Value)> { + vec![ + ("name", json!(self.name)), + ("initform", json!(self.initform)), + ] + } + + fn message(&self) -> String { + format!( + "{} is defined with {}, which allocates a new object every time it is evaluated; \ + compile-file evaluates it once at compile time and the fasl evaluates it again at \ + load time, so loading the compiled file signals DEFCONSTANT-UNEQL even on a first \ + build (alexandria:define-constant with a :test exists for this)", + self.name, self.initform + ) + } +} + +/// Whether `view` is a `(defconstant …)` form. +#[must_use] +pub fn is_defconstant(view: &ExpressionView) -> bool { + is_paren_list(view) + && list_head(view).is_some_and(|head| normalized_symbol(head) == DEFCONSTANT) +} + +/// The finding this `defconstant` implies, if any. +/// +/// **Ordering is load-bearing.** [`classify`] reads the initform node and +/// nothing else, and answers `Stable` or `Unknown` — no finding — for every +/// `defconstant` except the ones this rule is about. Only a form that has +/// already been classified `Fresh` reaches [`is_top_level_form`], which +/// materializes the enclosing top-level form. +#[must_use] +pub fn examine_defconstant( + tree: &SyntaxTree, + view: &ExpressionView, +) -> Option { + // 1. node-local: does the initform provably allocate? + let initform = view.children.get(2)?; + if classify(initform) != ValueStability::Fresh { + return None; + } + let name = view.children.get(1).and_then(atom_text)?; + if carries_reader_conditional(name) { + return None; + } + // 2. only now, the tree. A nested `defconstant` has no compile-time effect, + // so there is no second evaluation to collide with. + if !is_top_level_form(tree, view.span) { + return None; + } + Some(DefconstantNonEqlValueItem { + span: view.span, + name: name.to_owned(), + initform: initform_text(tree, initform), + }) +} + +/// The initform exactly as written, truncated so a large literal table does not +/// become the whole message. +fn initform_text(tree: &SyntaxTree, initform: &ExpressionView) -> String { + const LIMIT: usize = 40; + let text = tree + .source() + .get(initform.span.start().get()..initform.span.end().get()) + .unwrap_or_default(); + let flattened = text.split_whitespace().collect::>().join(" "); + if flattened.chars().count() > LIMIT { + let kept: String = flattened.chars().take(LIMIT).collect(); + format!("{kept}…") + } else { + flattened + } +} + +fn collect(tree: &SyntaxTree) -> (Vec, usize) { + let mut findings = Vec::new(); + let mut candidates = 0; + for_each_evaluated_subview(&tree.root_view(), |view| { + if !is_defconstant(view) { + return; + } + candidates += 1; + if let Some(item) = examine_defconstant(tree, view) { + findings.push(item); + } + }); + (findings, candidates) +} + +/// Collects the file's findings with the number of `defconstant` forms scanned +/// as the denominator beside it. +pub fn build_defconstant_non_eql_value_report( + path: &Path, + dialect: Dialect, + tree: &SyntaxTree, +) -> LintResult> { + if dialect != Dialect::CommonLisp { + return Ok(FileFindings::new( + path.to_path_buf(), + dialect, + false, + tree.source(), + Vec::new(), + vec![("defconstant_count", json!(0))], + )); + } + if !mentions(tree.source(), DEFCONSTANT) { + return Ok(FileFindings::new( + path.to_path_buf(), + dialect, + true, + tree.source(), + Vec::new(), + vec![("defconstant_count", json!(0))], + )); + } + let (findings, candidates) = collect(tree); + Ok(FileFindings::new( + path.to_path_buf(), + dialect, + true, + tree.source(), + findings, + vec![("defconstant_count", json!(candidates))], + )) +} + +#[cfg(test)] +mod tests { + use super::*; + + fn report(input: &str) -> FileFindings { + let tree = SyntaxTree::parse_with_dialect(input, Dialect::CommonLisp).expect("parse input"); + build_defconstant_non_eql_value_report(Path::new("app.lisp"), Dialect::CommonLisp, &tree) + .expect("build defconstant-non-eql-value report") + } + + fn findings(input: &str) -> Vec { + report(input).findings + } + + fn candidates(input: &str) -> u64 { + report(input) + .summary + .iter() + .find(|(name, _)| *name == "defconstant_count") + .and_then(|(_, value)| value.as_u64()) + .expect("defconstant_count in the summary") + } + + fn stability(initform: &str) -> ValueStability { + let source = format!("(defconstant +x+ {initform})"); + let tree = SyntaxTree::parse_with_dialect(&source, Dialect::CommonLisp).expect("parse"); + let form = tree.root_view().children[0].clone(); + classify(&form.children[2]) + } + + // --- the measured table, as a test + + /// Every one of these was confirmed to signal `DEFCONSTANT-UNEQL` under + /// `compile-file` + `load` of the fasl in a fresh SBCL 2.6.0. + #[test] + fn the_initforms_sbcl_reported_uneql_are_classified_fresh() { + for initform in [ + "(list 1 2)", + "'(1 2)", + "\"hello\"", + "#(1 2 3)", + "(vector 1 2)", + "(make-array 3)", + "(copy-seq \"ab\")", + ] { + assert_eq!( + stability(initform), + ValueStability::Fresh, + "{initform} was measured UNEQL but is not classified Fresh" + ); + } + } + + /// The controls. Every one of these was confirmed to load cleanly. + #[test] + fn the_initforms_sbcl_accepted_are_never_classified_fresh() { + for initform in [ + "42", + "12345678901234567890", + "1.5d0", + "1/3", + "'foo", + ":foo", + "#\\a", + "nil", + "t", + "(+ 1 2)", + "(if t 1 2)", + "most-positive-fixnum", + "(coerce 1 'double-float)", + ] { + assert_ne!( + stability(initform), + ValueStability::Fresh, + "{initform} loads cleanly but is classified Fresh" + ); + } + } + + /// The degenerate calls that make several plausible constructors unsound. + #[test] + fn the_constructors_that_can_return_a_non_fresh_value_are_not_flagged() { + for initform in [ + "(list)", + "(append)", + "(append x)", + "(make-list 0)", + "(list* x)", + "(concatenate 'list)", + "(reverse x)", + "(subseq x 0)", + ] { + assert_ne!( + stability(initform), + ValueStability::Fresh, + "{initform} can return a non-fresh value" + ); + } + } + + #[test] + fn an_empty_quoted_list_is_nil_and_is_stable() { + assert_eq!(stability("'()"), ValueStability::Stable); + assert_eq!(stability("'nil"), ValueStability::Stable); + } + + #[test] + fn the_long_hand_quote_is_classified_like_the_reader_macro() { + assert_eq!(stability("(quote (1 2))"), ValueStability::Fresh); + assert_eq!(stability("(quote foo)"), ValueStability::Stable); + assert_eq!(stability("(quote ())"), ValueStability::Stable); + } + + #[test] + fn an_unknown_call_says_nothing() { + assert_eq!(stability("(compute-it)"), ValueStability::Unknown); + assert_eq!( + stability("(my-package:build-table)"), + ValueStability::Unknown + ); + } + + #[test] + fn format_is_classified_by_its_destination() { + assert_eq!(stability("(format nil \"~a\" x)"), ValueStability::Fresh); + assert_eq!(stability("(format t \"~a\" x)"), ValueStability::Stable); + assert_eq!(stability("(format s \"~a\" x)"), ValueStability::Unknown); + } + + // --- findings + + #[test] + fn flags_a_list_valued_constant() { + let found = findings("(defconstant +limits+ (list 1 2))\n"); + assert_eq!(found.len(), 1); + assert_eq!(found[0].name, "+limits+"); + assert_eq!(found[0].initform, "(list 1 2)"); + assert!(found[0].message().contains("define-constant")); + } + + #[test] + fn flags_a_string_valued_constant() { + let found = findings("(defconstant +greeting+ \"hello\")\n"); + assert_eq!(found.len(), 1); + assert_eq!(found[0].initform, "\"hello\""); + } + + #[test] + fn a_long_initform_is_truncated_in_the_finding() { + let found = findings( + "(defconstant +table+ (list :aaaaaaaaaa :bbbbbbbbbb :cccccccccc :dddddddddd :eeeeeeeeee))\n", + ); + assert!(found[0].initform.ends_with('…')); + assert!(found[0].initform.chars().count() <= 41); + } + + #[test] + fn does_not_flag_a_numeric_or_symbolic_constant() { + assert!(findings("(defconstant +limit+ 100)\n").is_empty()); + assert!(findings("(defconstant +mode+ :fast)\n").is_empty()); + assert!(findings("(defconstant +none+ nil)\n").is_empty()); + } + + /// The head is `define-constant`, not `defconstant`, so the idiom this rule + /// recommends is never itself reported. + #[test] + fn does_not_flag_the_alexandria_idiom() { + assert!( + findings("(alexandria:define-constant +greeting+ \"hello\" :test #'string=)\n") + .is_empty() + ); + assert_eq!( + candidates("(alexandria:define-constant +g+ \"h\" :test #'string=)\n"), + 0 + ); + } + + /// A nested `defconstant` has no compile-time effect and so no second + /// evaluation to collide with. + #[test] + fn does_not_flag_a_non_top_level_defconstant() { + assert!(findings("(defun f () (defconstant +x+ (list 1 2)))\n").is_empty()); + assert!(findings("(let () (defconstant +x+ \"s\"))\n").is_empty()); + } + + #[test] + fn flags_it_inside_the_top_level_preserving_operators() { + for source in [ + "(progn (defconstant +x+ (list 1 2)))", + "(eval-when (:compile-toplevel :load-toplevel :execute) (defconstant +x+ \"s\"))", + "(locally (defconstant +x+ #(1 2)))", + ] { + assert_eq!(findings(source).len(), 1, "missed: {source}"); + } + } + + #[test] + fn does_not_flag_a_reader_conditional_name_or_initform() { + assert!(findings("(defconstant #+sbcl +x+ (list 1 2))\n").is_empty()); + } + + // --- quote negatives + + #[test] + fn quoted_data_is_never_a_finding() { + for source in [ + "'(defconstant +x+ (list 1 2))", + "(quote (defconstant +x+ \"s\"))", + "`(defconstant +x+ (list 1 2))", + "'(a ,(defconstant +x+ \"s\"))", + ] { + assert!(findings(source).is_empty(), "flagged data: {source}"); + } + } + + #[test] + fn a_defconstant_template_in_a_macro_body_is_data() { + assert!(findings("(defmacro m (n) `(defconstant ,n (list 1 2)))\n").is_empty()); + } + + // --- denominator and envelope + + #[test] + fn the_denominator_counts_every_defconstant_reached_as_code() { + assert_eq!( + candidates("(defconstant +a+ 1)\n(defconstant +b+ (list 1))\n(defun f () 1)\n"), + 2 + ); + assert_eq!(candidates("(defparameter *a* (list 1))\n"), 0); + } + + #[test] + fn a_non_common_lisp_dialect_is_reported_as_unmodelled() { + let tree = SyntaxTree::parse_with_dialect("(defconstant +x+ (list 1))", Dialect::Clojure) + .expect("parse"); + let report = + build_defconstant_non_eql_value_report(Path::new("app.clj"), Dialect::Clojure, &tree) + .expect("build report"); + assert!(!report.dialect_modelled); + assert!(report.findings.is_empty()); + } + + #[test] + fn a_finding_carries_its_line_its_kind_and_its_fields() { + let report = report("\n(defconstant +x+ (list 1 2))\n"); + let finding = &report.findings[0]; + assert_eq!(report.line_of(finding), 2); + assert_eq!(finding.kind(), "defconstant-non-eql-value"); + assert_eq!( + finding.json_fields(), + vec![("name", json!("+x+")), ("initform", json!("(list 1 2)"))] + ); + } +} diff --git a/packages/feature/lint-compile-time/src/defconstant_non_eql_value/mod.rs b/packages/feature/lint-compile-time/src/defconstant_non_eql_value/mod.rs new file mode 100644 index 00000000..cce9ec15 --- /dev/null +++ b/packages/feature/lint-compile-time/src/defconstant_non_eql_value/mod.rs @@ -0,0 +1,10 @@ +//! The `defconstant-non-eql-value` lint rule: its adapter, detection, use case +//! and command. +//! +//! One rule, one directory. `rule` is what the registry registers; the rest is +//! the report it drives. + +pub mod cli; +pub mod domain; +pub mod rule; +pub mod usecase; diff --git a/packages/feature/lint-compile-time/src/defconstant_non_eql_value/rule.rs b/packages/feature/lint-compile-time/src/defconstant_non_eql_value/rule.rs new file mode 100644 index 00000000..517a6516 --- /dev/null +++ b/packages/feature/lint-compile-time/src/defconstant_non_eql_value/rule.rs @@ -0,0 +1,128 @@ +//! `defconstant-non-eql-value`: a constant whose initform allocates. +//! +//! The analysis lives in [`crate::defconstant_non_eql_value::domain`]; this +//! module only registers it with the lint suite. +//! +//! # Cost +//! +//! `HeadFilter::Heads(&["defconstant"])`. `clean/forms/*` contains no +//! `defconstant`, so the rule is never dispatched there and contributes nothing +//! to the benchmark whose 10% threshold has failed this project five times. +//! +//! Within `check`, `classify` reads the initform node alone and rejects every +//! `defconstant` whose value is a number, a symbol, or any call this package +//! does not model — which is the great majority. Only a form already classified +//! `Fresh` reaches `is_top_level_form` and its tree access. +//! +//! Never `binding_table()`/`value_table()`/`type_table()`, never +//! `RuleContext::scratch_cache`. + +use paredit_core_lint_engine::LintResult; + +use crate::defconstant_non_eql_value::domain::{examine_defconstant, is_defconstant}; +use paredit_core_cli::report::Finding; +use paredit_core_lint_engine::engine::{RuleContext, RuleSink}; +use paredit_core_lint_engine::model::{ + Fixability, HeadFilter, NormalizedHead, RuleCategory, RuleMeta, Severity, +}; +use paredit_core_lint_engine::rule::LintRule; +use paredit_core_syntax::sexpr::ExpressionView; + +pub const META: RuleMeta = RuleMeta::new( + "defconstant-non-eql-value", + // The form is well formed and means something other than it appears to: + // it looks like a constant definition and is a redefinition collision. + RuleCategory::Suspicious, + // Measured: a fresh image that compiles and loads the file once already + // signals DEFCONSTANT-UNEQL. Not a style preference. + Severity::Error, + "a defconstant whose initform allocates, so the compile-time and load-time values are not eql", + // define-constant with which :test, or defparameter, is a judgement. + Fixability::ReportOnly, +); + +const HEADS: [NormalizedHead; 1] = [NormalizedHead::new("defconstant")]; + +#[derive(Debug)] +pub struct Rule; + +pub const RULE: Rule = Rule; + +impl LintRule for Rule { + fn head_filter(&self) -> HeadFilter { + HeadFilter::Heads(&HEADS) + } + + fn check( + &self, + context: &RuleContext<'_>, + view: &ExpressionView, + sink: &mut RuleSink<'_, '_>, + ) -> LintResult<()> { + if !is_defconstant(view) { + return Ok(()); + } + let Some(item) = examine_defconstant(context.tree(), view) else { + return Ok(()); + }; + sink.report(item.span, item.message()); + Ok(()) + } +} + +#[cfg(test)] +mod tests { + use super::*; + use crate::support::run_rule; + use paredit_core_lint_engine::rule::RuleEntry; + + static ENTRIES: [RuleEntry; 1] = [RuleEntry::new(&META, &RULE)]; + + fn messages(source: &str) -> Vec { + run_rule(&ENTRIES, source) + } + + #[test] + fn the_declared_head_reaches_the_rule() { + assert_eq!(messages("(defconstant +x+ (list 1 2))\n").len(), 1); + } + + #[test] + fn every_defconstant_spelling_survives_dispatch_and_the_recheck() { + for head in ["defconstant", "cl:defconstant", "DEFCONSTANT"] { + assert_eq!( + messages(&format!("({head} +x+ \"s\")\n")).len(), + 1, + "`{head}` did not reach a finding" + ); + } + } + + /// `define-constant` normalizes to a different head, so the recommended + /// idiom is never dispatched at all. + #[test] + fn the_alexandria_idiom_is_not_dispatched() { + assert!(messages("(alexandria:define-constant +x+ \"s\" :test #'string=)\n").is_empty()); + } + + #[test] + fn a_stable_valued_constant_produces_nothing_through_the_engine() { + assert!(messages("(defconstant +x+ 100)\n").is_empty()); + assert!(messages("(defconstant +x+ :fast)\n").is_empty()); + } + + #[test] + fn a_file_with_no_defconstant_produces_nothing() { + assert!(messages("(defparameter *x* (list 1 2))\n").is_empty()); + assert!(messages("").is_empty()); + } + + #[test] + fn each_offending_constant_is_reported_once() { + assert_eq!( + messages("(defconstant +a+ (list 1))\n(defconstant +b+ \"s\")\n(defconstant +c+ 3)\n") + .len(), + 2 + ); + } +} diff --git a/packages/feature/lint-compile-time/src/defconstant_non_eql_value/usecase.rs b/packages/feature/lint-compile-time/src/defconstant_non_eql_value/usecase.rs new file mode 100644 index 00000000..6649de3b --- /dev/null +++ b/packages/feature/lint-compile-time/src/defconstant_non_eql_value/usecase.rs @@ -0,0 +1,25 @@ +//! Non-`eql` constant detection across explicit files. + +pub use crate::defconstant_non_eql_value::domain::{ + DefconstantNonEqlValueItem, build_defconstant_non_eql_value_report, +}; + +use paredit_core_cli::report::{FileFindings, ReportPolicy}; + +/// Evaluates this report's gate. +#[must_use] +pub fn evaluate_fail_on_violation_policy( + fail_on_violation: bool, + reports: &[FileFindings], +) -> ReportPolicy { + ReportPolicy::fail_on_any( + fail_on_violation.then_some("--fail-on-violation"), + reports, + |report| { + format!( + "{} defines a constant whose value is not eql to itself", + report.path.display() + ) + }, + ) +} diff --git a/packages/feature/lint-compile-time/src/eval_when_body_never_runs/cli/args.rs b/packages/feature/lint-compile-time/src/eval_when_body_never_runs/cli/args.rs new file mode 100644 index 00000000..0d9f2376 --- /dev/null +++ b/packages/feature/lint-compile-time/src/eval_when_body_never_runs/cli/args.rs @@ -0,0 +1,25 @@ +use std::path::PathBuf; + +use clap::Args; + +use paredit_core_cli::args::{DialectArg, ReportFormat}; +use paredit_core_cli::runtime::Verbosity; + +#[derive(Debug, Args)] +pub struct EvalWhenBodyNeverRunsReportArgs { + /// Files or directories to scan. + #[arg(required = true)] + pub files: Vec, + /// Override extension-based dialect detection for every file. + #[arg(long)] + pub dialect: Option, + /// Exit with failure when any file has an eval-when whose body never runs. + #[arg(long)] + pub fail_on_violation: bool, + /// Output format for agent consumption. + #[arg(long, value_enum, default_value_t = ReportFormat::Json)] + pub output: ReportFormat, + /// How much detail the report includes. + #[arg(long, value_enum, default_value_t = Verbosity::Normal)] + pub verbosity: Verbosity, +} diff --git a/packages/feature/lint-compile-time/src/eval_when_body_never_runs/cli/mod.rs b/packages/feature/lint-compile-time/src/eval_when_body_never_runs/cli/mod.rs new file mode 100644 index 00000000..c5257b37 --- /dev/null +++ b/packages/feature/lint-compile-time/src/eval_when_body_never_runs/cli/mod.rs @@ -0,0 +1,3 @@ +pub mod args; +mod render; +pub mod workflow; diff --git a/packages/feature/lint-compile-time/src/eval_when_body_never_runs/cli/render.rs b/packages/feature/lint-compile-time/src/eval_when_body_never_runs/cli/render.rs new file mode 100644 index 00000000..c11b7f18 --- /dev/null +++ b/packages/feature/lint-compile-time/src/eval_when_body_never_runs/cli/render.rs @@ -0,0 +1,23 @@ +use paredit_core_cli::CliResult; + +use paredit_core_cli::args::ReportFormat; +use paredit_core_cli::runtime::Verbosity; + +use crate::eval_when_body_never_runs::usecase::EvalWhenBodyNeverRunsItem; +use paredit_core_cli::report::render::print_report; +use paredit_core_cli::report::{FileFindings, ReportPolicy}; + +pub fn print_eval_when_body_never_runs_report( + reports: &[FileFindings], + policy: &ReportPolicy, + output: ReportFormat, + verbosity: Verbosity, +) -> CliResult<()> { + print_report( + "inspect eval-when-body-never-runs", + reports, + policy, + output, + verbosity, + ) +} diff --git a/packages/feature/lint-compile-time/src/eval_when_body_never_runs/cli/workflow.rs b/packages/feature/lint-compile-time/src/eval_when_body_never_runs/cli/workflow.rs new file mode 100644 index 00000000..b48acf62 --- /dev/null +++ b/packages/feature/lint-compile-time/src/eval_when_body_never_runs/cli/workflow.rs @@ -0,0 +1,34 @@ +use paredit_core_cli::CommandResult; + +use crate::eval_when_body_never_runs::cli::args::EvalWhenBodyNeverRunsReportArgs; +use crate::eval_when_body_never_runs::cli::render::print_eval_when_body_never_runs_report; +use crate::eval_when_body_never_runs::usecase::{ + build_eval_when_body_never_runs_report, evaluate_fail_on_violation_policy, +}; +use paredit_core_cli::shared::{expand_input_files, read_input_dialect_and_tree}; + +pub fn eval_when_body_never_runs_report(args: EvalWhenBodyNeverRunsReportArgs) -> CommandResult { + let files = expand_input_files(&args.files, args.dialect)?; + + let mut reports = Vec::with_capacity(files.len()); + for file in &files { + let (_, dialect, tree) = read_input_dialect_and_tree(Some(file.clone()), args.dialect)?; + reports.push(build_eval_when_body_never_runs_report( + file, dialect, &tree, + )?); + } + + let policy = evaluate_fail_on_violation_policy(args.fail_on_violation, &reports); + let passed = policy.passed; + let message = policy.violations.join("; "); + + print_eval_when_body_never_runs_report(&reports, &policy, args.output, args.verbosity)?; + + if !passed { + return Err(paredit_core_cli::gate::gate_failure(format!( + "eval-when-body-never-runs-report policy failed: {message}" + ))); + } + + Ok(()) +} diff --git a/packages/feature/lint-compile-time/src/eval_when_body_never_runs/domain.rs b/packages/feature/lint-compile-time/src/eval_when_body_never_runs/domain.rs new file mode 100644 index 00000000..27835371 --- /dev/null +++ b/packages/feature/lint-compile-time/src/eval_when_body_never_runs/domain.rs @@ -0,0 +1,408 @@ +//! An `eval-when` that is *not* at top level and does not name `:execute`, so +//! its body never runs — in any phase. +//! +//! ```lisp +//! (defun run () +//! (eval-when (:compile-toplevel) (setf *marker* :fired)) +//! :done) +//! ``` +//! +//! CLHS 3.2.3.1 is explicit that `:compile-toplevel` and `:load-toplevel` are +//! considered **only** for a top level `eval-when`; anywhere else the form is +//! equivalent to `(if (member :execute situations) (progn body) nil)`. Naming +//! neither `:execute` nor `eval` in a nested `eval-when` therefore expands to +//! `nil`, and the body is dead code that reads like phase control. +//! +//! Verified against SBCL 2.6.0 on exactly that file, both phases: +//! +//! - `(load "src.lisp")` → `*marker*` is `:UNTOUCHED`. +//! - `(load (compile-file "src.lisp"))` → `*marker*` is `:UNTOUCHED`. +//! - the same body with `(eval-when (:execute) …)` → `:FIRED` in both phases. +//! - `(eval-when (:compile-toplevel :load-toplevel) …)` nested → `:UNTOUCHED` +//! in both phases. +//! +//! **SBCL emits no diagnostic whatsoever for this.** Not a warning, not a style +//! warning, not a note. That is what separates this rule from +//! [`crate::eval_when_execute_only`], whose subject SBCL at least style-warns +//! about downstream: here there is nothing to notice, in either phase, ever. The +//! author wrote code that they believe runs at compile time and it runs nowhere. +//! +//! # Deliberate limits +//! +//! - **Top level is CLHS 3.2.3.1's recursion, not depth 0.** The body of a +//! top-level `progn`/`locally`/`macrolet`/`symbol-macrolet`/`eval-when` is +//! still top level, so an `eval-when` there is *correct* to name +//! `:compile-toplevel` and is not flagged. Getting this wrong is what produced +//! false positives in an earlier batch in this repository; +//! [`crate::support::is_top_level_form`] enumerates the operators rather than +//! counting depth. +//! - **The situation list must name something.** `(eval-when () …)` is dead +//! everywhere, top level or not, and says nothing about phases. +//! - **The body must be non-empty.** `(eval-when (:compile-toplevel))` discards +//! nothing. +//! - **No fix.** Whether the author meant `:execute`, meant to hoist the form to +//! top level, or meant to delete it is not recoverable from the source. +//! +//! Scope: Common Lisp only. + +use std::path::Path; + +use paredit_core_cli::report::{FileFindings, Finding}; +use paredit_core_lint_engine::LintResult; +use paredit_core_syntax::dialect::Dialect; +use paredit_core_syntax::sexpr::{ByteSpan, ExpressionView, SyntaxTree}; +use serde_json::{Value, json}; + +use crate::eval_when_execute_only::domain::{EVAL_WHEN, is_eval_when}; +use crate::support::{ + EvalWhenSituations, for_each_evaluated_subview, is_top_level_form, mentions, read_situations, +}; + +/// Where an `eval-when`'s body begins: head, situations, then forms. +const BODY_START: usize = 2; + +#[derive(Debug, Clone)] +pub struct EvalWhenBodyNeverRunsItem { + /// The span of the whole `eval-when`. + pub span: ByteSpan, + /// The situations named, which are exactly the ones being ignored. + pub situations: String, + /// How many body forms never run. + pub body_form_count: usize, +} + +impl Finding for EvalWhenBodyNeverRunsItem { + fn kind(&self) -> &'static str { + "eval-when-body-never-runs" + } + + fn span(&self) -> ByteSpan { + self.span + } + + fn text_columns(&self) -> Vec { + vec![ + format!("situations={}", self.situations), + format!("body_form_count={}", self.body_form_count), + ] + } + + fn json_fields(&self) -> Vec<(&'static str, Value)> { + vec![ + ("situations", json!(self.situations)), + ("body_form_count", json!(self.body_form_count)), + ] + } + + fn message(&self) -> String { + format!( + "this eval-when is not a top level form, so {} {} ignored here and only :execute would \ + be considered; naming neither :execute nor eval means its {} body form(s) never run, \ + in any phase, with no diagnostic from the compiler", + self.situations, + if self.situations.contains(' ') { + "are" + } else { + "is" + }, + self.body_form_count + ) + } +} + +/// The situations named, in the standard spelling, for the message. +fn describe(situations: EvalWhenSituations) -> String { + let mut named = Vec::new(); + if situations.compile_toplevel { + named.push(":compile-toplevel"); + } + if situations.load_toplevel { + named.push(":load-toplevel"); + } + named.join(" ") +} + +/// The finding this `eval-when` implies, if any. +/// +/// **Ordering is load-bearing**, and in this rule it is the more important of +/// the two directions: the tree question here is the *expensive* one and the +/// one that is almost always answered "top level, no finding". Reading the +/// situation list first rejects every `eval-when` that names `:execute` — which +/// is nearly all of them, since the three-situation spelling is the idiom — +/// without touching the tree at all. +#[must_use] +pub fn examine_eval_when( + tree: &SyntaxTree, + view: &ExpressionView, +) -> Option { + // 1. node-local: the situation list. + let situations = read_situations(view.children.get(1)?)?; + if situations.execute || !situations.reaches_the_compiler() { + return None; + } + // 2. node-local: is anything actually discarded? + let body_form_count = view.children.get(BODY_START..).unwrap_or_default().len(); + if body_form_count == 0 { + return None; + } + // 3. only now, the tree. A top-level eval-when honours these situations and + // is correct; this rule is about the other context. + if is_top_level_form(tree, view.span) { + return None; + } + Some(EvalWhenBodyNeverRunsItem { + span: view.span, + situations: describe(situations), + body_form_count, + }) +} + +fn collect(tree: &SyntaxTree) -> (Vec, usize) { + let mut findings = Vec::new(); + let mut candidates = 0; + for_each_evaluated_subview(&tree.root_view(), |view| { + if !is_eval_when(view) { + return; + } + candidates += 1; + if let Some(item) = examine_eval_when(tree, view) { + findings.push(item); + } + }); + (findings, candidates) +} + +/// Collects the file's findings with the number of `eval-when` forms scanned as +/// the denominator beside it. +pub fn build_eval_when_body_never_runs_report( + path: &Path, + dialect: Dialect, + tree: &SyntaxTree, +) -> LintResult> { + if dialect != Dialect::CommonLisp { + return Ok(FileFindings::new( + path.to_path_buf(), + dialect, + false, + tree.source(), + Vec::new(), + vec![("eval_when_count", json!(0))], + )); + } + if !mentions(tree.source(), EVAL_WHEN) { + return Ok(FileFindings::new( + path.to_path_buf(), + dialect, + true, + tree.source(), + Vec::new(), + vec![("eval_when_count", json!(0))], + )); + } + let (findings, candidates) = collect(tree); + Ok(FileFindings::new( + path.to_path_buf(), + dialect, + true, + tree.source(), + findings, + vec![("eval_when_count", json!(candidates))], + )) +} + +#[cfg(test)] +mod tests { + use super::*; + + fn report(input: &str) -> FileFindings { + let tree = SyntaxTree::parse_with_dialect(input, Dialect::CommonLisp).expect("parse input"); + build_eval_when_body_never_runs_report(Path::new("app.lisp"), Dialect::CommonLisp, &tree) + .expect("build eval-when-body-never-runs report") + } + + fn findings(input: &str) -> Vec { + report(input).findings + } + + fn candidates(input: &str) -> u64 { + report(input) + .summary + .iter() + .find(|(name, _)| *name == "eval_when_count") + .and_then(|(_, value)| value.as_u64()) + .expect("eval_when_count in the summary") + } + + // --- positive: the shape SBCL says nothing about + + #[test] + fn flags_a_nested_compile_toplevel_only_eval_when() { + let found = findings( + "(defun run ()\n (eval-when (:compile-toplevel) (setf *m* :fired))\n :done)\n", + ); + assert_eq!(found.len(), 1); + assert_eq!(found[0].situations, ":compile-toplevel"); + assert_eq!(found[0].body_form_count, 1); + } + + #[test] + fn flags_a_nested_compile_and_load_toplevel_eval_when() { + let found = + findings("(defun run () (eval-when (:compile-toplevel :load-toplevel) (f) (g)))\n"); + assert_eq!(found.len(), 1); + assert_eq!(found[0].situations, ":compile-toplevel :load-toplevel"); + assert_eq!(found[0].body_form_count, 2); + } + + #[test] + fn flags_the_deprecated_spellings_too() { + assert_eq!( + findings("(defun run () (eval-when (compile) (f)))\n").len(), + 1 + ); + } + + #[test] + fn flags_it_inside_any_ordinary_binding_form() { + for source in [ + "(let () (eval-when (:compile-toplevel) (f)))", + "(lambda () (eval-when (:load-toplevel) (f)))", + "(when *flag* (eval-when (:compile-toplevel) (f)))", + "(defmacro m () (eval-when (:compile-toplevel) (f)))", + ] { + assert_eq!(findings(source).len(), 1, "missed: {source}"); + } + } + + /// A `macrolet`'s *bindings* are not its body, so an `eval-when` there is + /// not a top level form and is correctly flagged. + #[test] + fn flags_it_in_a_non_body_position_of_a_top_level_operator() { + assert_eq!( + findings("(macrolet ((m () (eval-when (:compile-toplevel) (f)))) 1)").len(), + 1 + ); + } + + // --- negatives: the shapes that are correct + + /// The whole point of the rule: at top level these situations are honoured. + #[test] + fn does_not_flag_a_top_level_eval_when() { + assert!(findings("(eval-when (:compile-toplevel) (defmacro m () 1))\n").is_empty()); + assert!(findings("(eval-when (:compile-toplevel :load-toplevel) (f))\n").is_empty()); + } + + /// CLHS 3.2.3.1's recursion. Getting this wrong is what produced false + /// positives in an earlier batch here. + #[test] + fn does_not_flag_inside_the_top_level_preserving_operators() { + for source in [ + "(progn (eval-when (:compile-toplevel) (f)))", + "(locally (eval-when (:compile-toplevel) (f)))", + "(macrolet () (eval-when (:compile-toplevel) (f)))", + "(symbol-macrolet () (eval-when (:compile-toplevel) (f)))", + "(eval-when (:compile-toplevel) (eval-when (:compile-toplevel) (f)))", + "(progn (progn (eval-when (:compile-toplevel) (f))))", + ] { + assert!(findings(source).is_empty(), "false positive on: {source}"); + } + } + + /// A nested `eval-when` naming `:execute` is the correct spelling there. + #[test] + fn does_not_flag_a_nested_eval_when_that_names_execute() { + assert!(findings("(defun run () (eval-when (:execute) (f)))\n").is_empty()); + assert!( + findings("(defun run () (eval-when (:compile-toplevel :execute) (f)))\n").is_empty() + ); + assert!(findings("(defun run () (eval-when (eval) (f)))\n").is_empty()); + } + + #[test] + fn does_not_flag_an_empty_situation_list_or_an_empty_body() { + assert!(findings("(defun run () (eval-when () (f)))\n").is_empty()); + assert!(findings("(defun run () (eval-when (:compile-toplevel)))\n").is_empty()); + } + + #[test] + fn does_not_flag_a_reader_conditional_situation_list() { + assert!(findings("(defun run () (eval-when (#+sbcl :compile-toplevel) (f)))\n").is_empty()); + } + + // --- quote negatives + + #[test] + fn quoted_data_is_never_a_finding() { + for source in [ + "'(defun run () (eval-when (:compile-toplevel) (f)))", + "(quote (eval-when (:compile-toplevel) (f)))", + "`(defun run () (eval-when (:compile-toplevel) (f)))", + "'(a ,(eval-when (:compile-toplevel) (f)))", + ] { + assert!(findings(source).is_empty(), "flagged data: {source}"); + } + } + + /// A macro that emits this shape into its *template* is writing code for + /// somewhere else, where it may well be top level. + #[test] + fn a_template_inside_a_macro_body_is_data_and_is_not_flagged() { + assert!(findings("(defmacro m () `(eval-when (:compile-toplevel) (f)))\n").is_empty()); + } + + // --- denominator and envelope + + #[test] + fn the_denominator_counts_every_eval_when_reached_as_code() { + assert_eq!( + candidates( + "(eval-when (:compile-toplevel) (f))\n(defun g () (eval-when (:compile-toplevel) (h)))\n" + ), + 2 + ); + assert_eq!(candidates("(defun f () 1)\n"), 0); + } + + #[test] + fn a_non_common_lisp_dialect_is_reported_as_unmodelled() { + let tree = + SyntaxTree::parse_with_dialect("(eval-when (:compile-toplevel) 1)", Dialect::Clojure) + .expect("parse"); + let report = + build_eval_when_body_never_runs_report(Path::new("app.clj"), Dialect::Clojure, &tree) + .expect("build report"); + assert!(!report.dialect_modelled); + assert!(report.findings.is_empty()); + } + + #[test] + fn a_finding_carries_its_line_its_kind_and_its_fields() { + let report = report("\n(defun run () (eval-when (:compile-toplevel) (f)))\n"); + let finding = &report.findings[0]; + assert_eq!(report.line_of(finding), 2); + assert_eq!(finding.kind(), "eval-when-body-never-runs"); + assert_eq!( + finding.json_fields(), + vec![ + ("situations", json!(":compile-toplevel")), + ("body_form_count", json!(1)), + ] + ); + assert!(finding.message().contains("never run")); + } + + /// Singular and plural agreement, since the message names a variable number + /// of situations. + #[test] + fn the_message_agrees_with_the_number_of_situations_named() { + let one = findings("(defun run () (eval-when (:compile-toplevel) (f)))\n"); + assert!(one[0].message().contains(":compile-toplevel is ignored")); + let two = findings("(defun run () (eval-when (:compile-toplevel :load-toplevel) (f)))\n"); + assert!( + two[0] + .message() + .contains(":compile-toplevel :load-toplevel are ignored") + ); + } +} diff --git a/packages/feature/lint-compile-time/src/eval_when_body_never_runs/mod.rs b/packages/feature/lint-compile-time/src/eval_when_body_never_runs/mod.rs new file mode 100644 index 00000000..8a604200 --- /dev/null +++ b/packages/feature/lint-compile-time/src/eval_when_body_never_runs/mod.rs @@ -0,0 +1,10 @@ +//! The `eval-when-body-never-runs` lint rule: its adapter, detection, use case +//! and command. +//! +//! One rule, one directory. `rule` is what the registry registers; the rest is +//! the report it drives. + +pub mod cli; +pub mod domain; +pub mod rule; +pub mod usecase; diff --git a/packages/feature/lint-compile-time/src/eval_when_body_never_runs/rule.rs b/packages/feature/lint-compile-time/src/eval_when_body_never_runs/rule.rs new file mode 100644 index 00000000..386e29bd --- /dev/null +++ b/packages/feature/lint-compile-time/src/eval_when_body_never_runs/rule.rs @@ -0,0 +1,162 @@ +//! `eval-when-body-never-runs`: a nested `eval-when` whose situations the +//! standard ignores, so its body never runs. +//! +//! The analysis lives in [`crate::eval_when_body_never_runs::domain`]; this +//! module only registers it with the lint suite. +//! +//! # Cost +//! +//! `HeadFilter::Heads(&["eval-when"])` — the same head as +//! [`crate::eval_when_execute_only`], and the two are complements rather than +//! duplicates: that rule fires only on a *top level* `eval-when` missing both +//! top-level situations, this one only on a *non*-top-level `eval-when` missing +//! `:execute`. No form can satisfy both, and a test in this module pins that. +//! +//! Sharing a head costs nothing: the head index maps one key to a list of +//! rules, so a second rule on `eval-when` adds one `check` call per `eval-when` +//! node and no extra walking. Files in `clean/forms/*` contain no `eval-when` +//! and so dispatch neither rule. +//! +//! Within `check`, the situation list is read from the dispatched node before +//! [`is_top_level_form`] touches the tree. That order matters more here than in +//! the sibling rule: the tree question is the expensive one *and* the one that +//! nearly always says "top level, no finding", so answering the cheap question +//! first is what keeps the common case free. +//! +//! Never `binding_table()`/`value_table()`/`type_table()`, never +//! `RuleContext::scratch_cache`. +//! +//! [`is_top_level_form`]: crate::support::is_top_level_form + +use paredit_core_lint_engine::LintResult; + +use crate::eval_when_body_never_runs::domain::examine_eval_when; +use crate::eval_when_execute_only::domain::is_eval_when; +use paredit_core_cli::report::Finding; +use paredit_core_lint_engine::engine::{RuleContext, RuleSink}; +use paredit_core_lint_engine::model::{ + Fixability, HeadFilter, NormalizedHead, RuleCategory, RuleMeta, Severity, +}; +use paredit_core_lint_engine::rule::LintRule; +use paredit_core_syntax::sexpr::ExpressionView; + +pub const META: RuleMeta = RuleMeta::new( + "eval-when-body-never-runs", + // The body is unreachable in every phase. That is dead code, and unlike the + // sibling rule's subject it is dead rather than merely misplaced. + RuleCategory::DeadCode, + // Certain, not probable: CLHS 3.2.3.1 makes a nested eval-when without + // :execute equivalent to nil, and SBCL emits no diagnostic at all. + Severity::Error, + "a non-top-level eval-when naming only situations the standard ignores there, so its body \ + never runs", + // Whether :execute was meant, or the form should be hoisted, or deleted, is + // not recoverable from the source. + Fixability::ReportOnly, +); + +const HEADS: [NormalizedHead; 1] = [NormalizedHead::new("eval-when")]; + +#[derive(Debug)] +pub struct Rule; + +pub const RULE: Rule = Rule; + +impl LintRule for Rule { + fn head_filter(&self) -> HeadFilter { + HeadFilter::Heads(&HEADS) + } + + fn check( + &self, + context: &RuleContext<'_>, + view: &ExpressionView, + sink: &mut RuleSink<'_, '_>, + ) -> LintResult<()> { + if !is_eval_when(view) { + return Ok(()); + } + let Some(item) = examine_eval_when(context.tree(), view) else { + return Ok(()); + }; + sink.report(item.span, item.message()); + Ok(()) + } +} + +#[cfg(test)] +mod tests { + use super::*; + use crate::support::run_rule; + use paredit_core_lint_engine::rule::RuleEntry; + + static ENTRIES: [RuleEntry; 1] = [RuleEntry::new(&META, &RULE)]; + + fn messages(source: &str) -> Vec { + run_rule(&ENTRIES, source) + } + + #[test] + fn the_declared_head_reaches_the_rule() { + assert_eq!( + messages("(defun f () (eval-when (:compile-toplevel) (g)))\n").len(), + 1 + ); + } + + #[test] + fn every_eval_when_spelling_survives_dispatch_and_the_recheck() { + for head in ["eval-when", "cl:eval-when", "EVAL-WHEN"] { + assert_eq!( + messages(&format!("(defun f () ({head} (:compile-toplevel) (g)))\n")).len(), + 1, + "`{head}` did not reach a finding" + ); + } + } + + #[test] + fn a_top_level_eval_when_produces_nothing_through_the_engine() { + assert!(messages("(eval-when (:compile-toplevel) (defmacro m () 1))\n").is_empty()); + assert!(messages("(progn (eval-when (:compile-toplevel) (f)))\n").is_empty()); + } + + #[test] + fn a_file_with_no_eval_when_produces_nothing() { + assert!(messages("(defun f () 1)\n").is_empty()); + assert!(messages("").is_empty()); + } + + /// The two `eval-when` rules in this package are complements. Running both + /// catalogues over the same corpus of shapes must never produce two findings + /// for one form — if it did, one of the two predicates would be wrong about + /// what "top level" means. + #[test] + fn the_two_eval_when_rules_never_both_fire_on_one_form() { + use crate::eval_when_execute_only; + static BOTH: [RuleEntry; 2] = [ + RuleEntry::new( + &eval_when_execute_only::rule::META, + &eval_when_execute_only::rule::RULE, + ), + RuleEntry::new(&META, &RULE), + ]; + for source in [ + "(eval-when (:execute) (defmacro m () 1))", + "(eval-when (:compile-toplevel) (defmacro m () 1))", + "(eval-when () (defmacro m () 1))", + "(eval-when (:compile-toplevel :load-toplevel :execute) (defmacro m () 1))", + "(defun f () (eval-when (:execute) (defmacro m () 1)))", + "(defun f () (eval-when (:compile-toplevel) (defmacro m () 1)))", + "(progn (eval-when (:execute) (defmacro m () 1)))", + "(let () (eval-when (:load-toplevel) (defmacro m () 1)))", + "(macrolet ((q () (eval-when (:execute) (defmacro m () 1)))) 1)", + ] { + let found = run_rule(&BOTH, source); + assert!( + found.len() <= 1, + "both rules fired on `{source}`: {found:?}" + ); + } + } +} diff --git a/packages/feature/lint-compile-time/src/eval_when_body_never_runs/usecase.rs b/packages/feature/lint-compile-time/src/eval_when_body_never_runs/usecase.rs new file mode 100644 index 00000000..92bff93d --- /dev/null +++ b/packages/feature/lint-compile-time/src/eval_when_body_never_runs/usecase.rs @@ -0,0 +1,25 @@ +//! Ignored-situation `eval-when` detection across explicit files. + +pub use crate::eval_when_body_never_runs::domain::{ + EvalWhenBodyNeverRunsItem, build_eval_when_body_never_runs_report, +}; + +use paredit_core_cli::report::{FileFindings, ReportPolicy}; + +/// Evaluates this report's gate. +#[must_use] +pub fn evaluate_fail_on_violation_policy( + fail_on_violation: bool, + reports: &[FileFindings], +) -> ReportPolicy { + ReportPolicy::fail_on_any( + fail_on_violation.then_some("--fail-on-violation"), + reports, + |report| { + format!( + "{} has an eval-when whose body never runs", + report.path.display() + ) + }, + ) +} diff --git a/packages/feature/lint-compile-time/src/eval_when_execute_only/cli/args.rs b/packages/feature/lint-compile-time/src/eval_when_execute_only/cli/args.rs new file mode 100644 index 00000000..4257e051 --- /dev/null +++ b/packages/feature/lint-compile-time/src/eval_when_execute_only/cli/args.rs @@ -0,0 +1,25 @@ +use std::path::PathBuf; + +use clap::Args; + +use paredit_core_cli::args::{DialectArg, ReportFormat}; +use paredit_core_cli::runtime::Verbosity; + +#[derive(Debug, Args)] +pub struct EvalWhenExecuteOnlyReportArgs { + /// Files or directories to scan. + #[arg(required = true)] + pub files: Vec, + /// Override extension-based dialect detection for every file. + #[arg(long)] + pub dialect: Option, + /// Exit with failure when any file has an eval-when compile-file discards. + #[arg(long)] + pub fail_on_violation: bool, + /// Output format for agent consumption. + #[arg(long, value_enum, default_value_t = ReportFormat::Json)] + pub output: ReportFormat, + /// How much detail the report includes. + #[arg(long, value_enum, default_value_t = Verbosity::Normal)] + pub verbosity: Verbosity, +} diff --git a/packages/feature/lint-compile-time/src/eval_when_execute_only/cli/mod.rs b/packages/feature/lint-compile-time/src/eval_when_execute_only/cli/mod.rs new file mode 100644 index 00000000..c5257b37 --- /dev/null +++ b/packages/feature/lint-compile-time/src/eval_when_execute_only/cli/mod.rs @@ -0,0 +1,3 @@ +pub mod args; +mod render; +pub mod workflow; diff --git a/packages/feature/lint-compile-time/src/eval_when_execute_only/cli/render.rs b/packages/feature/lint-compile-time/src/eval_when_execute_only/cli/render.rs new file mode 100644 index 00000000..19e003f7 --- /dev/null +++ b/packages/feature/lint-compile-time/src/eval_when_execute_only/cli/render.rs @@ -0,0 +1,23 @@ +use paredit_core_cli::CliResult; + +use paredit_core_cli::args::ReportFormat; +use paredit_core_cli::runtime::Verbosity; + +use crate::eval_when_execute_only::usecase::EvalWhenExecuteOnlyItem; +use paredit_core_cli::report::render::print_report; +use paredit_core_cli::report::{FileFindings, ReportPolicy}; + +pub fn print_eval_when_execute_only_report( + reports: &[FileFindings], + policy: &ReportPolicy, + output: ReportFormat, + verbosity: Verbosity, +) -> CliResult<()> { + print_report( + "inspect eval-when-execute-only", + reports, + policy, + output, + verbosity, + ) +} diff --git a/packages/feature/lint-compile-time/src/eval_when_execute_only/cli/workflow.rs b/packages/feature/lint-compile-time/src/eval_when_execute_only/cli/workflow.rs new file mode 100644 index 00000000..3c329212 --- /dev/null +++ b/packages/feature/lint-compile-time/src/eval_when_execute_only/cli/workflow.rs @@ -0,0 +1,32 @@ +use paredit_core_cli::CommandResult; + +use crate::eval_when_execute_only::cli::args::EvalWhenExecuteOnlyReportArgs; +use crate::eval_when_execute_only::cli::render::print_eval_when_execute_only_report; +use crate::eval_when_execute_only::usecase::{ + build_eval_when_execute_only_report, evaluate_fail_on_violation_policy, +}; +use paredit_core_cli::shared::{expand_input_files, read_input_dialect_and_tree}; + +pub fn eval_when_execute_only_report(args: EvalWhenExecuteOnlyReportArgs) -> CommandResult { + let files = expand_input_files(&args.files, args.dialect)?; + + let mut reports = Vec::with_capacity(files.len()); + for file in &files { + let (_, dialect, tree) = read_input_dialect_and_tree(Some(file.clone()), args.dialect)?; + reports.push(build_eval_when_execute_only_report(file, dialect, &tree)?); + } + + let policy = evaluate_fail_on_violation_policy(args.fail_on_violation, &reports); + let passed = policy.passed; + let message = policy.violations.join("; "); + + print_eval_when_execute_only_report(&reports, &policy, args.output, args.verbosity)?; + + if !passed { + return Err(paredit_core_cli::gate::gate_failure(format!( + "eval-when-execute-only-report policy failed: {message}" + ))); + } + + Ok(()) +} diff --git a/packages/feature/lint-compile-time/src/eval_when_execute_only/domain.rs b/packages/feature/lint-compile-time/src/eval_when_execute_only/domain.rs new file mode 100644 index 00000000..ef00d74e --- /dev/null +++ b/packages/feature/lint-compile-time/src/eval_when_execute_only/domain.rs @@ -0,0 +1,478 @@ +//! A top-level `eval-when` that names `:execute` and neither top-level +//! situation, wrapped around a definition. +//! +//! ```lisp +//! (eval-when (:execute) +//! (defmacro m (x) `(* ,x 10))) +//! +//! (defun run () (m 4)) +//! ``` +//! +//! `load`ing that file works and returns 40. `compile-file`ing it and loading +//! the fasl does not: CLHS 3.2.3.1 says a top-level `eval-when` naming neither +//! `:compile-toplevel` nor `:load-toplevel` is **not processed at all** by the +//! file compiler, so the `defmacro` never reaches the compiler and never reaches +//! the fasl. `(m 4)` compiles as a call to an undefined function and fails at +//! run time. +//! +//! Verified against SBCL 2.6.0, both phases, on exactly that file: +//! +//! - `(load "src.lisp")` → `40`, no diagnostic at all. +//! - `(load (compile-file "src.lisp"))` → one **style** warning, `undefined +//! function: M`, `warnings-p` and `failure-p` both `NIL` — so the build is +//! *green* — then `UNDEFINED-FUNCTION: The function M is undefined` when the +//! code is finally called. +//! +//! That gap is the entire point of the rule. The compile is reported as +//! successful, and the failure surfaces later, somewhere else, as a missing +//! function rather than as a phase mistake. +//! +//! # Why the situation set is exactly this one +//! +//! The four other shapes were measured on the same file and are **not** flagged: +//! +//! | situations | `load` | `compile-file` + load fasl | +//! | --- | --- | --- | +//! | *(no `eval-when` at all)* | 40 | 40 | +//! | `:compile-toplevel :load-toplevel :execute` | 40 | 40 | +//! | `:load-toplevel :execute` | 40 | **40** | +//! | `:execute` | 40 | **undefined function** | +//! +//! The third row is the surprising one, and it is why this rule does *not* ask +//! "does the situation list contain `:compile-toplevel`?". It does not need to: +//! `defmacro`'s own expansion contains an inner `(eval-when (:compile-toplevel) +//! …)`, and CLHS 3.2.3.1 keeps the body of a top-level `eval-when` top level, so +//! the inner one still runs at compile time. Omitting `:compile-toplevel` is +//! therefore harmless as long as `:load-toplevel` is present. A rule written +//! against the obvious predicate would have fired on every +//! `(eval-when (:load-toplevel :execute) …)` in the world, which is a correct +//! and common idiom. +//! +//! What actually matters is whether the body reaches the compiler **at all**, +//! which is [`EvalWhenSituations::reaches_the_compiler`]. +//! +//! # Deliberate limits +//! +//! - **`:execute` must be named.** `(eval-when () …)` also reaches no +//! compiler, but it does nothing under `load` either, so it is dead in every +//! phase rather than phase-dependent — a different and much more obvious +//! defect. Requiring `:execute` keeps the rule's name exactly true of what it +//! reports. +//! - **The body must contain a definition.** `(eval-when (:execute) (format t +//! "interactive only"))` is a judgement about intent — a form deliberately +//! confined to the interpreter. A *definition* that silently does not exist in +//! the compiled file is not a judgement call. +//! - **Top level only**, in the CLHS 3.2.3.1 sense, which includes the body of +//! a top-level `progn`/`locally`/`macrolet`/`symbol-macrolet`/`eval-when`. +//! Nested inside a `let` or a `defun`, `:compile-toplevel` and +//! `:load-toplevel` are ignored by the standard and `(eval-when (:execute) …)` +//! is the *correct* spelling — flagging it there is a false positive, and +//! [`crate::eval_when_body_never_runs`] is the rule about that context. +//! - **No fix.** Which situations were meant cannot be recovered from the +//! source: `:load-toplevel :execute` and the full three are both plausible, +//! and so is deleting the `eval-when`. +//! +//! Scope: Common Lisp only. + +use std::path::Path; + +use paredit_core_cli::report::{FileFindings, Finding}; +use paredit_core_lint_engine::LintResult; +use paredit_core_syntax::dialect::Dialect; +use paredit_core_syntax::sexpr::{ByteSpan, ExpressionView, SyntaxTree}; +use paredit_core_syntax::view_query::{atom_text, is_paren_list, list_head}; +use serde_json::{Value, json}; + +use crate::support::{ + for_each_evaluated_subview, is_definition_form, is_top_level_form, mentions, normalized_symbol, + read_situations, +}; + +/// The byte-scan needle, and the head this rule anchors on. +pub const EVAL_WHEN: &str = "eval-when"; + +/// Where an `eval-when`'s body begins: head, situations, then forms. +const BODY_START: usize = 2; + +#[derive(Debug, Clone)] +pub struct EvalWhenExecuteOnlyItem { + /// The span of the whole `eval-when`, which is what would have to change. + pub span: ByteSpan, + /// The definition the compiled file will not contain, named as written. + pub definition: String, + /// How many definition forms the body holds. All of them are lost, not just + /// the one named. + pub definition_count: usize, +} + +impl Finding for EvalWhenExecuteOnlyItem { + fn kind(&self) -> &'static str { + "eval-when-execute-only" + } + + fn span(&self) -> ByteSpan { + self.span + } + + fn text_columns(&self) -> Vec { + vec![ + format!("definition={}", self.definition), + format!("definition_count={}", self.definition_count), + ] + } + + fn json_fields(&self) -> Vec<(&'static str, Value)> { + vec![ + ("definition", json!(self.definition)), + ("definition_count", json!(self.definition_count)), + ] + } + + fn message(&self) -> String { + format!( + "this eval-when names :execute and neither :compile-toplevel nor :load-toplevel, so \ + compile-file discards its body entirely and the compiled file will not contain {} \ + (loading the source works, which is what hides it)", + self.definition + ) + } +} + +/// Whether `view` is an `(eval-when …)` form. +#[must_use] +pub fn is_eval_when(view: &ExpressionView) -> bool { + is_paren_list(view) && list_head(view).is_some_and(|head| normalized_symbol(head) == EVAL_WHEN) +} + +/// The definitions in an `eval-when`'s body, as written. +fn body_definitions(view: &ExpressionView) -> Vec { + view.children + .get(BODY_START..) + .unwrap_or_default() + .iter() + .filter(|form| is_definition_form(form)) + .map(|form| { + let head = list_head(form).unwrap_or("?"); + let name = form.children.get(1).and_then(atom_text).unwrap_or(""); + if name.is_empty() { + format!("({head} …)") + } else { + format!("({head} {name} …)") + } + }) + .collect() +} + +/// The finding this `eval-when` implies, if any. +/// +/// **Ordering is load-bearing.** The situation list and the body are read from +/// `view` alone — no tree access, no allocation beyond the situation read — and +/// they reject all but a handful of forms per file. Only then does +/// [`is_top_level_form`] touch the tree, which costs the enclosing top-level +/// form. Asking the top-level question first would pay that cost for every +/// `eval-when` in the corpus, including the overwhelming majority that name all +/// three situations and cannot produce a finding at all. +#[must_use] +pub fn examine_eval_when( + tree: &SyntaxTree, + view: &ExpressionView, +) -> Option { + // 1. node-local: the situation list. + let situations = read_situations(view.children.get(1)?)?; + if !situations.execute || situations.reaches_the_compiler() { + return None; + } + // 2. node-local: is anything actually lost? + let definitions = body_definitions(view); + let definition = definitions.first()?.clone(); + // 3. only now, the tree. + if !is_top_level_form(tree, view.span) { + return None; + } + Some(EvalWhenExecuteOnlyItem { + span: view.span, + definition, + definition_count: definitions.len(), + }) +} + +/// Every `eval-when` in the file, reached as evaluated code, with its finding. +fn collect(tree: &SyntaxTree) -> (Vec, usize) { + let mut findings = Vec::new(); + let mut candidates = 0; + for_each_evaluated_subview(&tree.root_view(), |view| { + if !is_eval_when(view) { + return; + } + candidates += 1; + if let Some(item) = examine_eval_when(tree, view) { + findings.push(item); + } + }); + (findings, candidates) +} + +/// Collects the file's findings with the number of `eval-when` forms scanned as +/// the denominator beside it. +/// +/// A dialect this rule does not model is reported as unmodelled rather than as +/// clean: an empty finding list means "every eval-when here reaches the +/// compiler" for Common Lisp and "nothing was looked for" for Clojure, and the +/// two read identically without the flag. +pub fn build_eval_when_execute_only_report( + path: &Path, + dialect: Dialect, + tree: &SyntaxTree, +) -> LintResult> { + if dialect != Dialect::CommonLisp { + return Ok(FileFindings::new( + path.to_path_buf(), + dialect, + false, + tree.source(), + Vec::new(), + vec![("eval_when_count", json!(0))], + )); + } + // The byte scan settles every file that never says `eval-when` without + // materializing the document at all. + if !mentions(tree.source(), EVAL_WHEN) { + return Ok(FileFindings::new( + path.to_path_buf(), + dialect, + true, + tree.source(), + Vec::new(), + vec![("eval_when_count", json!(0))], + )); + } + let (findings, candidates) = collect(tree); + Ok(FileFindings::new( + path.to_path_buf(), + dialect, + true, + tree.source(), + findings, + vec![("eval_when_count", json!(candidates))], + )) +} + +#[cfg(test)] +mod tests { + use super::*; + + fn report(input: &str) -> FileFindings { + // `parse_with_dialect`, never the legacy `SyntaxTree::parse`. + let tree = SyntaxTree::parse_with_dialect(input, Dialect::CommonLisp).expect("parse input"); + build_eval_when_execute_only_report(Path::new("app.lisp"), Dialect::CommonLisp, &tree) + .expect("build eval-when-execute-only report") + } + + fn findings(input: &str) -> Vec { + report(input).findings + } + + fn candidates(input: &str) -> u64 { + report(input) + .summary + .iter() + .find(|(name, _)| *name == "eval_when_count") + .and_then(|(_, value)| value.as_u64()) + .expect("eval_when_count in the summary") + } + + // --- positive: the shape SBCL loses under compile-file + + #[test] + fn flags_execute_only_around_a_defmacro() { + let found = findings("(eval-when (:execute)\n (defmacro m (x) `(* ,x 10)))\n"); + assert_eq!(found.len(), 1); + assert_eq!(found[0].definition, "(defmacro m …)"); + assert_eq!(found[0].definition_count, 1); + } + + #[test] + fn flags_execute_only_around_a_defconstant() { + // Verified separately against SBCL: `(eval-when (:execute) (defconstant + // +k+ 41))` then `(defun plus1 () (1+ +k+))` loads fine and fails to + // compile with `undefined variable: +K+`. + let found = findings("(eval-when (:execute) (defconstant +k+ 41))\n"); + assert_eq!(found.len(), 1); + assert_eq!(found[0].definition, "(defconstant +k+ …)"); + } + + #[test] + fn flags_the_deprecated_eval_spelling() { + assert_eq!(findings("(eval-when (eval) (defmacro m () 1))\n").len(), 1); + } + + #[test] + fn counts_every_definition_the_compiled_file_will_lack() { + let found = findings( + "(eval-when (:execute)\n (defmacro m () 1)\n (defun f () 2)\n (defconstant +c+ 3))\n", + ); + assert_eq!(found[0].definition_count, 3); + assert_eq!(found[0].definition, "(defmacro m …)"); + } + + /// CLHS 3.2.3.1: the body of a top-level `progn` is itself top level, and + /// SBCL 2.6.0 loses this exactly as it loses the depth-0 spelling. + #[test] + fn flags_the_top_level_preserving_nestings() { + for source in [ + "(progn (eval-when (:execute) (defmacro m () 1)))", + "(locally (eval-when (:execute) (defmacro m () 1)))", + "(macrolet () (eval-when (:execute) (defmacro m () 1)))", + "(symbol-macrolet () (eval-when (:execute) (defmacro m () 1)))", + ] { + assert_eq!(findings(source).len(), 1, "missed: {source}"); + } + } + + // --- negatives: the shapes that are correct + + /// The row that kills the obvious "missing :compile-toplevel" predicate. + #[test] + fn does_not_flag_load_toplevel_and_execute() { + assert!(findings("(eval-when (:load-toplevel :execute) (defmacro m () 1))\n").is_empty()); + } + + #[test] + fn does_not_flag_the_full_three_situations() { + assert!( + findings("(eval-when (:compile-toplevel :load-toplevel :execute) (defmacro m () 1))\n") + .is_empty() + ); + assert!(findings("(eval-when (compile load eval) (defmacro m () 1))\n").is_empty()); + } + + #[test] + fn does_not_flag_compile_toplevel_alone() { + assert!(findings("(eval-when (:compile-toplevel) (defmacro m () 1))\n").is_empty()); + } + + /// A body with no definition loses nothing a later form can miss. + #[test] + fn does_not_flag_execute_only_around_a_plain_call() { + assert!(findings("(eval-when (:execute) (format t \"interactive only~%\"))\n").is_empty()); + assert!(findings("(eval-when (:execute) (setf *debug* t))\n").is_empty()); + } + + /// Names nothing, so it is dead in every phase rather than phase-dependent. + #[test] + fn does_not_flag_an_empty_situation_list() { + assert!(findings("(eval-when () (defmacro m () 1))\n").is_empty()); + } + + /// Nested inside a binding form, `:compile-toplevel` and `:load-toplevel` + /// are ignored by the standard, so `(eval-when (:execute) …)` is the + /// *correct* spelling and flagging it is a false positive. + #[test] + fn does_not_flag_a_non_top_level_eval_when() { + for source in [ + "(let () (eval-when (:execute) (defmacro m () 1)))", + "(defun f () (eval-when (:execute) (defmacro m () 1)))", + "(when *flag* (eval-when (:execute) (defmacro m () 1)))", + ] { + assert!(findings(source).is_empty(), "false positive on: {source}"); + } + } + + /// The situations list of an outer `eval-when` is not one of its body forms. + #[test] + fn does_not_flag_a_candidate_in_a_non_body_position() { + assert!( + findings("(macrolet ((m () (eval-when (:execute) (defmacro q () 1)))) 2)").is_empty() + ); + } + + #[test] + fn does_not_flag_a_reader_conditional_situation_list() { + // `#+sbcl :compile-toplevel` folds into one atom, so the situation set + // cannot be read exactly. Saying nothing beats guessing it absent. + assert!( + findings("(eval-when (#+sbcl :compile-toplevel :execute) (defmacro m () 1))\n") + .is_empty() + ); + } + + // --- quote/quasiquote negatives (the five shapes) + + #[test] + fn quoted_data_is_never_a_finding() { + for source in [ + "'(eval-when (:execute) (defmacro m () 1))", + "(quote (eval-when (:execute) (defmacro m () 1)))", + "'(a ,(eval-when (:execute) (defmacro m () 1)))", + "`(eval-when (:execute) (defmacro m () 1))", + ] { + assert!(findings(source).is_empty(), "flagged data: {source}"); + } + } + + /// A macro that *emits* an `eval-when` is writing a template, not running + /// one; the comma is what makes the difference. + #[test] + fn an_unquoted_eval_when_inside_a_backquote_is_code_but_is_not_top_level() { + assert!(findings("`(a ,(eval-when (:execute) (defmacro m () 1)))").is_empty()); + } + + #[test] + fn a_form_inside_a_string_literal_is_one_atom() { + assert!(findings("(format t \"(eval-when (:execute) (defmacro m () 1))\")").is_empty()); + assert_eq!( + candidates("(format t \"(eval-when (:execute) (defmacro m () 1))\")"), + 0 + ); + } + + // --- denominator + + #[test] + fn the_denominator_counts_every_eval_when_reached_as_code() { + assert_eq!( + candidates( + "(eval-when (:compile-toplevel :load-toplevel :execute) (defmacro a () 1))\n\ + (eval-when (:execute) (defmacro b () 2))\n\ + (let () (eval-when (:execute) (defmacro c () 3)))\n" + ), + 3 + ); + } + + #[test] + fn a_file_that_never_says_eval_when_has_a_zero_denominator() { + assert_eq!(candidates("(defun f () 1)\n"), 0); + assert_eq!(candidates(""), 0); + } + + // --- envelope + + #[test] + fn a_non_common_lisp_dialect_is_reported_as_unmodelled() { + let tree = SyntaxTree::parse_with_dialect("(eval-when (:execute) 1)", Dialect::Clojure) + .expect("parse"); + let report = + build_eval_when_execute_only_report(Path::new("app.clj"), Dialect::Clojure, &tree) + .expect("build report"); + assert!(!report.dialect_modelled); + assert!(report.findings.is_empty()); + assert_eq!(report.summary, vec![("eval_when_count", json!(0))]); + } + + #[test] + fn a_finding_carries_its_line_its_kind_and_its_fields() { + let report = report("\n(eval-when (:execute) (defmacro m () 1))\n"); + let finding = &report.findings[0]; + assert_eq!(report.line_of(finding), 2); + assert_eq!(finding.kind(), "eval-when-execute-only"); + assert_eq!( + finding.json_fields(), + vec![ + ("definition", json!("(defmacro m …)")), + ("definition_count", json!(1)), + ] + ); + assert!(finding.message().contains("compile-file discards")); + } +} diff --git a/packages/feature/lint-compile-time/src/eval_when_execute_only/mod.rs b/packages/feature/lint-compile-time/src/eval_when_execute_only/mod.rs new file mode 100644 index 00000000..81573cdb --- /dev/null +++ b/packages/feature/lint-compile-time/src/eval_when_execute_only/mod.rs @@ -0,0 +1,10 @@ +//! The `eval-when-execute-only` lint rule: its adapter, detection, use case and +//! command. +//! +//! One rule, one directory. `rule` is what the registry registers; the rest is +//! the report it drives. + +pub mod cli; +pub mod domain; +pub mod rule; +pub mod usecase; diff --git a/packages/feature/lint-compile-time/src/eval_when_execute_only/rule.rs b/packages/feature/lint-compile-time/src/eval_when_execute_only/rule.rs new file mode 100644 index 00000000..850d8a1a --- /dev/null +++ b/packages/feature/lint-compile-time/src/eval_when_execute_only/rule.rs @@ -0,0 +1,153 @@ +//! `eval-when-execute-only`: a top-level `eval-when` whose body `compile-file` +//! discards. +//! +//! The analysis lives in [`crate::eval_when_execute_only::domain`], which also +//! backs the standalone `inspect eval-when-execute-only` command; this module +//! only registers it with the lint suite. +//! +//! # Cost +//! +//! `HeadFilter::Heads(&["eval-when"])`, so the rule is never dispatched on a +//! file without an `eval-when` — which is every file in `clean/forms/*`, the +//! benchmark whose 10% threshold has failed this project five times. A +//! `WholeTree` rule would be dispatched on all of them and pay a byte scan each; +//! this pays nothing, because the head index answers before `check` is reached. +//! +//! Within `check` the ordering is the one the module docs of +//! [`crate::support`] insist on: the situation list and the body are read from +//! the dispatched node alone, and only a form that has already failed both +//! node-local tests reaches [`is_top_level_form`], which materializes the +//! enclosing top-level form. A sibling package measured 450843 ns/call against +//! 28 ns/call purely from getting that order the wrong way round. +//! +//! Never `binding_table()`/`value_table()`/`type_table()` — this rule needs no +//! semantic pass and asks for none. Never `RuleContext::scratch_cache` either; +//! see [`crate::support`] for why that slot is not available to this package. +//! +//! [`is_top_level_form`]: crate::support::is_top_level_form + +use paredit_core_lint_engine::LintResult; + +use crate::eval_when_execute_only::domain::{examine_eval_when, is_eval_when}; +use paredit_core_cli::report::Finding; +use paredit_core_lint_engine::engine::{RuleContext, RuleSink}; +use paredit_core_lint_engine::model::{ + Fixability, HeadFilter, NormalizedHead, RuleCategory, RuleMeta, Severity, +}; +use paredit_core_lint_engine::rule::LintRule; +use paredit_core_syntax::sexpr::ExpressionView; + +pub const META: RuleMeta = RuleMeta::new( + "eval-when-execute-only", + // The file loads, compiles green, and means something other than it looks + // like it means. That is exactly `Suspicious`. + RuleCategory::Suspicious, + // Not a judgement call: the compiled file provably does not contain the + // definition, and SBCL reports the compilation as successful. + Severity::Error, + "a top-level eval-when naming :execute but neither top-level situation, wrapping a definition", + // Which situations were meant cannot be recovered from the source. + Fixability::ReportOnly, +); + +const HEADS: [NormalizedHead; 1] = [NormalizedHead::new("eval-when")]; + +#[derive(Debug)] +pub struct Rule; + +pub const RULE: Rule = Rule; + +impl LintRule for Rule { + fn head_filter(&self) -> HeadFilter { + HeadFilter::Heads(&HEADS) + } + + fn check( + &self, + context: &RuleContext<'_>, + view: &ExpressionView, + sink: &mut RuleSink<'_, '_>, + ) -> LintResult<()> { + // The head index is a pre-filter only, so the head is re-checked here. + if !is_eval_when(view) { + return Ok(()); + } + let Some(item) = examine_eval_when(context.tree(), view) else { + return Ok(()); + }; + sink.report(item.span, item.message()); + Ok(()) + } +} + +#[cfg(test)] +mod tests { + use super::*; + use crate::support::run_rule; + use paredit_core_lint_engine::rule::RuleEntry; + + /// A one-rule catalogue, so the engine's dispatch — the thing that decides + /// whether and how often `check` is called — is exercised for real. A wrong + /// `Heads` list compiles, passes every domain test, and is simply never + /// invoked by the CLI; only this catches that. + static ENTRIES: [RuleEntry; 1] = [RuleEntry::new(&META, &RULE)]; + + fn messages(source: &str) -> Vec { + run_rule(&ENTRIES, source) + } + + #[test] + fn the_declared_head_reaches_the_rule() { + assert_eq!( + messages("(eval-when (:execute) (defmacro m () 1))\n").len(), + 1 + ); + } + + /// The head index strips package qualifiers and folds case, and the rule's + /// own re-check must agree with it or the spelling is dispatched and then + /// silently dropped. + #[test] + fn every_eval_when_spelling_survives_dispatch_and_the_recheck() { + for head in [ + "eval-when", + "cl:eval-when", + "EVAL-WHEN", + "common-lisp:eval-when", + ] { + assert_eq!( + messages(&format!("({head} (:execute) (defmacro m () 1))\n")).len(), + 1, + "`{head}` did not reach a finding" + ); + } + } + + #[test] + fn a_correct_eval_when_produces_nothing_through_the_engine() { + assert!( + messages("(eval-when (:compile-toplevel :load-toplevel :execute) (defmacro m () 1))\n") + .is_empty() + ); + assert!(messages("(eval-when (:load-toplevel :execute) (defmacro m () 1))\n").is_empty()); + } + + #[test] + fn a_nested_eval_when_produces_nothing_through_the_engine() { + assert!(messages("(defun f () (eval-when (:execute) (defmacro m () 1)))\n").is_empty()); + } + + #[test] + fn a_file_with_no_eval_when_produces_nothing() { + assert!(messages("(defun f () 1)\n(defmacro m () 2)\n").is_empty()); + assert!(messages("").is_empty()); + } + + #[test] + fn each_offending_eval_when_is_reported_once() { + let found = messages( + "(eval-when (:execute) (defmacro a () 1))\n(eval-when (:execute) (defmacro b () 2))\n", + ); + assert_eq!(found.len(), 2); + } +} diff --git a/packages/feature/lint-compile-time/src/eval_when_execute_only/usecase.rs b/packages/feature/lint-compile-time/src/eval_when_execute_only/usecase.rs new file mode 100644 index 00000000..3370bd5a --- /dev/null +++ b/packages/feature/lint-compile-time/src/eval_when_execute_only/usecase.rs @@ -0,0 +1,29 @@ +//! Compile-file-invisible `eval-when` detection across explicit files. + +pub use crate::eval_when_execute_only::domain::{ + EvalWhenExecuteOnlyItem, build_eval_when_execute_only_report, +}; + +use paredit_core_cli::report::{FileFindings, ReportPolicy}; + +/// Evaluates this report's gate. +/// +/// Armed by a flag rather than always on: a file that is only ever `load`ed as +/// source — a script, a `--load` snippet — is not wrong to confine a definition +/// to `:execute`. +#[must_use] +pub fn evaluate_fail_on_violation_policy( + fail_on_violation: bool, + reports: &[FileFindings], +) -> ReportPolicy { + ReportPolicy::fail_on_any( + fail_on_violation.then_some("--fail-on-violation"), + reports, + |report| { + format!( + "{} has an eval-when whose body compile-file discards", + report.path.display() + ) + }, + ) +} diff --git a/packages/feature/lint-compile-time/src/lib.rs b/packages/feature/lint-compile-time/src/lib.rs new file mode 100644 index 00000000..18e37100 --- /dev/null +++ b/packages/feature/lint-compile-time/src/lib.rs @@ -0,0 +1,12 @@ +#![doc = include_str!("../README.md")] + +pub mod defconstant_non_eql_value; +pub mod eval_when_body_never_runs; +pub mod eval_when_execute_only; +pub mod support; + +#[cfg(test)] +mod corpus_tests; + +// The root's REGISTRY names each rule's META and RULE across this crate +// boundary (section 4.2), and each slice's cli owns its own subcommand. diff --git a/packages/feature/lint-compile-time/src/support.rs b/packages/feature/lint-compile-time/src/support.rs new file mode 100644 index 00000000..00f74164 --- /dev/null +++ b/packages/feature/lint-compile-time/src/support.rs @@ -0,0 +1,822 @@ +//! What the compile-time rules share: which parts of a file are *code*, which +//! forms are *top level* in the sense CLHS 3.2.3.1 means, and how to read an +//! `eval-when` situation list. +//! +//! # Evaluation context +//! +//! The quote machinery below ([`QuoteState`], [`for_each_evaluated_subview`]) +//! is a deliberate copy of `paredit-feature-lint-condition-system`'s +//! `support.rs`, not a new design and not a cross-package dependency — the same +//! copy `paredit-feature-lint-build-system` keeps, for the same reason. Two +//! independent counters are required because `'` and `` ` `` are not the same +//! thing: +//! +//! - a comma inside `'(…)` is a comma *character* in a literal list, so `hard` +//! never clears — a single `i32` depth counter gets `'(a ,X)` wrong; +//! - a comma inside `` `(…) `` escapes back to code, so `quasi` counts up and +//! down. +//! +//! That distinction is not incidental here, it is the whole of +//! [`crate::macro_helper_not_compile_time`]: a helper called from a macro's +//! quasiquote *template* runs at the expansion's run time and needs nothing at +//! compile time, while the same call one comma deeper runs at macroexpansion +//! time and does. Both were checked against SBCL 2.6.0 and behave exactly that +//! way — see that rule's module docs. +//! +//! # Top level, and why it is not "depth 0" +//! +//! CLHS 3.2.3.1 defines a *top level form* by a recursion, not by depth. The +//! body of a top-level `progn`, `locally`, `macrolet`, `symbol-macrolet` or +//! `eval-when` is itself processed as top level. Confirmed against SBCL 2.6.0: +//! `(progn (eval-when (:execute) (defmacro m …)))` behaves exactly as the same +//! `eval-when` written at depth 0 — the macro vanishes under `compile-file` and +//! survives under `load` — while wrapping it in `(let () …)` instead makes the +//! `eval-when` an ordinary nested form, where only `:execute` is ever +//! considered and naming it is correct rather than suspect. +//! +//! A previous batch in this repository shipped rules that got this wrong and +//! produced false positives on exactly the `locally`/`macrolet`/ +//! `symbol-macrolet` shapes, which is why [`is_top_level_form`] enumerates them +//! rather than testing a depth. +//! +//! # Cost +//! +//! Nothing here is called per visited node. The `clean/forms/*` benchmarks lint +//! files with zero findings, so the per-file cost of a rule that matches +//! nothing is exactly what they measure. Every rule in this package anchors on +//! [`HeadFilter::Heads`], answers a *node-local* question from the dispatched +//! node alone, and only then — if that question came back interesting — asks +//! anything that touches the tree. +//! +//! That ordering is load-bearing rather than tidy. [`is_top_level_form`] +//! materializes the enclosing top-level form, and a sibling package measured +//! 450843 ns/call against 28 ns/call purely from asking such a question before +//! the cheap one instead of after it. Each rule's `check` documents its own +//! ordering. +//! +//! Nor is anything here quadratic in the number of candidates. +//! [`is_top_level_form`] is called at most once per candidate, so it is allowed +//! to cost the *enclosing top-level form* and never the file: it binary-searches +//! the top level for the one root child containing the span and materializes +//! only that form. The search itself reads [`SyntaxTree::root_child_span`], +//! which is an index into a slice and a field read; +//! `select_path(&Path::root_child(i))` would heap-allocate an +//! `ExpressionPath`'s `Vec` on every step of the search instead of once at the +//! end. +//! +//! # `scratch_cache` is deliberately not used +//! +//! `RuleContext::scratch_cache` looks like the right home for +//! [`crate::macro_helper_not_compile_time`]'s per-file set of same-file +//! `defun` names. It is not usable: the slot holds **one type per file's +//! pass**, `paredit-feature-lint-repl-debug` already stores its evaluated-forms +//! walk there (`packages/feature/lint-repl-debug/src/support.rs:612`), and a +//! second caller with a different `T` *panics* rather than missing the cache. +//! `inspect lint` runs every rule on every file, so the two would meet on the +//! first Common Lisp file with both a `defmacro` and a REPL-debug candidate. +//! That rule therefore pays its own scan, under guards documented there. +//! +//! [`HeadFilter::Heads`]: paredit_core_lint_engine::model::HeadFilter::Heads + +use paredit_core_syntax::definition::definition_shape; +use paredit_core_syntax::dialect::Dialect; +use paredit_core_syntax::sexpr::reader::atom_symbol_text; +use paredit_core_syntax::sexpr::{ByteSpan, ExpressionView, Path, ReaderPrefix, SyntaxTree}; +use paredit_core_syntax::view_query::{is_paren_list, list_head, unqualified}; + +// --- evaluation context --------------------------------------------------- + +/// How much of the surrounding reader syntax says "this is data". +/// +/// Two independent counters, because `'` and `` ` `` are not the same thing. A +/// comma inside `'(…)` is a comma character in a literal list, so `hard` never +/// clears; a comma inside `` `(…) `` escapes back to code, so `quasi` counts up +/// and down. +#[derive(Debug, Clone, Copy, PartialEq, Eq)] +pub struct QuoteState { + hard: bool, + quasi: u32, +} + +impl QuoteState { + pub const EVALUATED: Self = Self { + hard: false, + quasi: 0, + }; + + #[must_use] + pub const fn is_data(self) -> bool { + self.hard || self.quasi > 0 + } + + /// The state inside a node, given the state outside it and the node's own + /// reader prefixes. + /// + /// `#'`, `#.`, `#+`, metadata and the rest are deliberately neutral: none of + /// them turns code into data. + #[must_use] + pub fn after_prefixes(mut self, view: &ExpressionView) -> Self { + for prefix in &view.reader_prefixes { + match prefix { + ReaderPrefix::Quote => self.hard = true, + ReaderPrefix::Quasiquote => self.quasi += 1, + ReaderPrefix::Unquote | ReaderPrefix::UnquoteSplicing => { + self.quasi = self.quasi.saturating_sub(1); + } + _ => {} + } + } + self + } + + #[must_use] + pub const fn quoted(mut self) -> Self { + self.hard = true; + self + } +} + +/// The long-hand `(quote …)`, which the reader also produces for `'…` but which +/// hand-written code and macro output both spell out. +fn is_quote_form(view: &ExpressionView) -> bool { + list_head(view).is_some_and(|head| normalized_symbol(head) == "quote") +} + +const fn span_contains(outer: ByteSpan, inner: ByteSpan) -> bool { + outer.start().get() <= inner.start().get() && inner.end().get() <= outer.end().get() +} + +/// Calls `visit` on every node of `root` that is reachable as evaluated code, +/// in the same pre-order the lint engine's own walk produces. +/// +/// Quoted subtrees are still *descended* — `` `(a ,(f)) `` has code inside data +/// — but their data nodes are never visited. +pub fn for_each_evaluated_subview(root: &ExpressionView, mut visit: impl FnMut(&ExpressionView)) { + let mut stack = vec![(root, QuoteState::EVALUATED)]; + while let Some((view, outer)) = stack.pop() { + let state = outer.after_prefixes(view); + if !state.is_data() { + visit(view); + } + let inside = if is_quote_form(view) { + state.quoted() + } else { + state + }; + for child in view.children.iter().rev() { + stack.push((child, inside)); + } + } +} + +// --- symbols -------------------------------------------------------------- + +/// An atom's symbol text, past any reader prefix, lowercased and stripped of +/// its package qualifier — the spelling every head comparison here is written +/// in. +/// +/// A keyword keeps its leading colon: `unqualified(":execute")` is +/// `":execute"`, which is what [`EvalWhenSituations`] compares against. +#[must_use] +pub fn normalized_symbol(text: &str) -> String { + unqualified(text).to_ascii_lowercase() +} + +/// The symbol an atom names, in the normalized spelling. +#[must_use] +pub fn symbol_name(view: &ExpressionView) -> Option { + atom_symbol_text(view) + .filter(|text| !text.is_empty()) + .map(normalized_symbol) +} + +/// Whether the file's bytes contain `needle` at all, ignoring ASCII case. +/// +/// A byte scan, not a tree walk: no allocation, no per-node work, and it reads +/// each byte once instead of visiting each node. Used only as a *negative* +/// guard — an answer of `true` may come from a string or a comment, in which +/// case the real analysis runs and finds nothing, exactly as it would have +/// without the guard. +#[must_use] +pub fn mentions(source: &str, needle: &str) -> bool { + let needle = needle.as_bytes(); + source.len() >= needle.len() + && source + .as_bytes() + .windows(needle.len()) + .any(|window| window.eq_ignore_ascii_case(needle)) +} + +/// Whether an atom's text carries a reader conditional. +/// +/// The dialect-aware parse folds `#+sbcl :compile-toplevel` into a **single +/// atom** whose text is `"#+sbcl :compile-toplevel"`, so an equality test on the +/// symbol never sees the keyword. Every reader of a situation list has to notice +/// that and bail rather than read the conditional as an unrecognized situation +/// — which would turn a conditionally-supplied `:compile-toplevel` into an +/// absent one, the single direction these rules must not get wrong. +#[must_use] +pub fn carries_reader_conditional(text: &str) -> bool { + let trimmed = text.trim_start(); + trimmed.starts_with("#+") || trimmed.starts_with("#-") +} + +// --- eval-when situations ------------------------------------------------- + +/// Which of the three situations an `eval-when` names. +/// +/// The deprecated spellings `compile`, `load` and `eval` are accepted alongside +/// `:compile-toplevel`, `:load-toplevel` and `:execute`. SBCL 2.6.0 emits a +/// style warning for them and then honours them exactly like the modern names +/// (verified: `(eval-when (compile load eval) (defmacro m …))` behaves +/// identically to the `:compile-toplevel :load-toplevel :execute` spelling under +/// both `load` and `compile-file`), so a rule that ignored them would miss real +/// findings in old code and — worse — report the modern-name rules' findings +/// against files that had in fact named the situation. +#[derive(Debug, Clone, Copy, PartialEq, Eq, Default)] +pub struct EvalWhenSituations { + pub compile_toplevel: bool, + pub load_toplevel: bool, + pub execute: bool, +} + +impl EvalWhenSituations { + /// Whether the body survives into the compiled file at all. + /// + /// A top-level `eval-when` naming neither `:compile-toplevel` nor + /// `:load-toplevel` is **discarded entirely** by `compile-file` — not merely + /// deferred. Verified against SBCL 2.6.0. + #[must_use] + pub const fn reaches_the_compiler(self) -> bool { + self.compile_toplevel || self.load_toplevel + } +} + +/// Reads an `eval-when`'s situation list, or `None` if it cannot be read +/// exactly. +/// +/// `None` for a situations form that is not a `(…)` list, that contains a +/// non-atom, that contains an atom carrying a reader conditional, or that names +/// a situation this reader does not recognize. Every caller treats `None` as +/// "say nothing", so an unreadable situation list is a missed finding rather +/// than a guessed one. +#[must_use] +pub fn read_situations(situations: &ExpressionView) -> Option { + if !is_paren_list(situations) { + return None; + } + let mut found = EvalWhenSituations::default(); + for element in &situations.children { + if !element.children.is_empty() { + return None; + } + let text = atom_symbol_text(element)?; + // No explicit reader-conditional bail here, deliberately. Mutation + // testing showed one to be **dead code**: `#+sbcl :compile-toplevel` + // folds into a single atom whose normalized spelling is + // `"#+sbcl :compile-toplevel"`, which matches no arm below and so + // already falls through to `_ => return None`. Removing the explicit + // guard changed no test's outcome, which is what "the guard kills + // nothing" means. The *property* stays pinned by + // `a_reader_conditional_in_the_situation_list_bails_rather_than_guessing` + // regardless of which arm delivers it. + match normalized_symbol(text).as_str() { + ":compile-toplevel" | "compile" => found.compile_toplevel = true, + ":load-toplevel" | "load" => found.load_toplevel = true, + ":execute" | "eval" => found.execute = true, + _ => return None, + } + } + Some(found) +} + +// --- top level, per CLHS 3.2.3.1 ------------------------------------------ + +/// The child index at which a top-level-preserving operator's *body* begins. +/// +/// CLHS 3.2.3.1 processes the body of each of these as top level forms in their +/// own right. The index matters as much as the head does: the situations list of +/// an `eval-when` and the bindings list of a `macrolet` are **not** body, and a +/// candidate found inside one of them is not a top-level form. +fn top_level_body_start(head: &str) -> Option { + match head { + // (progn form*) / (locally declaration* form*) + "progn" | "locally" => Some(1), + // (eval-when (situation*) form*) + // (macrolet (definition*) form*) / (symbol-macrolet (binding*) form*) + "eval-when" | "macrolet" | "symbol-macrolet" => Some(2), + _ => None, + } +} + +/// The index of the one child of `view` whose span covers `target`, found +/// without reading the others. +/// +/// A node's children are in document order and do not overlap, so the only child +/// that can contain `target` is the last one beginning at or before it — which a +/// binary search finds in `log₂ k` comparisons instead of `k`. +fn child_index_containing(view: &ExpressionView, target: ByteSpan) -> Option { + let after = view + .children + .partition_point(|child| child.span.start().get() <= target.start().get()); + let index = after.checked_sub(1)?; + span_contains(view.children.get(index)?.span, target).then_some(index) +} + +/// The top-level form containing `target`, materialized on its own. +/// +/// The binary search reads [`SyntaxTree::root_child_span`], which is an index +/// into a slice and a field read. The obvious spelling +/// `select_path(&Path::root_child(middle))?.span()` looks like the same thing +/// but [`Path::root_child`] builds an `ExpressionPath`, which owns a `Vec`, so +/// it heap-allocates once per step of the search. Only the single surviving +/// candidate is materialized. +fn root_child_containing(tree: &SyntaxTree, target: ByteSpan) -> Option { + let mut low = 0; + let mut high = tree.root_children().len(); + while low < high { + let middle = low + (high - low) / 2; + if tree.root_child_span(middle)?.start().get() <= target.start().get() { + low = middle + 1; + } else { + high = middle; + } + } + let index = low.checked_sub(1)?; + if !span_contains(tree.root_child_span(index)?, target) { + return None; + } + Some(tree.select_path(&Path::root_child(index)).ok()?.view()) +} + +/// Whether the node at `target` is a **top level form** in the sense CLHS +/// 3.2.3.1 means. +/// +/// True for a root child, and for a node reached from one through nothing but +/// the *body* positions of `progn`, `locally`, `macrolet`, `symbol-macrolet` and +/// `eval-when`. False for anything under a `let`, a `defun`, a lambda, the +/// situations list of an `eval-when`, or the bindings list of a `macrolet` — +/// and false for anything under a `'` or `` ` ``, which is data rather than a +/// form at all. +/// +/// Cost is the enclosing top-level form's size and never the file's; see the +/// module docs. Call it only after the node-local question has come back +/// interesting. +#[must_use] +pub fn is_top_level_form(tree: &SyntaxTree, target: ByteSpan) -> bool { + let Some(root_child) = root_child_containing(tree, target) else { + return false; + }; + let mut view = &root_child; + loop { + // A quoted or quasiquoted ancestor makes this data, not a form. Checked + // at every level, including the root child itself, because `'(progn …)` + // carries its prefix on the outermost node. + if QuoteState::EVALUATED.after_prefixes(view).is_data() { + return false; + } + if view.span == target { + return true; + } + let Some(head) = list_head(view) else { + return false; + }; + let Some(body_start) = top_level_body_start(&normalized_symbol(head)) else { + return false; + }; + let Some(index) = child_index_containing(view, target) else { + return false; + }; + if index < body_start { + // The head itself, an `eval-when`'s situations, or a `macrolet`'s + // bindings: inside the form but not one of its body forms. + return false; + } + view = &view.children[index]; + } +} + +// --- definitions ---------------------------------------------------------- + +/// Whether `view` is a definition form — anything the shared classifier +/// recognizes as introducing a name. +/// +/// Used to decide whether an `eval-when` body is *worth* complaining about. +/// `(eval-when (:execute) (format t "hi"))` is a judgement call about intent; +/// `(eval-when (:execute) (defmacro m …))` is a definition that silently does +/// not exist in the compiled file, which is not. +#[must_use] +pub fn is_definition_form(view: &ExpressionView) -> bool { + let Some(head) = list_head(view) else { + return false; + }; + definition_shape(Dialect::CommonLisp, view, head).is_some() +} + +/// Runs one rule end to end through the real lint engine and returns the +/// messages it emitted, in report order. +/// +/// Every rule here is also tested at the `domain` level, which is where the +/// detection lives — but a domain test cannot catch a wrong +/// [`HeadFilter::Heads`] list. A rule that declares the wrong head compiles, +/// passes every domain test, and is simply **never invoked** by the CLI. This +/// puts the engine's own head index between the test and the rule, so the head +/// list is exercised by the same dispatch the binary uses. +/// +/// [`HeadFilter::Heads`]: paredit_core_lint_engine::model::HeadFilter::Heads +#[cfg(test)] +#[must_use] +pub fn run_rule( + entries: &'static [paredit_core_lint_engine::rule::RuleEntry], + source: &str, +) -> Vec { + use paredit_core_lint_engine::engine::{build_head_index, collect_lint_outcomes}; + use paredit_core_lint_engine::policy::RuleSelection; + use paredit_core_lint_engine::rule::RuleCatalog; + + let catalog = RuleCatalog::new(entries); + let index = build_head_index(catalog); + let tree = SyntaxTree::parse_with_dialect(source, Dialect::CommonLisp).expect("parse"); + collect_lint_outcomes( + catalog, + &index, + std::path::Path::new("app.lisp"), + Dialect::CommonLisp, + &tree, + source, + RuleSelection::All, + ) + .expect("lint pass") + .into_iter() + .map(|outcome| outcome.into_parts().0.message) + .collect() +} + +#[cfg(test)] +mod tests { + use super::*; + use paredit_core_syntax::view_query::for_each_subview; + + fn tree(source: &str) -> SyntaxTree { + SyntaxTree::parse_with_dialect(source, Dialect::CommonLisp).expect("parse") + } + + fn evaluated_heads(source: &str) -> Vec { + let parsed = tree(source); + let mut heads = Vec::new(); + for_each_evaluated_subview(&parsed.root_view(), |view| { + if let Some(head) = list_head(view) { + heads.push(head.to_owned()); + } + }); + heads + } + + // --- the five quote shapes every rule in this package is pinned against + + #[test] + fn an_evaluated_walk_visits_plain_code() { + assert_eq!(evaluated_heads("(a (b) (c (d)))"), vec!["a", "b", "c", "d"]); + } + + #[test] + fn a_quoted_list_is_data_and_is_not_visited() { + assert!(evaluated_heads("'(eval-when (foo))").is_empty()); + } + + #[test] + fn a_long_hand_quote_form_is_data_below_its_head() { + assert_eq!(evaluated_heads("(quote (eval-when (foo)))"), vec!["quote"]); + } + + #[test] + fn a_comma_inside_a_hard_quote_stays_data() { + assert!(evaluated_heads("'(a ,(eval-when (foo)))").is_empty()); + } + + #[test] + fn a_backquote_without_an_unquote_is_data() { + assert!(evaluated_heads("`(eval-when (foo))").is_empty()); + } + + #[test] + fn an_unquote_inside_a_backquote_is_code_again() { + assert_eq!( + evaluated_heads("`(a ,(eval-when (foo)))"), + vec!["eval-when", "foo"] + ); + } + + #[test] + fn a_string_literal_is_one_atom_so_its_contents_are_never_forms() { + assert_eq!(evaluated_heads("(f \"(eval-when (foo))\")"), vec!["f"]); + } + + // --- situations + + fn situations(source: &str) -> Option { + let parsed = tree(source); + let form = &parsed.root_view().children[0]; + read_situations(&form.children[1]) + } + + #[test] + fn the_modern_situation_names_are_read() { + assert_eq!( + situations("(eval-when (:compile-toplevel :load-toplevel :execute) 1)"), + Some(EvalWhenSituations { + compile_toplevel: true, + load_toplevel: true, + execute: true, + }) + ); + } + + /// SBCL still honours these and merely style-warns, so the rules must read + /// them or they would report against a file that named the situation. + #[test] + fn the_deprecated_situation_names_are_read_too() { + assert_eq!( + situations("(eval-when (compile load eval) 1)"), + Some(EvalWhenSituations { + compile_toplevel: true, + load_toplevel: true, + execute: true, + }) + ); + } + + #[test] + fn an_empty_situation_list_names_nothing() { + assert_eq!( + situations("(eval-when () 1)"), + Some(EvalWhenSituations::default()) + ); + } + + #[test] + fn a_package_qualified_situation_is_still_read() { + assert_eq!( + situations("(eval-when (cl:compile) 1)").map(|s| s.compile_toplevel), + Some(true) + ); + } + + #[test] + fn an_upcased_situation_is_still_read() { + assert_eq!( + situations("(eval-when (:EXECUTE) 1)").map(|s| s.execute), + Some(true) + ); + } + + /// The reader folds the conditional into the keyword's atom, so an equality + /// test never sees `:compile-toplevel`. Reading it as an unrecognized + /// situation would turn a conditionally-supplied situation into an absent + /// one — a false positive. Bailing turns it into a missed finding. + #[test] + fn a_reader_conditional_in_the_situation_list_bails_rather_than_guessing() { + let parsed = tree("(eval-when (#+sbcl :compile-toplevel :execute) 1)"); + let form = &parsed.root_view().children[0]; + let list = &form.children[1]; + assert_eq!( + atom_symbol_text(&list.children[0]), + Some("#+sbcl :compile-toplevel"), + "the reader no longer folds the conditional into the keyword's atom" + ); + assert_eq!(read_situations(list), None); + } + + #[test] + fn an_unreadable_situation_list_says_nothing() { + assert_eq!(situations("(eval-when :execute 1)"), None); + assert_eq!(situations("(eval-when (:bogus) 1)"), None); + assert_eq!(situations("(eval-when ((:execute)) 1)"), None); + } + + #[test] + fn reaching_the_compiler_needs_one_of_the_two_toplevel_situations() { + let read = |source| situations(source).expect("readable"); + assert!(!read("(eval-when (:execute) 1)").reaches_the_compiler()); + assert!(!read("(eval-when () 1)").reaches_the_compiler()); + assert!(read("(eval-when (:load-toplevel) 1)").reaches_the_compiler()); + assert!(read("(eval-when (:compile-toplevel) 1)").reaches_the_compiler()); + } + + // --- top level, per CLHS 3.2.3.1 + + /// Finds the first node whose head is `head` and asks whether it is a top + /// level form. Uses the *unfiltered* walk, so the node is found even when it + /// is data. + fn top_level_at(source: &str, head: &str) -> bool { + let parsed = tree(source); + let mut span = None; + for_each_subview(&parsed.root_view(), |view| { + if span.is_none() && list_head(view).is_some_and(|found| found == head) { + span = Some(view.span); + } + }); + is_top_level_form(&parsed, span.expect("the head must occur in the source")) + } + + #[test] + fn a_root_child_is_a_top_level_form() { + assert!(top_level_at("(eval-when (:execute) 1)", "eval-when")); + } + + /// The four operators CLHS 3.2.3.1 recurses through, each verified against + /// SBCL 2.6.0 to behave exactly as the same form at depth 0. + #[test] + fn the_top_level_preserving_operators_keep_their_body_top_level() { + for source in [ + "(progn (eval-when (:execute) 1))", + "(locally (eval-when (:execute) 1))", + "(macrolet () (eval-when (:execute) 1))", + "(symbol-macrolet () (eval-when (:execute) 1))", + "(eval-when (:execute) (eval-when (:execute) 1))", + "(progn (progn (locally (eval-when (:execute) 1))))", + ] { + assert!(top_level_at(source, "eval-when"), "not top level: {source}"); + } + } + + #[test] + fn an_ordinary_binding_form_does_not_keep_its_body_top_level() { + for source in [ + "(let () (eval-when (:execute) 1))", + "(defun f () (eval-when (:execute) 1))", + "(lambda () (eval-when (:execute) 1))", + "(when t (eval-when (:execute) 1))", + "(flet ((g () 1)) (eval-when (:execute) 1))", + ] { + assert!( + !top_level_at(source, "eval-when"), + "wrongly top level: {source}" + ); + } + } + + /// The body-start index, not just the head, is what makes these false. A + /// candidate inside a `macrolet`'s bindings or an `eval-when`'s situations + /// is inside the form but is not one of its body forms. + #[test] + fn a_non_body_position_of_a_top_level_operator_is_not_top_level() { + assert!(!top_level_at( + "(macrolet ((m () (eval-when (:execute) 1))) 2)", + "eval-when" + )); + assert!(!top_level_at( + "(symbol-macrolet ((x (eval-when (:execute) 1))) 2)", + "eval-when" + )); + } + + /// The `index < body_start` test, isolated. + /// + /// The two cases above do not actually reach it: a `macrolet`'s bindings + /// list has a *list* as its own head, so the descent stops at the + /// `list_head` test one level further in and the body-start test is never + /// consulted. Mutation testing caught that — deleting `index < body_start` + /// left every test green. + /// + /// This is the shape that does reach it. The situations list of the outer + /// `eval-when` is child 1, below its body start of 2, and it happens to be + /// a list whose head *is* one of the top-level-preserving operators — so + /// without the position test the descent would walk straight through the + /// situations list and call the inner `eval-when` a top level form. + #[test] + fn a_top_level_operator_nested_in_a_situations_list_is_still_not_top_level() { + let source = "(eval-when (progn (eval-when (:execute) (defmacro m () 1))) 2)"; + let parsed = tree(source); + let mut spans = Vec::new(); + for_each_subview(&parsed.root_view(), |view| { + if list_head(view).is_some_and(|found| found == "eval-when") { + spans.push(view.span); + } + }); + assert_eq!(spans.len(), 2, "expected an outer and an inner eval-when"); + // The outer one is a root child and is top level. + assert!(is_top_level_form(&parsed, spans[0])); + // The inner one sits in the outer's *situations* list, which is child 1 + // and below the body start of 2. + assert!( + !is_top_level_form(&parsed, spans[1]), + "the body-start position test is not being applied" + ); + } + + #[test] + fn a_quoted_form_is_data_and_never_top_level() { + for source in [ + "'(eval-when (:execute) 1)", + "`(eval-when (:execute) 1)", + "(quote (eval-when (:execute) 1))", + "'(progn (eval-when (:execute) 1))", + "(progn '(eval-when (:execute) 1))", + ] { + assert!( + !top_level_at(source, "eval-when"), + "quoted data read as a top level form: {source}" + ); + } + } + + /// The binary search over the top level must select the same root child a + /// linear scan would, including for the last form and for a file of one. + #[test] + fn the_root_child_search_answers_what_a_linear_scan_would() { + for source in [ + "(a) (b) (c)", + "(only)", + "(a)\n\n(eval-when (:execute) 1)\n\n(c)", + "'(a) `(b ,(c)) #'d", + "(defsystem \"x\" #+sbcl :serial t)", + ] { + let parsed = tree(source); + let root = parsed.root_view(); + for (index, child) in root.children.iter().enumerate() { + let found = root_child_containing(&parsed, child.span).expect("a containing child"); + assert_eq!( + found.span, child.span, + "{source}: wrong root child for index {index}" + ); + } + } + } + + /// The cost regression this descent exists to avoid. `is_top_level_form` is + /// called once per candidate, and starting it from `tree.root_view()` would + /// make a file of T candidates cost T×T. The budget is deliberately hundreds + /// of times the linear cost, so only an asymptotic regression can trip it. + #[test] + fn resolving_a_span_does_not_scan_the_top_level() { + let source: String = (0..4000) + .map(|index| format!("(eval-when (:execute) (defun f{index} () 1))\n")) + .collect(); + let parsed = tree(&source); + let spans: Vec = parsed + .root_view() + .children + .iter() + .map(|child| child.span) + .collect(); + assert_eq!(spans.len(), 4000); + let started = std::time::Instant::now(); + for span in spans { + assert!(is_top_level_form(&parsed, span)); + } + let elapsed = started.elapsed(); + assert!( + elapsed < std::time::Duration::from_secs(10), + "4000 lookups took {elapsed:?}; the descent is scanning the top level again" + ); + } + + // --- definitions and the byte-scan guard + + #[test] + fn definition_forms_are_recognized() { + for source in [ + "(defun f () 1)", + "(defmacro m () 1)", + "(defconstant +c+ 1)", + "(defvar *v* 1)", + "(defclass c () ())", + "(define-condition e (error) ())", + ] { + let parsed = tree(source); + assert!( + is_definition_form(&parsed.root_view().children[0]), + "not recognized as a definition: {source}" + ); + } + } + + #[test] + fn a_call_is_not_a_definition_form() { + for source in ["(format t \"hi\")", "(setf *x* 1)", "(1+ 2)"] { + let parsed = tree(source); + assert!( + !is_definition_form(&parsed.root_view().children[0]), + "wrongly a definition: {source}" + ); + } + } + + #[test] + fn the_mention_guard_answers_yes_only_for_the_spelling() { + assert!(mentions("(eval-when (:execute) 1)", "eval-when")); + assert!(mentions("(EVAL-WHEN (:EXECUTE) 1)", "eval-when")); + assert!(!mentions("(progn 1)", "eval-when")); + assert!(!mentions("", "eval-when")); + assert!(!mentions("eval-whe", "eval-when")); + } + + #[test] + fn the_reader_conditional_guard_sees_both_polarities() { + assert!(carries_reader_conditional("#+sbcl :execute")); + assert!(carries_reader_conditional("#-sbcl :execute")); + assert!(!carries_reader_conditional(":execute")); + assert!(!carries_reader_conditional("#'f")); + } +} diff --git a/src/lint/registry/catalog.rs b/src/lint/registry/catalog.rs index 8172350d..61542805 100644 --- a/src/lint/registry/catalog.rs +++ b/src/lint/registry/catalog.rs @@ -207,7 +207,12 @@ pub const PEDANTIC_RULES: [&str; tagged_count(RuleTag::Pedantic)] = { // `INTROSPECTION_COMMANDS` stays where it was. `lint-type-declaration` // proposed six and ships five: `ignore-declared-variable-then-used` was dropped // as a true duplicate of `lint-convention`'s `ignore-declaration-conflict`. -const _: () = assert!(RULE_COUNT == 313); +// +// 313 + this batch's 3: 3 (`lint-compile-time`), one new package, Common Lisp +// only. It ships a `cli/` directory per rule, so all three add a standalone +// command and `INTROSPECTION_COMMANDS` moves with this number (337 -> 340), as +// it did two batches ago and did not one batch ago. +const _: () = assert!(RULE_COUNT == 316); // Unchanged at 99: every one of this branch's 37 rules is // `Fixability::ReportOnly`. Each one reports a judgment the tool cannot make // on the author's behalf — whether an annotation or the parameter list under it @@ -250,6 +255,15 @@ const _: () = assert!(RULE_COUNT == 313); // the initform is wrong, or whether a late `declare` wanted hoisting or wanted // to be a `the`, is the author's call and neither repair is right more often // than the other. +// +// Still 103 after this batch's 3, all three `Fixability::ReportOnly` and all +// three for the same reason: the offending form says nothing about what was +// meant. A `(eval-when (:execute) …)` at top level may have wanted +// `:load-toplevel`, or may have wanted to be hoisted out of a macro that put it +// there; a nested `eval-when` the standard ignores may have wanted `:execute` +// or may want deleting outright; and a `defconstant` whose initform allocates +// may want `defparameter`, `alexandria:define-constant` with a `:test`, or a +// genuinely `eql`-able value. Rewriting any of them is guessing. const _: () = assert!(fixable_count() == 103); // 164 (through PR #82) + 31 of this branch's 37 rules. The other 6 are // `Severity::Error`: `when-unless-implicit-nil-misused` and the five @@ -298,6 +312,16 @@ const _: () = assert!(fixable_count() == 103); // 2.6.0 reports as a full `caught ERROR`). `var-never-set` carries // `RuleTag::Style`, which is not `Pedantic` and so does not hold it back from // any preset; it counts as a warning here like the other 6. +// +// This batch's 3 leave it at 232: all three are `Severity::Error`, and each was +// run through SBCL 2.6.0 under both `load` of the source and `compile-file` +// plus `load` of the fasl before being given that severity. The two phases +// disagree, or the form is dead in both: `(eval-when (:execute) (defmacro m …))` +// loads fine from source and gives an *undefined function* at run time from a +// fasl; a non-top-level `eval-when` without `:execute` never runs in either +// phase and SBCL says nothing at all; and `(defconstant +x+ #("a" "b"))` +// signals `DEFCONSTANT-UNEQL` on the compile-then-load path. None of the three +// is a preference. const _: () = assert!(warning_count() == 232); const _: () = assert!(EXPERIMENTAL_RULES.is_empty()); // 6 (through PR #82) + 8 of this branch's rules: `lint-call-shape`'s four @@ -321,6 +345,8 @@ const _: () = assert!(EXPERIMENTAL_RULES.is_empty()); // layout or naming rather than behaviour, and which no preset filters on. Only // `Pedantic` and `Experimental` gate admission, so `PEDANTIC_RULES` and // `EXPERIMENTAL_RULES` are both unchanged. +// This batch's 3 leave it at 15 as well: none of them carries a tag at all, so +// `PEDANTIC_RULES` and `EXPERIMENTAL_RULES` are both unchanged by it. const _: () = assert!(PEDANTIC_RULES.len() == 15); fn meta_of(name: &str) -> Option<&'static crate::lint::model::RuleMeta> { diff --git a/src/lint/registry/mod.rs b/src/lint/registry/mod.rs index 2b5a1090..12b49750 100644 --- a/src/lint/registry/mod.rs +++ b/src/lint/registry/mod.rs @@ -76,7 +76,35 @@ use super::rule::RuleEntry; // positives, with the fixed guards sitting in this package's `support.rs` // ready to lift across. That is a pre-existing defect and deliberately not // repaired here. -pub const RULE_COUNT: usize = 313; +// +// 313 + this batch's 3, one new package: 3 (`lint-compile-time`) = 316. Unlike +// the two registry-only packages above it ships a `cli/` directory per rule, so +// all three come with a standalone `inspect ` command and +// `INTROSPECTION_COMMANDS` moves 337 -> 340. All three are Common Lisp only on +// `dialect_scope()`'s default, all three are `Severity::Error`, and all three +// are `Fixability::ReportOnly` — so of the four pinned counts in [`catalog`] +// only `RULE_COUNT` moves; `fixable_count()`, `warning_count()` and +// `PEDANTIC_RULES.len()` are unchanged at 103, 232 and 15. +// +// The subject is the compile-file/load gap — the "works in the REPL, breaks +// from a fasl" class. `eval-when-execute-only` catches a *top-level* +// `eval-when` naming `:execute` but neither top-level situation, whose body +// `compile-file` discards outright; `eval-when-body-never-runs` catches the +// mirror image, a *non*-top-level `eval-when` without `:execute`, whose body +// runs in no phase at all; `defconstant-non-eql-value` catches a `defconstant` +// whose initform allocates, so the compile-time and load-time values are not +// `eql` and a fresh image signals `DEFCONSTANT-UNEQL`. +// +// The two `eval-when` rules share the head `eval-when` with `lint-control-flow`'s +// already-registered `eval-when-situation`, which is the first time three rules +// in this registry key on one head. They are disjoint by construction and it +// was checked through the engine, not just by reading: `eval-when-situation` +// fires only on a *misspelled* situation (`:executee`, category `Malformed`), +// while these two fire only on situation lists that are entirely well spelled. +// The second rule was renamed from `eval-when-situation-ignored` during +// implementation for exactly this reason — two same-head rules one character +// class apart is a maintenance trap even when they never overlap. +pub const RULE_COUNT: usize = 316; /// Every rule, in report order: findings are grouped by this order, and the /// public `RULES`/`RULE_DOCS` arrays preserve it. @@ -1347,4 +1375,16 @@ pub const REGISTRY: [RuleEntry; RULE_COUNT] = [ &paredit_feature_lint_type_declaration::type_declaration_on_rest_parameter::rule::META, &paredit_feature_lint_type_declaration::type_declaration_on_rest_parameter::rule::RULE, ), + RuleEntry::new( + &paredit_feature_lint_compile_time::eval_when_execute_only::rule::META, + &paredit_feature_lint_compile_time::eval_when_execute_only::rule::RULE, + ), + RuleEntry::new( + &paredit_feature_lint_compile_time::eval_when_body_never_runs::rule::META, + &paredit_feature_lint_compile_time::eval_when_body_never_runs::rule::RULE, + ), + RuleEntry::new( + &paredit_feature_lint_compile_time::defconstant_non_eql_value::rule::META, + &paredit_feature_lint_compile_time::defconstant_non_eql_value::rule::RULE, + ), ]; diff --git a/src/presentation/cli.rs b/src/presentation/cli.rs index cd5b00ee..2c502a74 100644 --- a/src/presentation/cli.rs +++ b/src/presentation/cli.rs @@ -641,6 +641,9 @@ use paredit_feature_lint_clojure_idiom::apply_with_literal_collection::cli as ap use paredit_feature_lint_clojure_idiom::def_inside_function_body::cli as def_inside_function_body_report; use paredit_feature_lint_clojure_idiom::single_key_nested_path::cli as single_key_nested_path_report; use paredit_feature_lint_clojure_idiom::with_open_returns_lazy_seq::cli as with_open_returns_lazy_seq_report; +use paredit_feature_lint_compile_time::defconstant_non_eql_value::cli as defconstant_non_eql_value_report; +use paredit_feature_lint_compile_time::eval_when_body_never_runs::cli as eval_when_body_never_runs_report; +use paredit_feature_lint_compile_time::eval_when_execute_only::cli as eval_when_execute_only_report; use paredit_feature_lint_concurrency::atom_swap_with_side_effect::cli as atom_swap_with_side_effect_report; use paredit_feature_lint_concurrency::dynamic_var_bound_across_thread_boundary::cli as dynamic_var_bound_across_thread_boundary_report; use paredit_feature_lint_concurrency::future_promise_never_realized::cli as future_promise_never_realized_report; diff --git a/src/presentation/cli/command.rs b/src/presentation/cli/command.rs index 1ef32668..192a6d6a 100644 --- a/src/presentation/cli/command.rs +++ b/src/presentation/cli/command.rs @@ -26,7 +26,7 @@ use super::{ de_morgan_report, dead_boolean_operand_report, debt_score_report, deeply_nested_anonymous_lambda_report, def_inside_function_body_report, defclass_required_slot_no_initform_or_initarg_report, defclass_slot_shadowing_report, - define_condition_empty_superclass_list_report, + defconstant_non_eql_value_report, define_condition_empty_superclass_list_report, define_condition_missing_report_for_error_type_report, definition_movement, definition_removal, definition_report, defpackage_quoted_report, defpackage_without_in_package_report, dependency_report, destructive_literal_report, destructuring_bind_unused_whole_report, @@ -41,11 +41,12 @@ use super::{ eliminate_empty_binding_form, emacs_lisp_file_report, empty_body_report, empty_let_report, empty_test_body_report, epsilon_less_float_loop_bound_report, eq_char_comparison_report, eq_number_comparison_report, eql_list_comparison_report, eql_search_literal_report, - eql_string_comparison_report, equality_arity_report, eval_when_situation_report, - exhaustive_case_otherwise_report, explicit_nil_return_report, explicit_step_delta_report, - external_diagnostics_report, external_system_report, extract_constant, extract_function, - extract_local_function, flatten_progn, flet_single_use_inlinable_report, fold_constants, - form_report, format_directive_report, format_missing_destination_report, + eql_string_comparison_report, equality_arity_report, eval_when_body_never_runs_report, + eval_when_execute_only_report, eval_when_situation_report, exhaustive_case_otherwise_report, + explicit_nil_return_report, explicit_step_delta_report, external_diagnostics_report, + external_system_report, extract_constant, extract_function, extract_local_function, + flatten_progn, flet_single_use_inlinable_report, fold_constants, form_report, + format_directive_report, format_missing_destination_report, format_nested_directive_unbalanced_report, format_newline_report, format_percent_ampersand_adjacent_redundancy_report, format_to_string_report, format_unknown_directive_report, ftype_values_arity_mismatch_report, funcall_lambda_report, @@ -825,6 +826,12 @@ pub(super) enum InspectCommand { SchemeMemqAssqLiteralKey(scheme_memq_assq_literal_key_report::args::MemqAssqLiteralKeyReportArgs), /// Report a Scheme named let whose loop name is never mentioned in its body, so it can never iterate. SchemeNamedLetNeverRecurs(scheme_named_let_never_recurs_report::args::NamedLetNeverRecursReportArgs), + /// Report a top-level eval-when naming :execute but neither top-level situation, whose body compile-file discards. + EvalWhenExecuteOnly(eval_when_execute_only_report::args::EvalWhenExecuteOnlyReportArgs), + /// Report a non-top-level eval-when naming only situations the standard ignores there, so its body never runs. + EvalWhenBodyNeverRuns(eval_when_body_never_runs_report::args::EvalWhenBodyNeverRunsReportArgs), + /// Report a defconstant whose initform allocates, so the compile-time and load-time values are not eql. + DefconstantNonEqlValue(defconstant_non_eql_value_report::args::DefconstantNonEqlValueReportArgs), } /// Single-document structural editing commands. These print rewritten source diff --git a/src/presentation/cli/contract.rs b/src/presentation/cli/contract.rs index d73bc4a3..129a7c85 100644 --- a/src/presentation/cli/contract.rs +++ b/src/presentation/cli/contract.rs @@ -267,7 +267,7 @@ impl SupportStatus { /// here, the stack floor is the first thing to check — and note that an /// inherited `RUST_MIN_STACK` from the environment silently overrides /// `.cargo/config.toml`, because cargo's `[env]` is unforced. -const INTROSPECTION_COMMANDS: [&str; 337] = [ +const INTROSPECTION_COMMANDS: [&str; 340] = [ "inspect diff", "inspect check", "inspect dialect", @@ -622,6 +622,9 @@ const INTROSPECTION_COMMANDS: [&str; 337] = [ "inspect scheme-let-star-independent-bindings", "inspect scheme-memq-assq-literal-key", "inspect scheme-named-let-never-recurs", + "inspect eval-when-execute-only", + "inspect eval-when-body-never-runs", + "inspect defconstant-non-eql-value", ]; const FORMAT_COMMANDS: [&str; 3] = [ diff --git a/src/presentation/cli/dispatch.rs b/src/presentation/cli/dispatch.rs index eef78896..26913253 100644 --- a/src/presentation/cli/dispatch.rs +++ b/src/presentation/cli/dispatch.rs @@ -1011,6 +1011,15 @@ pub(super) fn dispatch(command: Command) -> CommandResult { args, )?; } + command::InspectCommand::EvalWhenExecuteOnly(args) => { + eval_when_execute_only_report::workflow::eval_when_execute_only_report(args)?; + } + command::InspectCommand::EvalWhenBodyNeverRuns(args) => { + eval_when_body_never_runs_report::workflow::eval_when_body_never_runs_report(args)?; + } + command::InspectCommand::DefconstantNonEqlValue(args) => { + defconstant_non_eql_value_report::workflow::defconstant_non_eql_value_report(args)?; + } }, Command::Edit { command } => match command { command::EditCommand::Format(args) => basic_edit::workflow::format(args)?, diff --git a/tests/cli/capabilities_contract.rs b/tests/cli/capabilities_contract.rs index 8093edd5..7b937577 100644 --- a/tests/cli/capabilities_contract.rs +++ b/tests/cli/capabilities_contract.rs @@ -245,7 +245,7 @@ fn leaf_commands_by_path( out } -/// FR-011: every command the dialect contract counts (the 460 commands +/// FR-011: every command the dialect contract counts (the 463 commands /// across `inspect`/`edit`/`refactor`/`query`/`fix`/`migrate`) carries a /// `writes` flag and a non-empty `possible_error_codes` set. A missing or /// empty set would mean a command nobody classified — the exact drift this @@ -263,7 +263,7 @@ fn every_dialect_contract_command_has_a_writes_flag_and_a_non_empty_error_code_s .collect(); assert_eq!( dialect_paths.len(), - 460, + 463, "the dialect contract's own command inventory changed size; update this test's \ expectation alongside it" ); diff --git a/tests/cli/determinism_contract.rs b/tests/cli/determinism_contract.rs index aa8a31f2..44997fa1 100644 --- a/tests/cli/determinism_contract.rs +++ b/tests/cli/determinism_contract.rs @@ -97,7 +97,7 @@ fn every_sampled_report_is_byte_identical_across_processes() { } /// Ten runs rather than two for the report most likely to wobble: `lint` runs -/// 303 rules and groups their findings, which is the most collection-order +/// 316 rules and groups their findings, which is the most collection-order /// surface in the tool. #[test] fn lint_is_stable_over_repeated_runs() { diff --git a/tests/cli/dialect_contract.rs b/tests/cli/dialect_contract.rs index e6a4b068..a4ed5809 100644 --- a/tests/cli/dialect_contract.rs +++ b/tests/cli/dialect_contract.rs @@ -88,7 +88,7 @@ fn schema_v2_registry_is_an_exact_bijection_with_clap_leaves() { let unique_registry_paths = registry_paths.iter().copied().collect::>(); assert_eq!(registry_paths.len(), unique_registry_paths.len()); - assert_eq!(registry_paths.len(), 460); + assert_eq!(registry_paths.len(), 463); assert_eq!( clap_contract_leaf_paths(&v1), unique_registry_paths @@ -142,9 +142,9 @@ fn schema_v2_keeps_its_three_value_vocabulary() { assert_eq!(report["schema_version"], 2); let contract = &report["dialect_contract"]; - assert_eq!(contract["command_count"], 460); + assert_eq!(contract["command_count"], 463); assert_eq!(contract["dialect_count"], 10); - assert_eq!(contract["cell_count"], 4600); + assert_eq!(contract["cell_count"], 4630); assert_eq!(contract["dialects"], serde_json::json!(DIALECTS)); assert_eq!( contract["statuses"], @@ -165,14 +165,14 @@ fn schema_v2_keeps_its_three_value_vocabulary() { category_counts, BTreeMap::from([ ("format", 3), - ("introspection", 337), + ("introspection", 340), ("semantic", 87), ("structural", 33), ]) ); let cells = support_cells(contract); - assert_eq!(cells.len(), 4600); + assert_eq!(cells.len(), 4630); let vocabulary = cells.values().map(String::as_str).collect::>(); assert!( vocabulary.is_subset(&BTreeSet::from(["supported", "unsupported"])), @@ -186,7 +186,7 @@ fn schema_v3_answers_every_cell_and_names_the_tier_it_used() { assert_eq!(report["schema_version"], 3); let contract = &report["dialect_contract"]; - assert_eq!(contract["cell_count"], 4600); + assert_eq!(contract["cell_count"], 4630); assert_eq!( contract["statuses"], serde_json::json!(["supported", "silent", "unsupported", "unknown"]) @@ -215,7 +215,7 @@ fn schema_v3_answers_every_cell_and_names_the_tier_it_used() { // The whole point of the matrix: no cell may answer "unknown". let cells = support_cells(contract); - assert_eq!(cells.len(), 4600); + assert_eq!(cells.len(), 4630); let unanswered = cells .iter() .filter(|(_, status)| *status == "unknown") @@ -306,7 +306,7 @@ fn schema_v3_summarises_how_deep_each_dialect_goes() { .values() .map(|count| count.as_u64().expect("count")) .sum(); - assert_eq!(total, 460, "{dialect} counts do not cover every command"); + assert_eq!(total, 463, "{dialect} counts do not cover every command"); // The summary has to agree with the matrix it summarises. for (status, count) in by_status { diff --git a/tests/cli/lint_report.rs b/tests/cli/lint_report.rs index 3be9ed7a..910ceaca 100644 --- a/tests/cli/lint_report.rs +++ b/tests/cli/lint_report.rs @@ -298,8 +298,10 @@ fn cli_lint_list_rules_prints_the_catalog_without_files() { // back. + all 10 of this branch's = 298, the whole suite's 313 less // the same 15. Nine of the 10 are untagged and the tenth carries // `RuleTag::Style`, which no preset filters on, so the rise here is - // again the full count. - .stdout(predicate::str::contains("\"rule_count\": 298")) + // again the full count. + all 3 of this branch's = 301, the whole + // suite's 316 less the same 15: all three are untagged, so once more + // the rise is the full count. + .stdout(predicate::str::contains("\"rule_count\": 301")) .stdout(predicate::str::contains("\"self-assignment\"")) .stdout(predicate::str::contains( "a setq/setf/psetq/psetf that assigns a place to itself", @@ -979,7 +981,9 @@ fn cli_lint_list_rules_marks_severity() { // `fennel-each-over-non-iterator`, `janet-mutating-immutable-literal` and // `declare-not-at-head-of-body`, all `Severity::Error`, and none of the 10 // `pedantic` — = 217, which is the suite's 232 warnings less the 15 - // `pedantic` rules, all of them warnings. + // `pedantic` rules, all of them warnings. + 0 of this branch's 3: all + // three `lint-compile-time` rules are `Severity::Error`, so this stays at + // 217 and the suite total stays at 232. assert_eq!(warnings, 217); } @@ -1004,7 +1008,9 @@ fn cli_lint_list_rules_marks_fixability() { // since — and it is also the only place the *preset-filtered* fixable // count is pinned, so a fixable rule that arrived tagged `pedantic` would // show up here and nowhere else. Unmoved by this branch's 10: every one of - // them is `ReportOnly`. + // them is `ReportOnly`. Unmoved by this branch's 3 for the same reason — + // all three `lint-compile-time` rules are `ReportOnly`, so the suite total + // and the preset-filtered total both stay at 103. assert_eq!( fixable_count, 103, "the fixable rules the default preset admits" diff --git a/tests/fixtures/lint_golden/expected/broad.json.golden b/tests/fixtures/lint_golden/expected/broad.json.golden index 12d497eb..4e6027f3 100644 --- a/tests/fixtures/lint_golden/expected/broad.json.golden +++ b/tests/fixtures/lint_golden/expected/broad.json.golden @@ -3624,6 +3624,24 @@ "count": 0, "description": "a &rest parameter declared to be its element type, though it is always bound to a list", "rule": "type-declaration-on-rest-parameter" + }, + { + "category": "suspicious", + "count": 0, + "description": "a top-level eval-when naming :execute but neither top-level situation, wrapping a definition", + "rule": "eval-when-execute-only" + }, + { + "category": "dead-code", + "count": 0, + "description": "a non-top-level eval-when naming only situations the standard ignores there, so its body never runs", + "rule": "eval-when-body-never-runs" + }, + { + "category": "suspicious", + "count": 0, + "description": "a defconstant whose initform allocates, so the compile-time and load-time values are not eql", + "rule": "defconstant-non-eql-value" } ], "policy": { diff --git a/tests/fixtures/lint_golden/expected/broad.sarif.golden b/tests/fixtures/lint_golden/expected/broad.sarif.golden index 8a92b990..f724a3e3 100644 --- a/tests/fixtures/lint_golden/expected/broad.sarif.golden +++ b/tests/fixtures/lint_golden/expected/broad.sarif.golden @@ -10020,6 +10020,42 @@ "shortDescription": { "text": "a &rest parameter declared to be its element type, though it is always bound to a list" } + }, + { + "id": "eval-when-execute-only", + "properties": { + "category": "suspicious", + "fixable": false, + "severity": "error", + "tags": [] + }, + "shortDescription": { + "text": "a top-level eval-when naming :execute but neither top-level situation, wrapping a definition" + } + }, + { + "id": "eval-when-body-never-runs", + "properties": { + "category": "dead-code", + "fixable": false, + "severity": "error", + "tags": [] + }, + "shortDescription": { + "text": "a non-top-level eval-when naming only situations the standard ignores there, so its body never runs" + } + }, + { + "id": "defconstant-non-eql-value", + "properties": { + "category": "suspicious", + "fixable": false, + "severity": "error", + "tags": [] + }, + "shortDescription": { + "text": "a defconstant whose initform allocates, so the compile-time and load-time values are not eql" + } } ] } diff --git a/tests/fixtures/lint_golden/expected/broad.text.golden b/tests/fixtures/lint_golden/expected/broad.text.golden index 043d1158..fca22ed4 100644 --- a/tests/fixtures/lint_golden/expected/broad.text.golden +++ b/tests/fixtures/lint_golden/expected/broad.text.golden @@ -297,6 +297,9 @@ rule declaim-inside-body 0 rule type-declaration-contradicts-initform 0 rule the-form-with-impossible-type 0 rule type-declaration-on-rest-parameter 0 +rule eval-when-execute-only 0 +rule eval-when-body-never-runs 0 +rule defconstant-non-eql-value 0 finding self-assignment error suspicious fixable=false broad.lisp 6875 setq assigns place x to itself self-assignment/5f1a5b802aa99b47/0 finding duplicate-setf-places error duplicate fixable=false broad.lisp 6961 setf assigns variable total more than once; the earlier assignment is dead duplicate-setf-places/8104810ed815b9fd/0 finding setf-arity error arity fixable=false broad.lisp 7021 setf has 3 arguments; place/value pairs require an even count setf-arity/b0a5b422aad6d4d2/0 diff --git a/tests/fixtures/lint_golden/expected/emacs-lisp.json.golden b/tests/fixtures/lint_golden/expected/emacs-lisp.json.golden index ac856be1..d08273fc 100644 --- a/tests/fixtures/lint_golden/expected/emacs-lisp.json.golden +++ b/tests/fixtures/lint_golden/expected/emacs-lisp.json.golden @@ -1934,6 +1934,24 @@ "count": 0, "description": "a &rest parameter declared to be its element type, though it is always bound to a list", "rule": "type-declaration-on-rest-parameter" + }, + { + "category": "suspicious", + "count": 0, + "description": "a top-level eval-when naming :execute but neither top-level situation, wrapping a definition", + "rule": "eval-when-execute-only" + }, + { + "category": "dead-code", + "count": 0, + "description": "a non-top-level eval-when naming only situations the standard ignores there, so its body never runs", + "rule": "eval-when-body-never-runs" + }, + { + "category": "suspicious", + "count": 0, + "description": "a defconstant whose initform allocates, so the compile-time and load-time values are not eql", + "rule": "defconstant-non-eql-value" } ], "policy": { diff --git a/tests/fixtures/lint_golden/expected/emacs-lisp.sarif.golden b/tests/fixtures/lint_golden/expected/emacs-lisp.sarif.golden index 90d0da8e..f73456b2 100644 --- a/tests/fixtures/lint_golden/expected/emacs-lisp.sarif.golden +++ b/tests/fixtures/lint_golden/expected/emacs-lisp.sarif.golden @@ -4447,6 +4447,42 @@ "shortDescription": { "text": "a &rest parameter declared to be its element type, though it is always bound to a list" } + }, + { + "id": "eval-when-execute-only", + "properties": { + "category": "suspicious", + "fixable": false, + "severity": "error", + "tags": [] + }, + "shortDescription": { + "text": "a top-level eval-when naming :execute but neither top-level situation, wrapping a definition" + } + }, + { + "id": "eval-when-body-never-runs", + "properties": { + "category": "dead-code", + "fixable": false, + "severity": "error", + "tags": [] + }, + "shortDescription": { + "text": "a non-top-level eval-when naming only situations the standard ignores there, so its body never runs" + } + }, + { + "id": "defconstant-non-eql-value", + "properties": { + "category": "suspicious", + "fixable": false, + "severity": "error", + "tags": [] + }, + "shortDescription": { + "text": "a defconstant whose initform allocates, so the compile-time and load-time values are not eql" + } } ] } diff --git a/tests/fixtures/lint_golden/expected/emacs-lisp.text.golden b/tests/fixtures/lint_golden/expected/emacs-lisp.text.golden index 914f4070..dfaf06bc 100644 --- a/tests/fixtures/lint_golden/expected/emacs-lisp.text.golden +++ b/tests/fixtures/lint_golden/expected/emacs-lisp.text.golden @@ -297,6 +297,9 @@ rule declaim-inside-body 0 rule type-declaration-contradicts-initform 0 rule the-form-with-impossible-type 0 rule type-declaration-on-rest-parameter 0 +rule eval-when-execute-only 0 +rule eval-when-body-never-runs 0 +rule defconstant-non-eql-value 0 finding elisp-macro-missing-declare warning malformed fixable=false emacs-lisp.el 344 missing editor declaration: macro `fixture-macro` is defined without one; add a leading (declare (indent ...)) and/or (declare (debug ...)) form so Emacs indents and Edebug instruments calls to this macro correctly elisp-macro-missing-declare/3f509c1d426873fb/0 finding elisp-missing-lexical-binding warning suspicious fixable=false emacs-lisp.el 0 no `lexical-binding` setting on the first line, so this file is evaluated with dynamic binding; add `-*- lexical-binding: t -*-` elisp-missing-lexical-binding/48686428ba8a57d0/0 finding elisp-unreachable-lexical-binding error suspicious fixable=false emacs-lisp.el 911 `lexical-binding` is read from the first line only, so this setting has no effect and the file is evaluated with dynamic binding elisp-unreachable-lexical-binding/7bec796cbb2809fb/0 diff --git a/tests/fixtures/lint_golden/expected/nested.json.golden b/tests/fixtures/lint_golden/expected/nested.json.golden index fca54cc2..ce310068 100644 --- a/tests/fixtures/lint_golden/expected/nested.json.golden +++ b/tests/fixtures/lint_golden/expected/nested.json.golden @@ -2038,6 +2038,24 @@ "count": 0, "description": "a &rest parameter declared to be its element type, though it is always bound to a list", "rule": "type-declaration-on-rest-parameter" + }, + { + "category": "suspicious", + "count": 0, + "description": "a top-level eval-when naming :execute but neither top-level situation, wrapping a definition", + "rule": "eval-when-execute-only" + }, + { + "category": "dead-code", + "count": 0, + "description": "a non-top-level eval-when naming only situations the standard ignores there, so its body never runs", + "rule": "eval-when-body-never-runs" + }, + { + "category": "suspicious", + "count": 0, + "description": "a defconstant whose initform allocates, so the compile-time and load-time values are not eql", + "rule": "defconstant-non-eql-value" } ], "policy": { diff --git a/tests/fixtures/lint_golden/expected/nested.sarif.golden b/tests/fixtures/lint_golden/expected/nested.sarif.golden index 6c4a0bdf..e5289dc7 100644 --- a/tests/fixtures/lint_golden/expected/nested.sarif.golden +++ b/tests/fixtures/lint_golden/expected/nested.sarif.golden @@ -5105,6 +5105,42 @@ "shortDescription": { "text": "a &rest parameter declared to be its element type, though it is always bound to a list" } + }, + { + "id": "eval-when-execute-only", + "properties": { + "category": "suspicious", + "fixable": false, + "severity": "error", + "tags": [] + }, + "shortDescription": { + "text": "a top-level eval-when naming :execute but neither top-level situation, wrapping a definition" + } + }, + { + "id": "eval-when-body-never-runs", + "properties": { + "category": "dead-code", + "fixable": false, + "severity": "error", + "tags": [] + }, + "shortDescription": { + "text": "a non-top-level eval-when naming only situations the standard ignores there, so its body never runs" + } + }, + { + "id": "defconstant-non-eql-value", + "properties": { + "category": "suspicious", + "fixable": false, + "severity": "error", + "tags": [] + }, + "shortDescription": { + "text": "a defconstant whose initform allocates, so the compile-time and load-time values are not eql" + } } ] } diff --git a/tests/fixtures/lint_golden/expected/nested.text.golden b/tests/fixtures/lint_golden/expected/nested.text.golden index 692d4e4e..f6445899 100644 --- a/tests/fixtures/lint_golden/expected/nested.text.golden +++ b/tests/fixtures/lint_golden/expected/nested.text.golden @@ -297,6 +297,9 @@ rule declaim-inside-body 0 rule type-declaration-contradicts-initform 0 rule the-form-with-impossible-type 0 rule type-declaration-on-rest-parameter 0 +rule eval-when-execute-only 0 +rule eval-when-body-never-runs 0 +rule defconstant-non-eql-value 0 finding redundant-quote warning suspicious fixable=true nested.lisp 840 quoting number 5 is redundant redundant-quote/07bb8307b4864109/0 finding redundant-progn warning suspicious fixable=true nested.lisp 268 redundant progn: progn wraps a single form; it is equivalent to that form redundant-progn/9715182cb9f63314/0 finding redundant-progn warning suspicious fixable=true nested.lisp 833 redundant progn: progn wraps a single form; it is equivalent to that form redundant-progn/8d949e5fcf0552a8/0 diff --git a/tests/fixtures/lint_golden/expected/suppressed.json.golden b/tests/fixtures/lint_golden/expected/suppressed.json.golden index 67b87d16..5c36d7ae 100644 --- a/tests/fixtures/lint_golden/expected/suppressed.json.golden +++ b/tests/fixtures/lint_golden/expected/suppressed.json.golden @@ -1817,6 +1817,24 @@ "count": 0, "description": "a &rest parameter declared to be its element type, though it is always bound to a list", "rule": "type-declaration-on-rest-parameter" + }, + { + "category": "suspicious", + "count": 0, + "description": "a top-level eval-when naming :execute but neither top-level situation, wrapping a definition", + "rule": "eval-when-execute-only" + }, + { + "category": "dead-code", + "count": 0, + "description": "a non-top-level eval-when naming only situations the standard ignores there, so its body never runs", + "rule": "eval-when-body-never-runs" + }, + { + "category": "suspicious", + "count": 0, + "description": "a defconstant whose initform allocates, so the compile-time and load-time values are not eql", + "rule": "defconstant-non-eql-value" } ], "policy": { diff --git a/tests/fixtures/lint_golden/expected/suppressed.sarif.golden b/tests/fixtures/lint_golden/expected/suppressed.sarif.golden index 3132f99a..73f767c6 100644 --- a/tests/fixtures/lint_golden/expected/suppressed.sarif.golden +++ b/tests/fixtures/lint_golden/expected/suppressed.sarif.golden @@ -4213,6 +4213,42 @@ "shortDescription": { "text": "a &rest parameter declared to be its element type, though it is always bound to a list" } + }, + { + "id": "eval-when-execute-only", + "properties": { + "category": "suspicious", + "fixable": false, + "severity": "error", + "tags": [] + }, + "shortDescription": { + "text": "a top-level eval-when naming :execute but neither top-level situation, wrapping a definition" + } + }, + { + "id": "eval-when-body-never-runs", + "properties": { + "category": "dead-code", + "fixable": false, + "severity": "error", + "tags": [] + }, + "shortDescription": { + "text": "a non-top-level eval-when naming only situations the standard ignores there, so its body never runs" + } + }, + { + "id": "defconstant-non-eql-value", + "properties": { + "category": "suspicious", + "fixable": false, + "severity": "error", + "tags": [] + }, + "shortDescription": { + "text": "a defconstant whose initform allocates, so the compile-time and load-time values are not eql" + } } ] } diff --git a/tests/fixtures/lint_golden/expected/suppressed.text.golden b/tests/fixtures/lint_golden/expected/suppressed.text.golden index c3d54774..ae6267c4 100644 --- a/tests/fixtures/lint_golden/expected/suppressed.text.golden +++ b/tests/fixtures/lint_golden/expected/suppressed.text.golden @@ -297,5 +297,8 @@ rule declaim-inside-body 0 rule type-declaration-contradicts-initform 0 rule the-form-with-impossible-type 0 rule type-declaration-on-rest-parameter 0 +rule eval-when-execute-only 0 +rule eval-when-body-never-runs 0 +rule defconstant-non-eql-value 0 finding redundant-quote warning suspicious fixable=true suppressed.lisp 338 quoting number 6 is redundant redundant-quote/07bb8007b4863bf0/0 finding declarative-style-score warning suspicious fixable=false suppressed.lisp 0 this file's declarative-style score is 0% (5 top-level forms), below the 80% threshold declarative-style-score/2f534fdd67304360/0