From 57f9dd1a651241da95b73b7f49c5cba8abfd3964 Mon Sep 17 00:00:00 2001 From: Christoph Knittel Date: Tue, 31 Mar 2026 13:30:08 +0200 Subject: [PATCH 1/4] Fix incorrect analysis report for optional function args --- analysis/reanalyze/src/DeadCommon.ml | 7 +- analysis/reanalyze/src/DeadOptionalArgs.ml | 79 ++++++++++--- analysis/reanalyze/src/DeadValue.ml | 88 +++++++++++--- analysis/reanalyze/src/Decl.ml | 1 + .../deadcode/expected/deadcode.txt | 109 +++++++++++++++++- .../deadcode/src/ContextOptionalArgs.res | 60 ++++++++++ 6 files changed, 299 insertions(+), 45 deletions(-) create mode 100644 tests/analysis_tests/tests-reanalyze/deadcode/src/ContextOptionalArgs.res diff --git a/analysis/reanalyze/src/DeadCommon.ml b/analysis/reanalyze/src/DeadCommon.ml index a2434473c0e..a5adcfa328b 100644 --- a/analysis/reanalyze/src/DeadCommon.ml +++ b/analysis/reanalyze/src/DeadCommon.ml @@ -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. *) diff --git a/analysis/reanalyze/src/DeadOptionalArgs.ml b/analysis/reanalyze/src/DeadOptionalArgs.ml index 71bef0ac99b..72e82f4b4d7 100644 --- a/analysis/reanalyze/src/DeadOptionalArgs.ml +++ b/analysis/reanalyze/src/DeadOptionalArgs.ml @@ -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) + | _ -> 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 @@ -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 + 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. *) diff --git a/analysis/reanalyze/src/DeadValue.ml b/analysis/reanalyze/src/DeadValue.ml index 0bb26e9dca1..876784def95 100644 --- a/analysis/reanalyze/src/DeadValue.ml +++ b/analysis/reanalyze/src/DeadValue.ml @@ -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 @@ -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 -> @@ -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 @@ -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; *) @@ -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) | Texp_apply { funct = @@ -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 @@ -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 @@ -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 @@ -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' = @@ -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 @@ -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) -> diff --git a/analysis/reanalyze/src/Decl.ml b/analysis/reanalyze/src/Decl.ml index d36b825eb13..f1a506a704d 100644 --- a/analysis/reanalyze/src/Decl.ml +++ b/analysis/reanalyze/src/Decl.ml @@ -7,6 +7,7 @@ module Kind = struct | VariantCase | Value of { isToplevel: bool; + mutable ownsOptionalArgs: bool; mutable optionalArgs: OptionalArgs.t; sideEffects: bool; } diff --git a/tests/analysis_tests/tests-reanalyze/deadcode/expected/deadcode.txt b/tests/analysis_tests/tests-reanalyze/deadcode/expected/deadcode.txt index 9f8e8ec204f..0be5132d2fe 100644 --- a/tests/analysis_tests/tests-reanalyze/deadcode/expected/deadcode.txt +++ b/tests/analysis_tests/tests-reanalyze/deadcode/expected/deadcode.txt @@ -31,6 +31,44 @@ addTypeReference _none_:1:-1 --> ComponentAsProp.res:6:12 addTypeReference _none_:1:-1 --> ComponentAsProp.res:6:20 addTypeReference _none_:1:-1 --> ComponentAsProp.res:6:34 + Scanning ContextOptionalArgs.cmt Source:ContextOptionalArgs.res + addValueDeclaration +dispatchNotificationContext ContextOptionalArgs.res:2:6 path:+ContextOptionalArgs.NotificationProvider + addValueDeclaration +make ContextOptionalArgs.res:8:8 path:+ContextOptionalArgs.NotificationProvider.Provider + addValueDeclaration +make ContextOptionalArgs.res:12:6 path:+ContextOptionalArgs.NotificationProvider + addValueDeclaration +useNotification ContextOptionalArgs.res:22:6 path:+ContextOptionalArgs.NotificationProvider + addValueDeclaration +make ContextOptionalArgs.res:27:6 path:+ContextOptionalArgs.ComponentUsingAction + addValueDeclaration +make ContextOptionalArgs.res:41:6 path:+ContextOptionalArgs.ComponentNotUsingAction + addValueDeclaration +make ContextOptionalArgs.res:55:4 path:+ContextOptionalArgs + addRecordLabelDeclaration children ContextOptionalArgs.res:12:14 path:+ContextOptionalArgs.NotificationProvider.props + addValueReference ContextOptionalArgs.res:2:6 --> React.res:80:0 + addValueReference ContextOptionalArgs.res:8:8 --> ContextOptionalArgs.res:2:6 + addValueReference ContextOptionalArgs.res:8:8 --> React.res:76:2 + addRecordLabelDeclaration children ContextOptionalArgs.res:12:14 path:+ContextOptionalArgs.NotificationProvider.props + addValueDeclaration +dispatchNotification ContextOptionalArgs.res:13:8 path:+ContextOptionalArgs.NotificationProvider + addValueReference ContextOptionalArgs.res:13:8 --> ContextOptionalArgs.res:13:43 + addValueReference ContextOptionalArgs.res:13:8 --> ContextOptionalArgs.res:15:13 + addValueReference ContextOptionalArgs.res:13:8 --> ContextOptionalArgs.res:13:43 + addValueReference ContextOptionalArgs.res:13:8 --> ContextOptionalArgs.res:13:32 + addValueReference ContextOptionalArgs.res:19:5 --> ContextOptionalArgs.res:8:8 + addValueReference ContextOptionalArgs.res:19:20 --> ContextOptionalArgs.res:13:8 + addValueReference ContextOptionalArgs.res:19:43 --> ContextOptionalArgs.res:12:14 + addTypeReference _none_:1:-1 --> ContextOptionalArgs.res:12:14 + DeadOptionalArgs.addReferences React.useContext called with optional argNames: argNamesMaybe: ContextOptionalArgs.res:22:30 + addValueReference ContextOptionalArgs.res:22:6 --> ContextOptionalArgs.res:2:6 + addValueReference ContextOptionalArgs.res:22:6 --> React.res:250:0 + addValueDeclaration +dispatchNotification ContextOptionalArgs.res:28:8 path:+ContextOptionalArgs.ComponentUsingAction + addValueReference ContextOptionalArgs.res:28:8 --> ContextOptionalArgs.res:22:6 + addValueReference ContextOptionalArgs.res:35:4 --> React.res:3:0 + addValueReference ContextOptionalArgs.res:31:6 --> ContextOptionalArgs.res:28:8 + addValueReference ContextOptionalArgs.res:30:4 --> React.res:150:0 + addValueDeclaration +dispatchNotification ContextOptionalArgs.res:42:8 path:+ContextOptionalArgs.ComponentNotUsingAction + addValueReference ContextOptionalArgs.res:42:8 --> ContextOptionalArgs.res:22:6 + addValueReference ContextOptionalArgs.res:49:4 --> React.res:3:0 + addValueReference ContextOptionalArgs.res:45:6 --> ContextOptionalArgs.res:42:8 + addValueReference ContextOptionalArgs.res:44:4 --> React.res:150:0 + addValueReference ContextOptionalArgs.res:56:3 --> ContextOptionalArgs.res:12:6 + addValueReference ContextOptionalArgs.res:57:5 --> ContextOptionalArgs.res:27:6 + addValueReference ContextOptionalArgs.res:58:5 --> ContextOptionalArgs.res:41:6 Scanning CreateErrorHandler1.cmt Source:CreateErrorHandler1.res addValueDeclaration +notification CreateErrorHandler1.res:3:6 path:+CreateErrorHandler1.Error1 addValueReference CreateErrorHandler1.res:3:6 --> CreateErrorHandler1.res:3:21 @@ -1931,9 +1969,9 @@ Forward Liveness Analysis - decls: 695 - roots(external targets): 134 - decl-deps: decls_with_out=407 edges_to_decls=288 + decls: 706 + roots(external targets): 143 + decl-deps: decls_with_out=417 edges_to_decls=302 Root (annotated): Value +Hooks.+default Root (external ref): Value +FirstClassModules.M.InnerModule2.+k @@ -1974,8 +2012,10 @@ Forward Liveness Analysis Root (external ref): RecordLabel +Records.record.v Root (external ref): VariantCase +DeadTest.VariantUsedOnlyInImplementation.t.A Root (annotated): Value +DeadTest.GloobLive.+globallyLive3 + Root (external ref): Value +ContextOptionalArgs.ComponentUsingAction.+make Root (external ref): Value +Hooks.RenderPropRequiresConversion.+car Root (external ref): RecordLabel +Records.person.address + Root (external ref): RecordLabel +ContextOptionalArgs.NotificationProvider.props.children Root (annotated): Value +Variants.+testConvert2 Root (annotated): Value +Tuples.+coord2d Root (external ref): Value +CreateErrorHandler1.Error1.+notification @@ -2008,6 +2048,7 @@ Forward Liveness Analysis Root (external ref): Value OptArg.+bar Root (annotated): Value +Records.+payloadValue Root (external ref): RecordLabel +DeadTest.props.s + Root (external ref): Value +ContextOptionalArgs.NotificationProvider.+make Root (annotated): Value +TestEmitInnerModules.Inner.+y Root (external ref): VariantCase InnerModuleTypes.I.t.Foo Root (annotated): Value +Types.+selfRecursiveConverter @@ -2025,6 +2066,7 @@ Forward Liveness Analysis Root (external ref): RecordLabel +Tuples.person.name Root (external ref): Value +FirstClassModules.M.InnerModule3.+k3 Root (external ref): VariantCase +Unison.break.Always + Root (external ref): Value +ContextOptionalArgs.ComponentNotUsingAction.+dispatchNotification Root (external ref): RecordLabel +Records.coord.x Root (annotated): RecordLabel +DeadTypeTest.record.y Root (annotated): Value +TestImport.+defaultValue @@ -2085,6 +2127,7 @@ Forward Liveness Analysis Root (annotated): Value +OcamlWarningSuppressToplevel.+suppressed1 Root (external ref): RecordLabel +Records.business2.address2 Root (annotated): Value +Tuples.+testTuple + Root (external ref): Value +ContextOptionalArgs.NotificationProvider.+dispatchNotification Root (annotated): Value +Records.+testMyObj2 Root (annotated): Value +Uncurried.+callback2 Root (external ref): Value +DeadTest.VariantUsedOnlyInImplementation.+a @@ -2095,6 +2138,7 @@ Forward Liveness Analysis Root (annotated): Value +TestEmitInnerModules.Inner.+x Root (external ref): Value +OptArg.+wrapOneArg Root (external ref): RecordLabel +ComponentAsProp.props.title + Root (external ref): Value +ContextOptionalArgs.ComponentUsingAction.+dispatchNotification Root (annotated): Value +Records.+findAddress Root (annotated): Value +Uncurried.+callback Root (annotated): Value +VariantsWithPayload.+printVariantWithPayload @@ -2105,6 +2149,7 @@ Forward Liveness Analysis Root (annotated): Value +LetPrivate.local_1.+x Root (annotated): Value +TestImport.+make Root (external ref): RecordLabel +Unison.t.break + Root (external ref): Value +ContextOptionalArgs.NotificationProvider.Provider.+make Root (annotated): Value +Docstrings.+grouped Root (annotated): Value +OcamlWarningSuppressToplevel.M.+suppressed4 Root (annotated): Value +Types.+optFunction @@ -2141,8 +2186,10 @@ Forward Liveness Analysis Root (annotated): RecordLabel +DeadTypeTest.record.x Root (external ref): RecordLabel +Records.myRec.type_ Root (annotated): Value +TestOptArg.+liveSuppressesOptArgs + Root (external ref): Value +ContextOptionalArgs.ComponentNotUsingAction.+make Root (annotated): Value NestedModulesInSignature.Universe.+theAnswer Root (annotated): Value +Docstrings.+unitArgWithoutConversion + Root (annotated): Value +ContextOptionalArgs.+make Root (annotated): Value +References.+create Root (annotated): Value +Types.+currentTime Root (annotated): Value +Records.+someBusiness2 @@ -2256,7 +2303,7 @@ Forward Liveness Analysis Root (annotated): Value +UseImportJsValue.+useGetProp Root (external ref): RecordLabel +Hooks.RenderPropRequiresConversion.props.renderVehicle - 320 roots found + 329 roots found Propagate: +Hooks.+default -> +Hooks.+make Propagate: DeadRT.moduleAccessPath.Root -> +DeadRT.moduleAccessPath.Root @@ -2267,6 +2314,7 @@ Forward Liveness Analysis Propagate: +Newton.+f -> +Newton.++ Propagate: +Newton.+f -> +Newton.+* Propagate: +DeadTest.VariantUsedOnlyInImplementation.t.A -> +DeadTest.VariantUsedOnlyInImplementation.t.A + Propagate: +ContextOptionalArgs.ComponentUsingAction.+make -> +ContextOptionalArgs.NotificationProvider.+useNotification Propagate: +DeadTest.+thisIsMarkedLive -> +DeadTest.+thisIsKeptAlive Propagate: +TypeReexport.UseOriginal.reexportedType.directlyUsed -> +TypeReexport.UseOriginal.originalType.directlyUsed Propagate: InnerModuleTypes.I.t.Foo -> +InnerModuleTypes.I.t.Foo @@ -2285,6 +2333,7 @@ Forward Liveness Analysis Propagate: +DeadTest.VariantUsedOnlyInImplementation.+a -> +DeadTest.VariantUsedOnlyInImplementation.+a Propagate: +OptArg.+wrapOneArg -> +OptArg.+oneArg Propagate: +TestImmutableArray.+testImmutableArrayGet -> ImmutableArray.Array.+get + Propagate: +ContextOptionalArgs.NotificationProvider.Provider.+make -> +ContextOptionalArgs.NotificationProvider.+dispatchNotificationContext Propagate: +TypeReexport.VariantUseReexported.reexportedType.A -> +TypeReexport.VariantUseReexported.originalType.A Propagate: +References.+set -> +References.R.+set Propagate: +DeadTest.MM.+x -> +DeadTest.MM.+x @@ -2312,7 +2361,7 @@ Forward Liveness Analysis Propagate: +DeadTest.MM.+x -> +DeadTest.MM.+y Propagate: +ImportJsValue.AbsoluteValue.+getAbs -> +ImportJsValue.AbsoluteValue.+getAbs - 53 declarations marked live via propagation + 55 declarations marked live via propagation Dead VariantCase +AutoAnnotate.variant.R Dead RecordLabel +AutoAnnotate.record.variant @@ -2341,6 +2390,56 @@ Forward Liveness Analysis Live (external ref) RecordLabel +ComponentAsProp.props.button deps: in=1 (live=1 dead=0) out=0 <- +ComponentAsProp.+make (live) + Live (propagated) Value +ContextOptionalArgs.NotificationProvider.+dispatchNotificationContext + deps: in=2 (live=2 dead=0) out=0 + <- +ContextOptionalArgs.NotificationProvider.Provider.+make (live) + <- +ContextOptionalArgs.NotificationProvider.+useNotification (live) + Live (external ref) Value +ContextOptionalArgs.NotificationProvider.Provider.+make + deps: in=1 (live=1 dead=0) out=1 + <- +ContextOptionalArgs.NotificationProvider.+make (live) + -> +ContextOptionalArgs.NotificationProvider.+dispatchNotificationContext + Live (external ref) Value +ContextOptionalArgs.NotificationProvider.+make + deps: in=1 (live=1 dead=0) out=3 + <- +ContextOptionalArgs.+make (live) + -> +ContextOptionalArgs.NotificationProvider.Provider.+make + -> +ContextOptionalArgs.NotificationProvider.props.children + -> +ContextOptionalArgs.NotificationProvider.+dispatchNotification + Live (external ref) RecordLabel +ContextOptionalArgs.NotificationProvider.props.children + deps: in=1 (live=1 dead=0) out=0 + <- +ContextOptionalArgs.NotificationProvider.+make (live) + Live (external ref) Value +ContextOptionalArgs.NotificationProvider.+dispatchNotification + deps: in=1 (live=1 dead=0) out=0 + <- +ContextOptionalArgs.NotificationProvider.+make (live) + Live (propagated) Value +ContextOptionalArgs.NotificationProvider.+useNotification + deps: in=4 (live=4 dead=0) out=1 + <- +ContextOptionalArgs.ComponentUsingAction.+make (live) + <- +ContextOptionalArgs.ComponentUsingAction.+dispatchNotification (live) + <- +ContextOptionalArgs.ComponentNotUsingAction.+make (live) + <- ... (1 more) + -> +ContextOptionalArgs.NotificationProvider.+dispatchNotificationContext + Live (external ref) Value +ContextOptionalArgs.ComponentUsingAction.+make + deps: in=1 (live=1 dead=0) out=2 + <- +ContextOptionalArgs.+make (live) + -> +ContextOptionalArgs.NotificationProvider.+useNotification + -> +ContextOptionalArgs.ComponentUsingAction.+dispatchNotification + Live (external ref) Value +ContextOptionalArgs.ComponentUsingAction.+dispatchNotification + deps: in=1 (live=1 dead=0) out=1 + <- +ContextOptionalArgs.ComponentUsingAction.+make (live) + -> +ContextOptionalArgs.NotificationProvider.+useNotification + Live (external ref) Value +ContextOptionalArgs.ComponentNotUsingAction.+make + deps: in=1 (live=1 dead=0) out=2 + <- +ContextOptionalArgs.+make (live) + -> +ContextOptionalArgs.NotificationProvider.+useNotification + -> +ContextOptionalArgs.ComponentNotUsingAction.+dispatchNotification + Live (external ref) Value +ContextOptionalArgs.ComponentNotUsingAction.+dispatchNotification + deps: in=1 (live=1 dead=0) out=1 + <- +ContextOptionalArgs.ComponentNotUsingAction.+make (live) + -> +ContextOptionalArgs.NotificationProvider.+useNotification + Live (annotated) Value +ContextOptionalArgs.+make + deps: in=0 (live=0 dead=0) out=3 + -> +ContextOptionalArgs.NotificationProvider.+make + -> +ContextOptionalArgs.ComponentUsingAction.+make + -> +ContextOptionalArgs.ComponentNotUsingAction.+make Live (external ref) Value +CreateErrorHandler1.Error1.+notification Live (external ref) Value +CreateErrorHandler2.Error2.+notification Live (external ref) Value +DeadCodeImplementation.M.+x diff --git a/tests/analysis_tests/tests-reanalyze/deadcode/src/ContextOptionalArgs.res b/tests/analysis_tests/tests-reanalyze/deadcode/src/ContextOptionalArgs.res new file mode 100644 index 00000000000..f9c4075e9d1 --- /dev/null +++ b/tests/analysis_tests/tests-reanalyze/deadcode/src/ContextOptionalArgs.res @@ -0,0 +1,60 @@ +module NotificationProvider = { + let dispatchNotificationContext = React.createContext(( + ~action as _: option=?, + _message: string, + ) => ()) + + module Provider = { + let make = React.Context.provider(dispatchNotificationContext) + } + + @react.component + let make = (~children) => { + let dispatchNotification = (~action=?, message) => + switch action { + | Some(action) => Console.log2(message, action) + | None => Console.log(message) + } + + {children} + } + + let useNotification = () => React.useContext(dispatchNotificationContext) +} + +module ComponentUsingAction = { + @react.component + let make = () => { + let dispatchNotification = NotificationProvider.useNotification() + + React.useEffect(() => { + dispatchNotification(~action="Some action", "This is a notification message") + None + }, []) + + React.null + } +} + +module ComponentNotUsingAction = { + @react.component + let make = () => { + let dispatchNotification = NotificationProvider.useNotification() + + React.useEffect(() => { + dispatchNotification("This is a notification message") + None + }, []) + + React.null + } +} + +@live +@react.component +let make = () => { + + + + +} From ea581f1c9be3b71dc7cfbd4b45042c54a01a3daa Mon Sep 17 00:00:00 2001 From: Christoph Knittel Date: Tue, 31 Mar 2026 13:42:21 +0200 Subject: [PATCH 2/4] Tighten the cross-file function-ref check --- analysis/reanalyze/src/DeadOptionalArgs.ml | 30 +++++++++++++++++++--- 1 file changed, 26 insertions(+), 4 deletions(-) diff --git a/analysis/reanalyze/src/DeadOptionalArgs.ml b/analysis/reanalyze/src/DeadOptionalArgs.ml index 72e82f4b4d7..e5e5458ca75 100644 --- a/analysis/reanalyze/src/DeadOptionalArgs.ml +++ b/analysis/reanalyze/src/DeadOptionalArgs.ml @@ -13,10 +13,32 @@ let addFunctionReference ~config ~decls ~cross_file ~(locFrom : Location.t) the declaration site that should receive warnings. *) let shouldAdd = 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) - | _ -> false + if + fileIsImplementationOf posTo.pos_fname posFrom.pos_fname + || fileIsImplementationOf posFrom.pos_fname posTo.pos_fname + then + match Declarations.find_opt_builder decls posTo with + | Some {declKind = Value {ownsOptionalArgs; optionalArgs}} -> + ownsOptionalArgs && not (OptionalArgs.isEmpty optionalArgs) + | _ -> 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 else match ( Declarations.find_opt_builder decls posFrom, From c6969ec07c186c98960c2d0ae0422ad3bb240620 Mon Sep 17 00:00:00 2001 From: Christoph Knittel Date: Tue, 31 Mar 2026 13:45:53 +0200 Subject: [PATCH 3/4] Cleanup --- analysis/reanalyze/src/DeadOptionalArgs.ml | 53 +++++----------------- 1 file changed, 12 insertions(+), 41 deletions(-) diff --git a/analysis/reanalyze/src/DeadOptionalArgs.ml b/analysis/reanalyze/src/DeadOptionalArgs.ml index e5e5458ca75..89facfda34a 100644 --- a/analysis/reanalyze/src/DeadOptionalArgs.ml +++ b/analysis/reanalyze/src/DeadOptionalArgs.ml @@ -7,6 +7,15 @@ let addFunctionReference ~config ~decls ~cross_file ~(locFrom : Location.t) if active () then let posTo = locTo.loc_start in let posFrom = locFrom.loc_start in + let ownsNonEmptyOptionalArgs pos = + match Declarations.find_opt_builder decls pos with + | Some {declKind = Value {ownsOptionalArgs; optionalArgs}} -> + ownsOptionalArgs && not (OptionalArgs.isEmpty optionalArgs) + | _ -> false + in + let bothOwnNonEmptyOptionalArgs () = + ownsNonEmptyOptionalArgs posFrom && ownsNonEmptyOptionalArgs posTo + in (* 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 @@ -16,47 +25,9 @@ let addFunctionReference ~config ~decls ~cross_file ~(locFrom : Location.t) if fileIsImplementationOf posTo.pos_fname posFrom.pos_fname || fileIsImplementationOf posFrom.pos_fname posTo.pos_fname - then - match Declarations.find_opt_builder decls posTo with - | Some {declKind = Value {ownsOptionalArgs; optionalArgs}} -> - ownsOptionalArgs && not (OptionalArgs.isEmpty optionalArgs) - | _ -> 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 - 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 + then ownsNonEmptyOptionalArgs posTo + else bothOwnNonEmptyOptionalArgs () + else bothOwnNonEmptyOptionalArgs () in if shouldAdd then ( if config.DceConfig.cli.debug then From 8c7342857a074c92778db1d3db90b946da37bbc9 Mon Sep 17 00:00:00 2001 From: Christoph Knittel Date: Tue, 31 Mar 2026 14:06:29 +0200 Subject: [PATCH 4/4] Fix --- analysis/reanalyze/src/DeadOptionalArgs.ml | 25 ++++++++++--------- analysis/reanalyze/src/DeadValue.ml | 22 ++++++++-------- .../deadcode/expected/deadcode.txt | 2 ++ 3 files changed, 25 insertions(+), 24 deletions(-) diff --git a/analysis/reanalyze/src/DeadOptionalArgs.ml b/analysis/reanalyze/src/DeadOptionalArgs.ml index 89facfda34a..c2d350f83b9 100644 --- a/analysis/reanalyze/src/DeadOptionalArgs.ml +++ b/analysis/reanalyze/src/DeadOptionalArgs.ml @@ -7,27 +7,28 @@ let addFunctionReference ~config ~decls ~cross_file ~(locFrom : Location.t) if active () then let posTo = locTo.loc_start in let posFrom = locFrom.loc_start in - let ownsNonEmptyOptionalArgs pos = + let hasNonEmptyOptionalArgs pos = match Declarations.find_opt_builder decls pos with - | Some {declKind = Value {ownsOptionalArgs; optionalArgs}} -> - ownsOptionalArgs && not (OptionalArgs.isEmpty optionalArgs) + | Some {declKind = Value {optionalArgs}} -> + not (OptionalArgs.isEmpty optionalArgs) | _ -> false in - let bothOwnNonEmptyOptionalArgs () = - ownsNonEmptyOptionalArgs posFrom && ownsNonEmptyOptionalArgs posTo + let bothHaveNonEmptyOptionalArgs () = + hasNonEmptyOptionalArgs posFrom && hasNonEmptyOptionalArgs posTo in (* 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. *) + the declaration site that should receive warnings. The alias still needs + optional-arg state so calls through it can propagate back to the owner. *) let shouldAdd = if posTo.pos_fname <> posFrom.pos_fname then if fileIsImplementationOf posTo.pos_fname posFrom.pos_fname || fileIsImplementationOf posFrom.pos_fname posTo.pos_fname - then ownsNonEmptyOptionalArgs posTo - else bothOwnNonEmptyOptionalArgs () - else bothOwnNonEmptyOptionalArgs () + then hasNonEmptyOptionalArgs posTo + else bothHaveNonEmptyOptionalArgs () + else bothHaveNonEmptyOptionalArgs () in if shouldAdd then ( if config.DceConfig.cli.debug then @@ -77,8 +78,8 @@ let addReferences ~config ~decls ~cross_file ~(locFrom : Location.t) 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) + | Some {declKind = Value {optionalArgs}} -> + not (OptionalArgs.isEmpty optionalArgs) | _ -> false in if shouldAdd then ( @@ -97,7 +98,7 @@ let addReferences ~config ~decls ~cross_file ~(locFrom : Location.t) Uses optional_args_state map for final computed state. *) let check ~optional_args_state ~ann_store ~config:_ decl : Issue.t list = match decl with - | {Decl.declKind = Value {optionalArgs}} + | {Decl.declKind = Value {ownsOptionalArgs = true; optionalArgs}} when active () && not (AnnotationStore.is_annotated_gentype_or_live ann_store decl.pos) diff --git a/analysis/reanalyze/src/DeadValue.ml b/analysis/reanalyze/src/DeadValue.ml index 876784def95..ff747f171c9 100644 --- a/analysis/reanalyze/src/DeadValue.ml +++ b/analysis/reanalyze/src/DeadValue.ml @@ -32,14 +32,14 @@ let collectValueBinding ~config ~decls ~file ~(current_binding : Location.t) 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. *) + warnings should stay attached to the declaration site while usage state + still propagates through the alias. *) let ownsOptionalArgs = match vb.vb_expr.exp_desc with | Texp_function _ -> true @@ -128,15 +128,13 @@ 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 = + let suppressOptionalArgOwnership pos = match Declarations.find_opt_builder decls pos with - | Some ({declKind = Value ({optionalArgs; _} as value_kind)} as decl) - when not (OptionalArgs.isEmpty optionalArgs) -> + | Some + ({declKind = Value ({ownsOptionalArgs = true} as value_kind)} as decl) + -> Declarations.replace_builder decls pos - { - decl with - declKind = Value {value_kind with optionalArgs = OptionalArgs.empty}; - } + {decl with declKind = Value {value_kind with ownsOptionalArgs = false}} | _ -> () in let rec remove_first target = function @@ -166,8 +164,8 @@ let rec collectExpr ~config ~decls ~refs ~file_deps ~cross_file ~callee_locs else ( addValueReference ~config ~refs ~file_deps ~binding ~addFileReference:true ~locFrom ~locTo; - if not (List.mem locFrom !callee_locs) then - suppressOptionalArgs locTo.loc_start) + if binding = Location.none && not (List.mem locFrom !callee_locs) then + suppressOptionalArgOwnership locTo.loc_start) | Texp_apply { funct = diff --git a/tests/analysis_tests/tests-reanalyze/deadcode/expected/deadcode.txt b/tests/analysis_tests/tests-reanalyze/deadcode/expected/deadcode.txt index 0be5132d2fe..4d54113f35c 100644 --- a/tests/analysis_tests/tests-reanalyze/deadcode/expected/deadcode.txt +++ b/tests/analysis_tests/tests-reanalyze/deadcode/expected/deadcode.txt @@ -59,11 +59,13 @@ addValueDeclaration +dispatchNotification ContextOptionalArgs.res:28:8 path:+ContextOptionalArgs.ComponentUsingAction addValueReference ContextOptionalArgs.res:28:8 --> ContextOptionalArgs.res:22:6 addValueReference ContextOptionalArgs.res:35:4 --> React.res:3:0 + DeadOptionalArgs.addReferences dispatchNotification called with optional argNames:action argNamesMaybe: ContextOptionalArgs.res:31:6 addValueReference ContextOptionalArgs.res:31:6 --> ContextOptionalArgs.res:28:8 addValueReference ContextOptionalArgs.res:30:4 --> React.res:150:0 addValueDeclaration +dispatchNotification ContextOptionalArgs.res:42:8 path:+ContextOptionalArgs.ComponentNotUsingAction addValueReference ContextOptionalArgs.res:42:8 --> ContextOptionalArgs.res:22:6 addValueReference ContextOptionalArgs.res:49:4 --> React.res:3:0 + DeadOptionalArgs.addReferences dispatchNotification called with optional argNames: argNamesMaybe: ContextOptionalArgs.res:45:6 addValueReference ContextOptionalArgs.res:45:6 --> ContextOptionalArgs.res:42:8 addValueReference ContextOptionalArgs.res:44:4 --> React.res:150:0 addValueReference ContextOptionalArgs.res:56:3 --> ContextOptionalArgs.res:12:6