Skip to content

Fix incorrect analysis report for optional function args #8321

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Draft
cknitt wants to merge 4 commits into
base: master
Choose a base branch
from
Draft

Fix incorrect analysis report for optional function args #8321

Show file tree
Hide file tree
Changes from 1 commit
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
57f9dd1
Fix incorrect analysis report for optional function args
cknitt Mar 31, 2026
ea581f1
Tighten the cross-file function-ref check
cknitt Mar 31, 2026
c6969ec
Cleanup
cknitt Mar 31, 2026
8c73428
Fix
cknitt Mar 31, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
7 changes: 4 additions & 3 deletions analysis/reanalyze/src/DeadCommon.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -123,11 +123,12 @@ let addDeclaration_ ~config ~decls ~(file : FileContext.t) ?posEnd ?posStart
Declarations.add decls pos decl)

let addValueDeclaration ~config ~decls ~file ?(isToplevel = true)
~(loc : Location.t) ~moduleLoc ?(optionalArgs = OptionalArgs.empty) ~path
~sideEffects name =
?(ownsOptionalArgs = false) ~(loc : Location.t) ~moduleLoc
?(optionalArgs = OptionalArgs.empty) ~path ~sideEffects name =
name
|> addDeclaration_ ~config ~decls ~file
~declKind:(Value {isToplevel; optionalArgs; sideEffects})
~declKind:
(Value {isToplevel; ownsOptionalArgs; optionalArgs; sideEffects})
~loc ~moduleLoc ~path

(** Create a dead code issue. Pure - no side effects. *)
Expand Down
79 changes: 61 additions & 18 deletions analysis/reanalyze/src/DeadOptionalArgs.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -7,12 +7,34 @@ let addFunctionReference ~config ~decls ~cross_file ~(locFrom : Location.t)
if active () then
let posTo = locTo.loc_start in
let posFrom = locFrom.loc_start in
(* Check if target has optional args - for filtering and debug logging *)
(* Only declarations that own optional args should participate in
optional-arg state merging. A function-valued alias like
[let f = useNotification()] can have an optional-arg type, but it is not
the declaration site that should receive warnings. *)
let shouldAdd =
match Declarations.find_opt_builder decls posTo with
| Some {declKind = Value {optionalArgs}} ->
not (OptionalArgs.isEmpty optionalArgs)
| _ -> false
if posTo.pos_fname <> posFrom.pos_fname then
match Declarations.find_opt_builder decls posTo with
| Some {declKind = Value {ownsOptionalArgs; optionalArgs}} ->
ownsOptionalArgs && not (OptionalArgs.isEmpty optionalArgs)
Copy link
Copy Markdown

@chatgpt-codex-connector chatgpt-codex-connector bot Mar 31, 2026

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

P1 Badge Check source ownership for cross-file function refs

The cross-file branch only validates posTo, so it still records function references whose posFrom is a non-owning alias/value with optionalArgs = empty. In this commit, that empty source state is then merged in compute_optional_args_state via OptionalArgs.combine_pair (which intersects states), so a live cross-file alias like let g = A.f can erase f’s optional-arg state and suppress legitimate optional-argument diagnostics on the real declaration.

Useful? React with 👍 / 👎.

| _ -> false
else
match
( Declarations.find_opt_builder decls posFrom,
Declarations.find_opt_builder decls posTo )
with
| ( Some
{
declKind =
Value {ownsOptionalArgs = true; optionalArgs = sourceArgs};
},
Some
{
declKind =
Value {ownsOptionalArgs = true; optionalArgs = targetArgs};
} ) ->
(not (OptionalArgs.isEmpty sourceArgs))
&& not (OptionalArgs.isEmpty targetArgs)
| _ -> false
in
if shouldAdd then (
if config.DceConfig.cli.debug then
Expand All @@ -39,23 +61,44 @@ let rec fromTypeExpr (texpr : Types.type_expr) =
| Tsubst t -> fromTypeExpr t
| _ -> []

let addReferences ~config ~cross_file ~(locFrom : Location.t)
let rec fromTypeExprWithArity (texpr : Types.type_expr) arity =
if arity <= 0 then []
else
match texpr.desc with
| _ when not (active ()) -> []
| Tarrow ({lbl = Optional {txt = s}}, tTo, _, _) ->
s :: fromTypeExprWithArity tTo (arity - 1)
| Tarrow (_, tTo, _, _) -> fromTypeExprWithArity tTo (arity - 1)
| Tlink t -> fromTypeExprWithArity t arity
| Tsubst t -> fromTypeExprWithArity t arity
| _ -> []

let addReferences ~config ~decls ~cross_file ~(locFrom : Location.t)
~(locTo : Location.t) ~(binding : Location.t) ~path (argNames, argNamesMaybe)
=
if active () then (
if active () then
let posTo = locTo.loc_start in
let posFrom = binding.loc_start in
CrossFileItems.add_optional_arg_call cross_file ~pos_from:posFrom
~pos_to:posTo ~arg_names:argNames ~arg_names_maybe:argNamesMaybe;
if config.DceConfig.cli.debug then
let callPos = locFrom.loc_start in
Log_.item
"DeadOptionalArgs.addReferences %s called with optional argNames:%s \
argNamesMaybe:%s %s@."
(path |> DcePath.fromPathT |> DcePath.toString)
(argNames |> String.concat ", ")
(argNamesMaybe |> String.concat ", ")
(callPos |> Pos.toString))
let callPos = locFrom.loc_start in
let shouldAdd =
if posTo.pos_fname <> callPos.pos_fname then true
else
match Declarations.find_opt_builder decls posTo with
| Some {declKind = Value {ownsOptionalArgs; optionalArgs}} ->
ownsOptionalArgs && not (OptionalArgs.isEmpty optionalArgs)
| _ -> false
Comment on lines +80 to +83
Copy link
Copy Markdown

@chatgpt-codex-connector chatgpt-codex-connector bot Mar 31, 2026

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

P2 Badge Record optional calls even when target decl isn't built yet

The same-file guard in addReferences drops a call unless Declarations.find_opt_builder decls posTo already has a non-empty optional-arg declaration. In a let rec ... and ... group, expressions are traversed per binding before later bindings are added, so a call from an earlier binding to a later optional-arg function can hit None here and never be recorded. This undercounts real calls and can produce wrong optional-argument diagnostics (e.g., reporting an arg as unused/redundant when it is used through mutual recursion).

Useful? React with 👍 / 👎.

in
if shouldAdd then (
CrossFileItems.add_optional_arg_call cross_file ~pos_from:posFrom
~pos_to:posTo ~arg_names:argNames ~arg_names_maybe:argNamesMaybe;
if config.DceConfig.cli.debug then
Log_.item
"DeadOptionalArgs.addReferences %s called with optional argNames:%s \
argNamesMaybe:%s %s@."
(path |> DcePath.fromPathT |> DcePath.toString)
(argNames |> String.concat ", ")
(argNamesMaybe |> String.concat ", ")
(callPos |> Pos.toString))

(** Check for optional args issues. Returns issues instead of logging.
Uses optional_args_state map for final computed state. *)
Expand Down
88 changes: 69 additions & 19 deletions analysis/reanalyze/src/DeadValue.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -27,12 +27,28 @@ let collectValueBinding ~config ~decls ~file ~(current_binding : Location.t)
when (not loc_ghost) && not vb.vb_loc.loc_ghost ->
let name = Ident.name id |> Name.create ~isInterface:false in
let optionalArgs =
vb.vb_expr.exp_type |> DeadOptionalArgs.fromTypeExpr
|> OptionalArgs.fromList
match vb.vb_expr.exp_desc with
| Texp_function {arity = Some arity; _} ->
vb.vb_expr.exp_type
|> (fun texpr -> DeadOptionalArgs.fromTypeExprWithArity texpr arity)
|> OptionalArgs.fromList
| Texp_function _ ->
vb.vb_expr.exp_type |> DeadOptionalArgs.fromTypeExpr
|> OptionalArgs.fromList
| _ -> OptionalArgs.empty
in
(* Only actual function declarations own optional-arg diagnostics.
Aliases to function values can expose the same optional-arg type, but
warnings should stay attached to the declaration site. *)
let ownsOptionalArgs =
match vb.vb_expr.exp_desc with
| Texp_function _ -> true
| _ -> false
in
let exists =
match Declarations.find_opt_builder decls loc_start with
| Some {declKind = Value r} ->
r.ownsOptionalArgs <- ownsOptionalArgs;
r.optionalArgs <- optionalArgs;
true
| _ -> false
Expand All @@ -48,8 +64,9 @@ let collectValueBinding ~config ~decls ~file ~(current_binding : Location.t)
let isToplevel = oldLastBinding = Location.none in
let sideEffects = SideEffects.checkExpr vb.vb_expr in
name
|> addValueDeclaration ~config ~decls ~file ~isToplevel ~loc
~moduleLoc:modulePath.loc ~optionalArgs ~path ~sideEffects);
|> addValueDeclaration ~config ~decls ~file ~isToplevel
~ownsOptionalArgs ~loc ~moduleLoc:modulePath.loc ~optionalArgs
~path ~sideEffects);
(match Declarations.find_opt_builder decls loc_start with
| None -> ()
| Some decl ->
Expand All @@ -74,8 +91,8 @@ let collectValueBinding ~config ~decls ~file ~(current_binding : Location.t)
in
loc

let processOptionalArgs ~config ~cross_file ~expType ~(locFrom : Location.t)
~(binding : Location.t) ~locTo ~path args =
let processOptionalArgs ~config ~decls ~cross_file ~expType
~(locFrom : Location.t) ~(binding : Location.t) ~locTo ~path args =
if expType |> DeadOptionalArgs.hasOptionalArgs then (
let supplied = ref [] in
let suppliedMaybe = ref [] in
Expand Down Expand Up @@ -104,13 +121,36 @@ let processOptionalArgs ~config ~cross_file ~expType ~(locFrom : Location.t)
if argIsSupplied = None then suppliedMaybe := s :: !suppliedMaybe
| _ -> ());
(!supplied, !suppliedMaybe)
|> DeadOptionalArgs.addReferences ~config ~cross_file ~locFrom ~locTo
|> DeadOptionalArgs.addReferences ~config ~decls ~cross_file ~locFrom ~locTo
~binding ~path)

let rec collectExpr ~config ~refs ~file_deps ~cross_file
let rec collectExpr ~config ~decls ~refs ~file_deps ~cross_file ~callee_locs
~(last_binding : Location.t) super self (e : Typedtree.expression) =
let locFrom = e.exp_loc in
let binding = last_binding in
let suppressOptionalArgs pos =
match Declarations.find_opt_builder decls pos with
| Some ({declKind = Value ({optionalArgs; _} as value_kind)} as decl)
when not (OptionalArgs.isEmpty optionalArgs) ->
Declarations.replace_builder decls pos
{
decl with
declKind = Value {value_kind with optionalArgs = OptionalArgs.empty};
}
| _ -> ()
in
let rec remove_first target = function
| [] -> []
| x :: xs when x = target -> xs
| x :: xs -> x :: remove_first target xs
in
let callee_loc_opt =
match e.exp_desc with
| Texp_apply {funct = {exp_desc = Texp_ident (_, _, _); exp_loc}; _} ->
Some exp_loc
| _ -> None
in
Option.iter (fun loc -> callee_locs := loc :: !callee_locs) callee_loc_opt;
(match e.exp_desc with
| Texp_ident (_path, _, {Types.val_loc = {loc_ghost = false; _} as locTo}) ->
(* if Path.name _path = "rc" then assert false; *)
Expand All @@ -123,9 +163,11 @@ let rec collectExpr ~config ~refs ~file_deps ~cross_file
(locTo.loc_start |> Pos.toString);
References.add_value_ref refs ~posTo:locTo.loc_start
~posFrom:Location.none.loc_start)
else
else (
addValueReference ~config ~refs ~file_deps ~binding ~addFileReference:true
~locFrom ~locTo
~locFrom ~locTo;
if not (List.mem locFrom !callee_locs) then
suppressOptionalArgs locTo.loc_start)
Copy link
Copy Markdown

@chatgpt-codex-connector chatgpt-codex-connector bot Mar 31, 2026

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

P1 Badge Stop erasing optional args on non-call identifier refs

The new collectExpr path clears a declaration’s optionalArgs whenever it sees a Texp_ident that is not in callee_locs, which includes ordinary aliasing like let alias = f. This mutates f before optional-arg state is computed, so later direct calls to f start from an empty optional-arg set and DeadOptionalArgs.check can no longer report real unused/always-supplied optional arguments; even dead aliases can suppress diagnostics for the original function.

Useful? React with 👍 / 👎.

| Texp_apply
{
funct =
Expand All @@ -138,7 +180,7 @@ let rec collectExpr ~config ~refs ~file_deps ~cross_file
args;
} ->
args
|> processOptionalArgs ~config ~cross_file ~expType:exp_type
|> processOptionalArgs ~config ~decls ~cross_file ~expType:exp_type
~locFrom:(locFrom : Location.t)
~binding:last_binding ~locTo ~path
| Texp_let
Expand Down Expand Up @@ -179,7 +221,7 @@ let rec collectExpr ~config ~refs ~file_deps ~cross_file
&& Ident.name etaArg = "eta"
&& Path.name idArg2 = "arg" ->
args
|> processOptionalArgs ~config ~cross_file ~expType:exp_type
|> processOptionalArgs ~config ~decls ~cross_file ~expType:exp_type
~locFrom:(locFrom : Location.t)
~binding:last_binding ~locTo ~path
| Texp_field
Expand All @@ -206,12 +248,16 @@ let rec collectExpr ~config ~refs ~file_deps ~cross_file
->
(* Punned field in OCaml projects has ghost location in expression *)
let e = {e with exp_loc = {exp_loc with loc_ghost = false}} in
collectExpr ~config ~refs ~file_deps ~cross_file ~last_binding
super self e
collectExpr ~config ~decls ~refs ~file_deps ~cross_file
~callee_locs ~last_binding super self e
|> ignore
| _ -> ())
| _ -> ());
super.Tast_mapper.expr self e
let result = super.Tast_mapper.expr self e in
Option.iter
(fun loc -> callee_locs := remove_first loc !callee_locs)
callee_loc_opt;
result

(*
type k. is a locally abstract type
Expand Down Expand Up @@ -279,13 +325,17 @@ let rec processSignatureItem ~config ~decls ~file ~doTypes ~doValues ~moduleLoc
let optionalArgs =
val_type |> DeadOptionalArgs.fromTypeExpr |> OptionalArgs.fromList
in
(* Signature items only expose the function type, so we conservatively
seed ownership from the presence of optional args. The implementation
pass above refines this for aliases that should not own warnings. *)
let ownsOptionalArgs = not (OptionalArgs.isEmpty optionalArgs) in

(* if Ident.name id = "someValue" then
Printf.printf "XXX %s\n" (Ident.name id); *)
Ident.name id
|> Name.create ~isInterface:false
|> addValueDeclaration ~config ~decls ~file ~loc ~moduleLoc
~optionalArgs ~path ~sideEffects:false
~ownsOptionalArgs ~optionalArgs ~path ~sideEffects:false
| Sig_module (id, {Types.md_type = moduleType; md_loc = moduleLoc}, _)
| Sig_modtype (id, {Types.mtd_type = Some moduleType; mtd_loc = moduleLoc}) ->
let modulePath' =
Expand All @@ -309,6 +359,7 @@ let rec processSignatureItem ~config ~decls ~file ~doTypes ~doValues ~moduleLoc
(* Traverse the AST *)
let traverseStructure ~config ~decls ~refs ~file_deps ~cross_file ~file ~doTypes
~doExternals (structure : Typedtree.structure) : unit =
let callee_locs = ref [] in
let rec create_mapper (last_binding : Location.t) (modulePath : ModulePath.t)
=
let super = Tast_mapper.default in
Expand All @@ -317,9 +368,8 @@ let traverseStructure ~config ~decls ~refs ~file_deps ~cross_file ~file ~doTypes
super with
expr =
(fun _self e ->
e
|> collectExpr ~config ~refs ~file_deps ~cross_file ~last_binding
super mapper);
collectExpr ~config ~decls ~refs ~file_deps ~cross_file ~callee_locs
~last_binding super mapper e);
pat = (fun _self p -> p |> collectPattern ~config ~refs super mapper);
structure_item =
(fun _self (structureItem : Typedtree.structure_item) ->
Expand Down
1 change: 1 addition & 0 deletions analysis/reanalyze/src/Decl.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,7 @@ module Kind = struct
| VariantCase
| Value of {
isToplevel: bool;
mutable ownsOptionalArgs: bool;
mutable optionalArgs: OptionalArgs.t;
sideEffects: bool;
}
Expand Down
Loading
Loading