From 39a110e80196af3ab0dc53f1cfd735ef78cbfd8a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Mon, 10 Jun 2024 14:45:48 +0200 Subject: [PATCH] Reset uid counter when restoring the typer's state This ensures UIDs are stable between edits. Since some table use uids as keys, we have to clean them properly. This is done using the Stamped_hashtable datastructure introduced in 147f0c3 --- src/kernel/mtyper.ml | 43 ++++--- src/ocaml/typing/env.ml | 110 +++++++++++------- src/ocaml/typing/env.mli | 1 + src/ocaml/typing/shape.ml | 9 +- src/ocaml/typing/shape.mli | 3 + src/utils/stamped_hashtable.ml | 8 ++ src/utils/stamped_hashtable.mli | 7 ++ .../server-tests/pwo-uid-stability.t | 92 ++++----------- tests/test-dirs/server-tests/stable-uids.t | 28 +++++ .../server-tests/warnings/backtrack.t | 40 +++++++ 10 files changed, 215 insertions(+), 126 deletions(-) create mode 100644 tests/test-dirs/server-tests/stable-uids.t diff --git a/src/kernel/mtyper.ml b/src/kernel/mtyper.ml index 369e204347..47c0a477d2 100644 --- a/src/kernel/mtyper.ml +++ b/src/kernel/mtyper.ml @@ -25,6 +25,7 @@ type ('p,'t) item = { typedtree_items: 't list * Types.signature_item list; part_snapshot : Types.snapshot; part_stamp : int; + part_uid : int; part_env : Env.t; part_errors : exn list; part_checks : Typecore.delayed_check list; @@ -49,6 +50,7 @@ type 'a cache_result = { env : Env.t; snapshot : Types.snapshot; ident_stamp : int; + uid_stamp : int; value : 'a; index : (Shape.Uid.t * Longident.t Location.loc, unit) Stamped_hashtable.t; } @@ -60,15 +62,16 @@ let fresh_env config = let env0 = Extension.register Mconfig.(config.merlin.extensions) env0 in let snap0 = Btype.snapshot () in let stamp0 = Ident.get_currentstamp () in - (env0, snap0, stamp0) + let uid0 = Shape.Uid.get_current_stamp () in + (env0, snap0, stamp0, uid0) let get_cache config = match !cache with | Some ({ snapshot; _ } as c) when Types.is_valid snapshot -> c | Some _ | None -> - let env, snapshot, ident_stamp = fresh_env config in + let env, snapshot, ident_stamp, uid_stamp = fresh_env config in let index = Stamped_hashtable.create !index_changelog 256 in - { env; snapshot; ident_stamp; value = None; index } + { env; snapshot; ident_stamp; uid_stamp; value = None; index } let return_and_cache status = cache := Some ({ status with value = Some status.value }); @@ -80,6 +83,7 @@ type result = { initial_snapshot : Types.snapshot; initial_stamp : int; stamp : int; + initial_uid_stamp : int; typedtree : typedtree_items; index : (Shape.Uid.t * Longident.t Location.loc, unit) Stamped_hashtable.t; cache_stat : typer_cache_stats @@ -116,6 +120,7 @@ let rec type_structure caught env = function parsetree_item; typedtree_items; part_env; part_snapshot = Btype.snapshot (); part_stamp = Ident.get_currentstamp (); + part_uid = Shape.Uid.get_current_stamp (); part_errors = !caught; part_checks = !Typecore.delayed_checks; part_warnings = Warnings.backup (); @@ -131,6 +136,7 @@ let rec type_signature caught env = function parsetree_item; typedtree_items = (sig_items, sig_type); part_env; part_snapshot = Btype.snapshot (); part_stamp = Ident.get_currentstamp (); + part_uid = Shape.Uid.get_current_stamp (); part_errors = !caught; part_checks = !Typecore.delayed_checks; part_warnings = Warnings.backup (); @@ -139,24 +145,28 @@ let rec type_signature caught env = function | [] -> [] let type_implementation config caught parsetree = - let { env; snapshot; ident_stamp; value = prefix; index; _ } = get_cache config in + let { env; snapshot; ident_stamp; uid_stamp; value = prefix; index; _ } = + get_cache config + in let prefix, parsetree, cache_stats = match prefix with | Some (`Implementation items) -> compatible_prefix items parsetree | Some (`Interface _) | None -> ([], parsetree, Miss) in - let env', snap', stamp', warn' = match prefix with - | [] -> (env, snapshot, ident_stamp, Warnings.backup ()) + let env', snap', stamp', uid_stamp', warn' = match prefix with + | [] -> (env, snapshot, ident_stamp, uid_stamp, Warnings.backup ()) | x :: _ -> caught := x.part_errors; Typecore.delayed_checks := x.part_checks; - (x.part_env, x.part_snapshot, x.part_stamp, x.part_warnings) + (x.part_env, x.part_snapshot, x.part_stamp, x.part_uid, x.part_warnings) in Btype.backtrack snap'; Warnings.restore warn'; Env.cleanup_functor_caches ~stamp:stamp'; let stamp = List.length prefix - 1 in Stamped_hashtable.backtrack !index_changelog ~stamp; + Env.cleanup_usage_tables ~stamp:uid_stamp'; + Shape.Uid.restore_stamp uid_stamp'; let suffix = type_structure caught env' parsetree in let () = List.iteri ~f:(fun i { typedtree_items = (items, _); _ } -> @@ -164,27 +174,32 @@ let type_implementation config caught parsetree = !index_items ~index ~stamp config (`Impl items)) suffix in let value = `Implementation (List.rev_append prefix suffix) in - return_and_cache { env; snapshot; ident_stamp; value; index }, cache_stats + return_and_cache { env; snapshot; ident_stamp; uid_stamp; value; index }, + cache_stats let type_interface config caught parsetree = - let { env; snapshot; ident_stamp; value = prefix; index; _ } = get_cache config in + let { env; snapshot; ident_stamp; uid_stamp; value = prefix; index; _ } = + get_cache config + in let prefix, parsetree, cache_stats = match prefix with | Some (`Interface items) -> compatible_prefix items parsetree | Some (`Implementation _) | None -> ([], parsetree, Miss) in - let env', snap', stamp', warn' = match prefix with - | [] -> (env, snapshot, ident_stamp, Warnings.backup ()) + let env', snap', stamp', uid_stamp', warn' = match prefix with + | [] -> (env, snapshot, ident_stamp, uid_stamp, Warnings.backup ()) | x :: _ -> caught := x.part_errors; Typecore.delayed_checks := x.part_checks; - (x.part_env, x.part_snapshot, x.part_stamp, x.part_warnings) + (x.part_env, x.part_snapshot, x.part_stamp, x.part_uid, x.part_warnings) in Btype.backtrack snap'; Warnings.restore warn'; Env.cleanup_functor_caches ~stamp:stamp'; let stamp = List.length prefix in Stamped_hashtable.backtrack !index_changelog ~stamp; + Env.cleanup_usage_tables ~stamp:uid_stamp'; + Shape.Uid.restore_stamp uid_stamp'; let suffix = type_signature caught env' parsetree in let () = List.iteri ~f:(fun i { typedtree_items = (items, _); _ } -> @@ -192,7 +207,8 @@ let type_interface config caught parsetree = !index_items ~index ~stamp config (`Intf items)) suffix in let value = `Interface (List.rev_append prefix suffix) in - return_and_cache { env; snapshot; ident_stamp; value; index}, cache_stats + return_and_cache { env; snapshot; ident_stamp; uid_stamp; value; index}, + cache_stats let run config parsetree = if not (Env.check_state_consistency ()) then ( @@ -219,6 +235,7 @@ let run config parsetree = initial_snapshot = cached_result.snapshot; initial_stamp = cached_result.ident_stamp; stamp; + initial_uid_stamp = cached_result.uid_stamp; typedtree = cached_result.value; index = cached_result.index; cache_stat; diff --git a/src/ocaml/typing/env.ml b/src/ocaml/typing/env.ml index 4beeb037d1..1e52f6dd33 100644 --- a/src/ocaml/typing/env.ml +++ b/src/ocaml/typing/env.ml @@ -28,7 +28,7 @@ module String = Misc.String let add_delayed_check_forward = ref (fun _ -> assert false) -type 'a usage_tbl = ('a -> unit) Types.Uid.Tbl.t +type 'a usage_tbl = (Uid.t, ('a -> unit)) Stamped_hashtable.t (** This table is used to track usage of value declarations. A declaration is identified by its uid. The callback attached to a declaration is called whenever the value (or @@ -36,9 +36,18 @@ type 'a usage_tbl = ('a -> unit) Types.Uid.Tbl.t (inclusion test between signatures, cf Includemod.value_descriptions, ...). *) -let value_declarations : unit usage_tbl ref = s_table Types.Uid.Tbl.create 16 -let type_declarations : unit usage_tbl ref = s_table Types.Uid.Tbl.create 16 -let module_declarations : unit usage_tbl ref = s_table Types.Uid.Tbl.create 16 +let local_stamped n : Stamped_hashtable.changelog * ('a usage_tbl) = + let changelog = Stamped_hashtable.create_changelog () in + changelog, Stamped_hashtable.create changelog n + +let stamped_value_declarations = s_table local_stamped 32 +let value_declarations_changelog, value_declarations = !stamped_value_declarations + +let stamped_type_declarations = s_table local_stamped 32 +let type_declarations_changelog, type_declarations = !stamped_type_declarations + +let stamped_module_declarations = s_table local_stamped 32 +let module_declarations_changelog, module_declarations = !stamped_module_declarations type constructor_usage = Positive | Pattern | Exported_private | Exported type constructor_usages = @@ -74,8 +83,8 @@ let constructor_usage_complaint ~rebind priv cu | false, false, true -> Some Only_exported_private end -let used_constructors : constructor_usage usage_tbl ref = - s_table Types.Uid.Tbl.create 16 +let stamped_used_constructors = s_table local_stamped 32 +let used_constructors_changelog, used_constructors = !stamped_used_constructors type label_usage = Projection | Mutation | Construct | Exported_private | Exported @@ -124,8 +133,8 @@ let label_usage_complaint priv mut lu | true, false, _ -> Some Not_mutated end -let used_labels : label_usage usage_tbl ref = - s_table Types.Uid.Tbl.create 16 +let stamped_used_labels = s_table local_stamped 32 +let used_labels_changelog, used_labels = !stamped_used_labels (** Map indexed by the name of module components. *) module NameMap = String.Map @@ -509,7 +518,7 @@ let in_signature_flag = 0x01 let stamped_changelog = s_table Stamped_hashtable.create_changelog () -let stamped_add table path value = +let stamped_path_add table path value = let rec path_stamp = function | Pident id -> Ident.stamp id | Pdot (t, _) -> path_stamp t @@ -520,11 +529,15 @@ let stamped_add table path value = let stamp = if stamp = 0 then None else Some stamp in Stamped_hashtable.add table ?stamp path value -let stamped_mem table path = - Stamped_hashtable.mem table path +let stamped_uid_add table uid value = + let stamp = Types.Uid.stamp_of_uid uid in + Stamped_hashtable.add table ?stamp uid value -let stamped_find table path = - Stamped_hashtable.find table path +let stamped_mem table value = + Stamped_hashtable.mem table value + +let stamped_find table value = + Stamped_hashtable.find table value let stamped_create n = Stamped_hashtable.create !stamped_changelog n @@ -1009,11 +1022,11 @@ let register_import_as_opaque modname = Persistent_env.register_import_as_opaque !persistent_env modname let reset_declaration_caches () = - Types.Uid.Tbl.clear !value_declarations; - Types.Uid.Tbl.clear !type_declarations; - Types.Uid.Tbl.clear !module_declarations; - Types.Uid.Tbl.clear !used_constructors; - Types.Uid.Tbl.clear !used_labels; + Stamped_hashtable.clear value_declarations; + Stamped_hashtable.clear type_declarations; + Stamped_hashtable.clear module_declarations; + Stamped_hashtable.clear used_constructors; + Stamped_hashtable.clear used_labels; () let reset_cache () = @@ -1060,7 +1073,7 @@ let modtype_of_functor_appl fcomp p1 p2 = in Subst.modtype (Rescope scope) subst mty in - stamped_add fcomp.fcomp_subst_cache p2 mty; + stamped_path_add fcomp.fcomp_subst_cache p2 mty; mty let check_functor_appl @@ -1986,9 +1999,9 @@ and check_usage loc id uid warn tbl = Warnings.is_active (warn "") then begin let name = Ident.name id in - if Types.Uid.Tbl.mem tbl uid then () + if stamped_mem tbl uid then () else let used = ref false in - Types.Uid.Tbl.add tbl uid (fun () -> used := true); + stamped_uid_add tbl uid (fun () -> used := true); if not (name = "" || name.[0] = '_' || name.[0] = '#') then !add_delayed_check_forward @@ -2009,7 +2022,7 @@ and store_value ?check id addr decl shape env = check_value_name (Ident.name id) decl.val_loc; Builtin_attributes.mark_alerts_used decl.val_attributes; Option.iter - (fun f -> check_usage decl.val_loc id decl.val_uid f !value_declarations) + (fun f -> check_usage decl.val_loc id decl.val_uid f value_declarations) check; let vda = { vda_description = decl; @@ -2030,9 +2043,9 @@ and store_constructor ~check type_decl type_id cstr_id cstr env = let loc = cstr.cstr_loc in let k = cstr.cstr_uid in let priv = type_decl.type_private in - if not (Types.Uid.Tbl.mem !used_constructors k) then begin + if not (stamped_mem used_constructors k) then begin let used = constructor_usages () in - Types.Uid.Tbl.add !used_constructors k + stamped_uid_add used_constructors k (add_constructor_usage used); if not (ty_name = "" || ty_name.[0] = '_') then @@ -2066,9 +2079,9 @@ and store_label ~check type_decl type_id lbl_id lbl env = let loc = lbl.lbl_loc in let mut = lbl.lbl_mut in let k = lbl.lbl_uid in - if not (Types.Uid.Tbl.mem !used_labels k) then + if not (stamped_mem used_labels k) then let used = label_usages () in - Types.Uid.Tbl.add !used_labels k + stamped_uid_add used_labels k (add_label_usage used); if not (ty_name = "" || ty_name.[0] = '_' || name.[0] = '_') then !add_delayed_check_forward @@ -2092,7 +2105,7 @@ and store_type ~check ~long_path ~predef id info shape env = if check then check_usage loc id info.type_uid (fun s -> Warnings.Unused_type_declaration s) - !type_declarations; + type_declarations; let descrs, env = let path = Pident id in match info.type_kind with @@ -2166,9 +2179,9 @@ and store_extension ~check ~rebind id addr ext shape env = let is_exception = Path.same ext.ext_type_path Predef.path_exn in let name = cstr.cstr_name in let k = cstr.cstr_uid in - if not (Types.Uid.Tbl.mem !used_constructors k) then begin + if not (stamped_mem used_constructors k) then begin let used = constructor_usages () in - Types.Uid.Tbl.add !used_constructors k + stamped_uid_add used_constructors k (add_constructor_usage used); !add_delayed_check_forward (fun () -> @@ -2190,7 +2203,7 @@ and store_module ?(update_summary=true) ~check let open Subst.Lazy in let loc = md.mdl_loc in Option.iter - (fun f -> check_usage loc id md.mdl_uid f !module_declarations) check; + (fun f -> check_usage loc id md.mdl_uid f module_declarations) check; Builtin_attributes.mark_alerts_used md.mdl_attributes; let alerts = Builtin_attributes.alerts_of_attrs md.mdl_attributes in let comps = @@ -2276,7 +2289,7 @@ let components_of_functor_appl ~loc ~f_path ~f_comp ~arg env = (*???*) env Subst.identity p addr (Subst.Lazy.of_modtype mty) shape in - stamped_add f_comp.fcomp_cache arg comps; + stamped_path_add f_comp.fcomp_cache arg comps; comps (* Define forward functions *) @@ -2722,19 +2735,19 @@ let add_type ~check ?shape id info env = (* Tracking usage *) let mark_module_used uid = - match Types.Uid.Tbl.find !module_declarations uid with + match Stamped_hashtable.find module_declarations uid with | mark -> mark () | exception Not_found -> () let mark_modtype_used _uid = () let mark_value_used uid = - match Types.Uid.Tbl.find !value_declarations uid with + match Stamped_hashtable.find value_declarations uid with | mark -> mark () | exception Not_found -> () let mark_type_used uid = - match Types.Uid.Tbl.find !type_declarations uid with + match Stamped_hashtable.find type_declarations uid with | mark -> mark () | exception Not_found -> () @@ -2744,24 +2757,24 @@ let mark_type_path_used env path = | exception Not_found -> () let mark_constructor_used usage cd = - match Types.Uid.Tbl.find !used_constructors cd.cd_uid with + match stamped_find used_constructors cd.cd_uid with | mark -> mark usage | exception Not_found -> () let mark_extension_used usage ext = - match Types.Uid.Tbl.find !used_constructors ext.ext_uid with + match stamped_find used_constructors ext.ext_uid with | mark -> mark usage | exception Not_found -> () let mark_label_used usage ld = - match Types.Uid.Tbl.find !used_labels ld.ld_uid with + match stamped_find used_labels ld.ld_uid with | mark -> mark usage | exception Not_found -> () let mark_constructor_description_used usage env cstr = let ty_path = Btype.cstr_type_path cstr in mark_type_path_used env ty_path; - match Types.Uid.Tbl.find !used_constructors cstr.cstr_uid with + match stamped_find used_constructors cstr.cstr_uid with | mark -> mark usage | exception Not_found -> () @@ -2772,30 +2785,30 @@ let mark_label_description_used usage env lbl = | _ -> assert false in mark_type_path_used env ty_path; - match Types.Uid.Tbl.find !used_labels lbl.lbl_uid with + match stamped_find used_labels lbl.lbl_uid with | mark -> mark usage | exception Not_found -> () let mark_class_used uid = - match Types.Uid.Tbl.find !type_declarations uid with + match stamped_find type_declarations uid with | mark -> mark () | exception Not_found -> () let mark_cltype_used uid = - match Types.Uid.Tbl.find !type_declarations uid with + match stamped_find type_declarations uid with | mark -> mark () | exception Not_found -> () let set_value_used_callback vd callback = - Types.Uid.Tbl.add !value_declarations vd.val_uid callback + stamped_uid_add value_declarations vd.val_uid callback let set_type_used_callback td callback = if Uid.for_actual_declaration td.type_uid then let old = - try Types.Uid.Tbl.find !type_declarations td.type_uid + try stamped_find type_declarations td.type_uid with Not_found -> ignore in - Types.Uid.Tbl.replace !type_declarations td.type_uid + Stamped_hashtable.replace type_declarations td.type_uid (fun () -> callback old) (* Lookup by name *) @@ -4049,7 +4062,7 @@ and short_paths_functor_components_desc env mpath comp path = Subst.modtype (Rescope (Path.scope (Papply (mpath, path)))) subst f.fcomp_res in - stamped_add f.fcomp_subst_cache path mty; + stamped_path_add f.fcomp_subst_cache path mty; mty in let loc = Location.(in_file !input_name) in @@ -4159,3 +4172,10 @@ let short_paths env = let cleanup_functor_caches ~stamp = Stamped_hashtable.backtrack !stamped_changelog ~stamp + +let cleanup_usage_tables ~stamp = + Stamped_hashtable.backtrack value_declarations_changelog ~stamp; + Stamped_hashtable.backtrack type_declarations_changelog ~stamp; + Stamped_hashtable.backtrack module_declarations_changelog ~stamp; + Stamped_hashtable.backtrack used_constructors_changelog ~stamp; + Stamped_hashtable.backtrack used_labels_changelog ~stamp diff --git a/src/ocaml/typing/env.mli b/src/ocaml/typing/env.mli index 0a052fed3b..aa005a4b82 100644 --- a/src/ocaml/typing/env.mli +++ b/src/ocaml/typing/env.mli @@ -549,3 +549,4 @@ val with_cmis : (unit -> 'a) -> 'a val add_merlin_extension_module: Ident.t -> module_type -> t -> t val cleanup_functor_caches : stamp:int -> unit +val cleanup_usage_tables : stamp:int -> unit diff --git a/src/ocaml/typing/shape.ml b/src/ocaml/typing/shape.ml index 2657058229..1d588c647d 100644 --- a/src/ocaml/typing/shape.ml +++ b/src/ocaml/typing/shape.ml @@ -38,10 +38,17 @@ module Uid = struct print fmt t end) - let id = ref (-1) + let id = Local_store.s_ref (-1) let reinit () = id := (-1) + let get_current_stamp () = !id + let restore_stamp i = id := i + + let stamp_of_uid = function + | Item { id; _ } -> Some id + | _ -> None + let mk ~current_unit = incr id; Item { comp_unit = current_unit; id = !id } diff --git a/src/ocaml/typing/shape.mli b/src/ocaml/typing/shape.mli index 01b31d2575..115cce4596 100644 --- a/src/ocaml/typing/shape.mli +++ b/src/ocaml/typing/shape.mli @@ -62,6 +62,9 @@ module Uid : sig | Predef of string val reinit : unit -> unit + val get_current_stamp : unit -> int + val restore_stamp : int -> unit + val stamp_of_uid : t -> int option val mk : current_unit:string -> t val of_compilation_unit_id : Ident.t -> t diff --git a/src/utils/stamped_hashtable.ml b/src/utils/stamped_hashtable.ml index 538df0a2c9..23b98eb8d5 100644 --- a/src/utils/stamped_hashtable.ml +++ b/src/utils/stamped_hashtable.ml @@ -42,6 +42,9 @@ let add {table; changelog} ?stamp key value = | Some stamp -> changelog.recent <- Cell {stamp; key; table} :: changelog.recent +let replace t k v = + Hashtbl.replace t.table k v + let mem t a = Hashtbl.mem t.table a @@ -51,6 +54,11 @@ let find t a = let fold f t acc = Hashtbl.fold f t.table acc +let clear t = + Hashtbl.clear t.table; + t.changelog.recent <- []; + t.changelog.sorted <- [] + (* Implementation of backtracking *) (* Helper to sort by decreasing stamps *) diff --git a/src/utils/stamped_hashtable.mli b/src/utils/stamped_hashtable.mli index c5950c5173..94140fc5b5 100644 --- a/src/utils/stamped_hashtable.mli +++ b/src/utils/stamped_hashtable.mli @@ -37,9 +37,16 @@ val find : ('a, 'b) t -> 'a -> 'b val fold : ('a -> 'b -> 'acc -> 'acc) -> ('a, 'b) t -> 'acc -> 'acc (** See [Hashtbl.fold]. *) +val clear : ('a, 'b) t -> unit +(** Clear the table and empty the changelog. See [Hashtbl.clear]. *) + val create_changelog : unit -> changelog (** Create a new change log. *) (* [backtrack changelog ~stamp] remove all items added to tables logging to [changelog] with a stamp strictly greater than [stamp] *) val backtrack : changelog -> stamp:int -> unit + +val replace : ('a, 'b) t -> 'a -> 'b -> unit +(** This operation is unsafe in general. Only replacements that does not imply + re-stamping are safe. *) diff --git a/tests/test-dirs/server-tests/pwo-uid-stability.t b/tests/test-dirs/server-tests/pwo-uid-stability.t index 5003d18445..6bbb1dd203 100644 --- a/tests/test-dirs/server-tests/pwo-uid-stability.t +++ b/tests/test-dirs/server-tests/pwo-uid-stability.t @@ -20,23 +20,11 @@ "Lib.z": File "main.ml", line 1, characters 9-14 }, 0 approx shapes: {}, and shapes for CUS . -FIXME: duplicated occurrence + $ $MERLIN server occurrences -identifier-at 3:4 \ > -scope project -index-file .ocaml-index \ - > -log-file log -log-section occurrences \ > -filename lib.ml lib.ml <<'EOF' > let x = () @@ -98,10 +67,9 @@ Now we insert a def before z: "Lib.z": File "main.ml", line 1, characters 9-14 }, 0 approx shapes: {}, and shapes for CUS . -FIXME: We are missing the occurrence in main.ml +We are not missing the occurrence in main.ml $ $MERLIN server occurrences -identifier-at 3:4 \ > -scope project -index-file .ocaml-index \ - > -log-file log -log-section occurrences \ > -filename lib.ml lib.ml <<'EOF' > let x = () > @@ -148,10 +112,9 @@ FIXME: We are missing the occurrence in main.ml "Lib.z": File "main.ml", line 1, characters 9-14 }, 0 approx shapes: {}, and shapes for CUS . -FIXME: we are missing the occurrence in main.ml +We are not missing the occurrence in main.ml $ $MERLIN server occurrences -identifier-at 3:4 \ > -scope project -index-file .ocaml-index \ - > -log-file log -log-section occurrences \ > -filename lib.ml main.ml <<'EOF' + > let x' = 1 + > let x = 41 + > let f x = x + > let y = f x + > EOF + + $ $MERLIN server occurrences -scope local -identifier-at 3:10 \ + > -log-file log_1 -log-section index \ + > -filename main.ml /dev/null + + $ cat >main.ml <<'EOF' + > let x' = 1 + > let x = 42 + > let f x = x + > let y = f x + > EOF + + $ $MERLIN server occurrences -scope local -identifier-at 3:10 \ + > -log-file log_2 -log-section index \ + > -filename main.ml /dev/null + +The uids should be the same on both queries: + $ cat log_1 | grep Found | cat >log_1g + $ cat log_2 | grep Found | cat >log_2g + $ diff log_1g log_2g + + $ $MERLIN server stop-server diff --git a/tests/test-dirs/server-tests/warnings/backtrack.t b/tests/test-dirs/server-tests/warnings/backtrack.t index 99d27a20fa..65003eb30f 100644 --- a/tests/test-dirs/server-tests/warnings/backtrack.t +++ b/tests/test-dirs/server-tests/warnings/backtrack.t @@ -78,4 +78,44 @@ environment in different queries, some warnings will be reported only once. "notifications": [] } + + $ $MERLIN server errors -filename backtrack.ml -w +A < let f x = () + > let g y = () + > EOF + { + "class": "return", + "value": [ + { + "start": { + "line": 1, + "col": 6 + }, + "end": { + "line": 1, + "col": 7 + }, + "type": "warning", + "sub": [], + "valid": true, + "message": "Warning 27: unused variable x." + }, + { + "start": { + "line": 2, + "col": 6 + }, + "end": { + "line": 2, + "col": 7 + }, + "type": "warning", + "sub": [], + "valid": true, + "message": "Warning 27: unused variable y." + } + ], + "notifications": [] + } + $ $MERLIN server stop-server