diff --git a/.github/workflows/build-and-test.yml b/.github/workflows/build-and-test.yml index 1889fd256..eedf8c098 100644 --- a/.github/workflows/build-and-test.yml +++ b/.github/workflows/build-and-test.yml @@ -4,7 +4,7 @@ on: pull_request: push: branches: - - master + - 414-LTS schedule: # Prime the caches every Monday - cron: 0 1 * * MON @@ -21,8 +21,7 @@ jobs: - macos-latest - windows-latest ocaml-compiler: - - "5.2" - + - "4.14" runs-on: ${{ matrix.os }} @@ -59,19 +58,21 @@ jobs: - name: Build and install dependencies run: opam install . - # the makefile explains why we don't use --with-test - # ppx expect is not yet compatible with 5.1 and test output vary from one - # compiler to another. We only test on 4.14. + # the makefile explains why we don't use test dependencies - name: Install test dependencies + if: matrix.ocaml-compiler == '4.14' run: opam exec -- make install-test-deps - name: Run build @all + if: matrix.ocaml-compiler == '4.14' run: opam exec -- make all - name: Run the unit tests + if: matrix.ocaml-compiler == '4.14' run: opam exec -- make test-ocaml - name: Run the template integration tests + if: matrix.ocaml-compiler == '4.14' run: opam exec -- make test-e2e coverage: @@ -86,7 +87,7 @@ jobs: - name: Set-up OCaml uses: ocaml/setup-ocaml@v2 with: - ocaml-compiler: "5.2" + ocaml-compiler: "4.14" allow-prerelease-opam: true - name: Set git user diff --git a/.github/workflows/changelog.yml b/.github/workflows/changelog.yml index bde3332ab..47f05782d 100644 --- a/.github/workflows/changelog.yml +++ b/.github/workflows/changelog.yml @@ -2,7 +2,7 @@ name: Changelog check on: pull_request: - branches: [master] + branches: [414-LTS] types: [opened, synchronize, reopened, labeled, unlabeled] jobs: diff --git a/.github/workflows/nix.yml b/.github/workflows/nix.yml index f770986f6..55d39fe4b 100644 --- a/.github/workflows/nix.yml +++ b/.github/workflows/nix.yml @@ -3,7 +3,7 @@ on: pull_request: push: branches: - - master + - 414-LTS jobs: # tests: # runs-on: ubuntu-latest diff --git a/Makefile b/Makefile index dc89c4c02..11ea0d90e 100644 --- a/Makefile +++ b/Makefile @@ -17,7 +17,7 @@ all: # results in a conflict .PHONY: install-test-deps install-test-deps: - opam install --yes cinaps 'ppx_expect>=v0.17.0' \ + opam install --yes cinaps 'ppx_expect= "v0.14")) (cinaps :with-test) - (ppx_expect (and (>= v0.17.0) :with-test)) + (ppx_expect (and (>= v0.15.0) (< 0.17.0) :with-test)) (uutf (>= 1.0.2)) (odoc :with-doc) (ocaml (>= 4.14)))) @@ -55,21 +55,21 @@ possible and does not make any assumptions about IO. dyn stdune (fiber (and (>= 3.1.1) (< 4.0.0))) - (ocaml (>= 5.2.0)) + (ocaml (and (>= 4.14.0) (< 5.0))) xdg ordering dune-build-info spawn astring camlp-streams - (ppx_expect (and (>= v0.17.0) :with-test)) + (ppx_expect (and (>= v0.15.0) (< 0.17.0) :with-test)) (ocamlformat (and :with-test (= 0.26.2))) (ocamlc-loc (>= 3.7.0)) (pp (>= 1.1.2)) (csexp (>= 1.5)) (ocamlformat-rpc-lib (>= 0.21.0)) (odoc :with-doc) - (merlin-lib (and (>= 5.2) (< 6.0))))) + (merlin-lib (and (>= 4.18) (< 5.0))))) (package (name jsonrpc) diff --git a/flake.lock b/flake.lock index 423919db5..30cec1fec 100644 --- a/flake.lock +++ b/flake.lock @@ -5,11 +5,11 @@ "systems": "systems" }, "locked": { - "lastModified": 1726560853, - "narHash": "sha256-X6rJYSESBVr3hBoH0WbKE5KvhPU5bloyZ2L4K60/fPQ=", + "lastModified": 1731533236, + "narHash": "sha256-l0KFg5HjrsfsO/JpG+r7fRrqm12kzFHyUHqHCVpMMbI=", "owner": "numtide", "repo": "flake-utils", - "rev": "c1dfcf08411b08f6b8615f7d8971a2bfa81d5e8a", + "rev": "11707dc2f618dd54ca8739b309ec4fc024de578b", "type": "github" }, "original": { @@ -18,98 +18,43 @@ "type": "github" } }, - "flake-utils_2": { - "inputs": { - "systems": "systems_2" - }, - "locked": { - "lastModified": 1726560853, - "narHash": "sha256-X6rJYSESBVr3hBoH0WbKE5KvhPU5bloyZ2L4K60/fPQ=", - "owner": "numtide", - "repo": "flake-utils", - "rev": "c1dfcf08411b08f6b8615f7d8971a2bfa81d5e8a", - "type": "github" - }, - "original": { - "owner": "numtide", - "repo": "flake-utils", - "type": "github" - } - }, - "merlin5_1": { - "flake": false, - "locked": { - "lastModified": 1727427299, - "narHash": "sha256-P9+3BPBWrulS/1r03CqMdicFcgEcLK1Gy7pCAcYt3n4=", - "owner": "ocaml", - "repo": "merlin", - "rev": "650a7865bc37a646250f7c52fa6644d9d4a5218b", - "type": "github" - }, - "original": { - "owner": "ocaml", - "ref": "501", - "repo": "merlin", - "type": "github" - } - }, - "merlin5_2": { + "merlin4_14": { "flake": false, "locked": { - "lastModified": 1727427098, - "narHash": "sha256-ijy7MvHaVOyj99I4M7jqqollbou3ilzcWUctJCuLES4=", + "lastModified": 1732638333, + "narHash": "sha256-5v7VB6D/5upS3YRMyqIKBOP1QOUi5oHTiWKj7APkiFc=", "owner": "ocaml", "repo": "merlin", - "rev": "0eaccc1b8520d605b1e00685e1c3f8acb5da534c", + "rev": "2b9cd21c24a687ca4dc6d0a191942b13903eae82", "type": "github" }, "original": { "owner": "ocaml", - "ref": "main", + "ref": "v4.18-414", "repo": "merlin", "type": "github" } }, "nixpkgs": { - "inputs": { - "flake-utils": "flake-utils_2", - "nixpkgs": "nixpkgs_2" - }, - "locked": { - "lastModified": 1727603600, - "narHash": "sha256-bffkUWgbvlDEXPR0QUyHKPuI1FdMmIZvRwIWPP14SYQ=", - "owner": "nix-ocaml", - "repo": "nix-overlays", - "rev": "b5c11f8e03530ab94cd251871bd1a0abcf7bef54", - "type": "github" - }, - "original": { - "owner": "nix-ocaml", - "repo": "nix-overlays", - "type": "github" - } - }, - "nixpkgs_2": { "locked": { - "lastModified": 1727552795, - "narHash": "sha256-IZJVvM+8Jwk8RgWygbfAZ7mnLk0DxGI/2HBDSNxCIio=", - "owner": "NixOS", + "lastModified": 1732617236, + "narHash": "sha256-PYkz6U0bSEaEB1al7O1XsqVNeSNS+s3NVclJw7YC43w=", + "owner": "nixos", "repo": "nixpkgs", - "rev": "602fb03c3a4aaeb33ea15ae1c921325c593531b1", + "rev": "af51545ec9a44eadf3fe3547610a5cdd882bc34e", "type": "github" }, "original": { - "owner": "NixOS", + "owner": "nixos", + "ref": "nixpkgs-unstable", "repo": "nixpkgs", - "rev": "602fb03c3a4aaeb33ea15ae1c921325c593531b1", "type": "github" } }, "root": { "inputs": { "flake-utils": "flake-utils", - "merlin5_1": "merlin5_1", - "merlin5_2": "merlin5_2", + "merlin4_14": "merlin4_14", "nixpkgs": "nixpkgs" } }, @@ -127,21 +72,6 @@ "repo": "default", "type": "github" } - }, - "systems_2": { - "locked": { - "lastModified": 1681028828, - "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", - "owner": "nix-systems", - "repo": "default", - "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", - "type": "github" - }, - "original": { - "owner": "nix-systems", - "repo": "default", - "type": "github" - } } }, "root": "root", diff --git a/flake.nix b/flake.nix index 348068892..53888938a 100644 --- a/flake.nix +++ b/flake.nix @@ -1,13 +1,9 @@ { inputs = { flake-utils.url = "github:numtide/flake-utils"; - nixpkgs.url = "github:nix-ocaml/nix-overlays"; - merlin5_2 = { - url = "github:ocaml/merlin/main"; - flake = false; - }; - merlin5_1 = { - url = "github:ocaml/merlin/501"; + nixpkgs.url = "github:nixos/nixpkgs/nixpkgs-unstable"; + merlin4_14 = { + url = "github:ocaml/merlin/v4.18-414"; flake = false; }; }; @@ -30,7 +26,7 @@ }); dune-release = prev.dune-release.overrideAttrs (_: { doCheck = false; }); - ocamlPackages = prev.ocamlPackages.overrideScope' (oself: osuper: + ocamlPackages = prev.ocamlPackages.overrideScope (oself: osuper: let fixPreBuild = o: { propagatedBuildInputs = o.propagatedBuildInputs ++ [ oself.pp ]; @@ -58,13 +54,11 @@ in rec { jsonrpc = buildDunePackage (basePackage // { pname = "jsonrpc"; - doCheck = false; propagatedBuildInputs = with pkgs.ocamlPackages; [ ]; }); lsp = buildDunePackage (basePackage // { pname = "lsp"; - doCheck = false; propagatedBuildInputs = with pkgs.ocamlPackages; [ jsonrpc yojson @@ -72,19 +66,12 @@ uutf ]; checkInputs = let p = pkgs.ocamlPackages; - in [ - p.stdune - p.cinaps - p.ppx_expect - p.ppx_yojson_conv - (ocamlformat pkgs) - ]; + in [ p.cinaps p.ppx_expect p.ppx_yojson_conv (ocamlformat pkgs) ]; }); ocaml-lsp = with pkgs.ocamlPackages; buildDunePackage (basePackage // { pname = package; - doCheck = false; checkInputs = let p = pkgs.ocamlPackages; in [ p.ppx_expect @@ -137,29 +124,20 @@ overlays = [ (ocamlVersionOverlay ocaml) (overlay merlin) ]; inherit system; }; - pkgs_5_1 = - makeNixpkgs (ocaml: ocaml.ocamlPackages_5_1) inputs.merlin5_1; - pkgs_5_2 = - makeNixpkgs (ocaml: ocaml.ocamlPackages_5_2) inputs.merlin5_2; - localPackages_5_1 = makeLocalPackages pkgs_5_1; - localPackages_5_2 = makeLocalPackages pkgs_5_2; + pkgs_4_14 = + makeNixpkgs (ocaml: ocaml.ocamlPackages_4_14) inputs.merlin4_14; + localPackages_4_14 = makeLocalPackages pkgs_4_14; devShell = localPackages: nixpkgs: nixpkgs.mkShell { buildInputs = [ nixpkgs.ocamlPackages.utop ]; - inputsFrom = - builtins.map (x: x.overrideAttrs (p: n: { doCheck = true; })) - (builtins.attrValues localPackages); + inputsFrom = builtins.attrValues localPackages; }; in { - packages = (localPackages_5_2 // { - default = localPackages_5_2.ocaml-lsp; - ocaml_5_1 = localPackages_5_1; - }); + packages = + (localPackages_4_14 // { default = localPackages_4_14.ocaml-lsp; }); devShells = { - default = devShell localPackages_5_2 pkgs_5_2; - - ocaml5_1 = devShell localPackages_5_1 pkgs_5_1; + default = devShell localPackages_4_14 pkgs_4_14; release = pkgsWithoutOverlays.mkShell { buildInputs = [ pkgsWithoutOverlays.dune-release ]; @@ -176,8 +154,8 @@ ]; }; - check = pkgs_5_2.mkShell { - inputsFrom = builtins.attrValues localPackages_5_2; + check = pkgs_4_14.mkShell { + inputsFrom = builtins.attrValues localPackages_4_14; }; }; })); diff --git a/jsonrpc-fiber/test/dune b/jsonrpc-fiber/test/dune index e360e22df..22392de46 100644 --- a/jsonrpc-fiber/test/dune +++ b/jsonrpc-fiber/test/dune @@ -12,7 +12,7 @@ jsonrpc_fiber ;; This is because of the (implicit_transitive_deps false) ;; in dune-project - ppx_expect + ppx_expect.common ppx_expect.config ppx_expect.config_types ppx_inline_test.config diff --git a/lsp-fiber/test/dune b/lsp-fiber/test/dune index 150c99bb4..f3bf169f8 100644 --- a/lsp-fiber/test/dune +++ b/lsp-fiber/test/dune @@ -19,7 +19,7 @@ lsp_fiber ;; This is because of the (implicit_transitive_deps false) ;; in dune-project - ppx_expect + ppx_expect.common ppx_expect.config ppx_expect.config_types ppx_inline_test.config diff --git a/lsp.opam b/lsp.opam index 4aadd460f..5d4117cff 100644 --- a/lsp.opam +++ b/lsp.opam @@ -28,7 +28,7 @@ depends: [ "yojson" "ppx_yojson_conv_lib" {>= "v0.14"} "cinaps" {with-test} - "ppx_expect" {>= "v0.17.0" & with-test} + "ppx_expect" {>= "v0.15.0" & < "0.17.0" & with-test} "uutf" {>= "1.0.2"} "odoc" {with-doc} "ocaml" {>= "4.14"} diff --git a/lsp/test/dune b/lsp/test/dune index 1156aae86..f8262452e 100644 --- a/lsp/test/dune +++ b/lsp/test/dune @@ -11,7 +11,7 @@ ;; This is because of the (implicit_transitive_deps false) ;; in dune-project base - ppx_expect + ppx_expect.common ppx_expect.config ppx_expect.config_types ppx_inline_test.config) diff --git a/ocaml-lsp-server.opam b/ocaml-lsp-server.opam index 9651f1fa2..3c07f2bad 100644 --- a/ocaml-lsp-server.opam +++ b/ocaml-lsp-server.opam @@ -31,21 +31,21 @@ depends: [ "dyn" "stdune" "fiber" {>= "3.1.1" & < "4.0.0"} - "ocaml" {>= "5.2.0"} + "ocaml" {>= "4.14.0" & < "5.0"} "xdg" "ordering" "dune-build-info" "spawn" "astring" "camlp-streams" - "ppx_expect" {>= "v0.17.0" & with-test} + "ppx_expect" {>= "v0.15.0" & < "0.17.0" & with-test} "ocamlformat" {with-test & = "0.26.2"} "ocamlc-loc" {>= "3.7.0"} "pp" {>= "1.1.2"} "csexp" {>= "1.5"} "ocamlformat-rpc-lib" {>= "0.21.0"} "odoc" {with-doc} - "merlin-lib" {>= "5.2" & < "6.0"} + "merlin-lib" {>= "4.18" & < "5.0"} ] dev-repo: "git+https://github.com/ocaml/ocaml-lsp.git" build: [ diff --git a/ocaml-lsp-server/src/code_actions/action_add_rec.ml b/ocaml-lsp-server/src/code_actions/action_add_rec.ml index 5ecc37849..f064daf39 100644 --- a/ocaml-lsp-server/src/code_actions/action_add_rec.ml +++ b/ocaml-lsp-server/src/code_actions/action_add_rec.ml @@ -6,7 +6,7 @@ let action_title = "Add missing `rec` keyword" let let_bound_vars bindings = List.filter_map bindings ~f:(fun vb -> match vb.Typedtree.vb_pat.pat_desc with - | Typedtree.Tpat_var (id, loc, _) -> Some (id, loc) + | Typedtree.Tpat_var (id, loc) -> Some (id, loc) | _ -> None) ;; diff --git a/ocaml-lsp-server/src/code_actions/action_extract.ml b/ocaml-lsp-server/src/code_actions/action_extract.ml index 00358f213..bc8e9f032 100644 --- a/ocaml-lsp-server/src/code_actions/action_extract.ml +++ b/ocaml-lsp-server/src/code_actions/action_extract.ml @@ -74,7 +74,7 @@ let tightest_enclosing_binder_position typedtree range = | Texp_letexception (_, body) | Texp_open (_, body) -> found_if_expr_contains body | Texp_letop { body; _ } -> found_if_case_contains [ body ] - | Texp_function (_, Tfunction_cases { cases; _ }) -> found_if_case_contains cases + | Texp_function { cases; _ } -> found_if_case_contains cases | Texp_match (_, cases, _) -> found_if_case_contains cases | Texp_try (_, cases) -> found_if_case_contains cases | _ -> ()) diff --git a/ocaml-lsp-server/src/code_actions/action_inline.ml b/ocaml-lsp-server/src/code_actions/action_inline.ml index 6114ce5dd..b384ce2c1 100644 --- a/ocaml-lsp-server/src/code_actions/action_inline.ml +++ b/ocaml-lsp-server/src/code_actions/action_inline.ml @@ -66,7 +66,7 @@ let find_inline_task typedtree pos = match expr.exp_desc with | Texp_let ( Nonrecursive - , [ { vb_pat = { pat_desc = Tpat_var (inlined_var, { loc; _ }, _); _ } + , [ { vb_pat = { pat_desc = Tpat_var (inlined_var, { loc; _ }); _ } ; vb_expr = inlined_expr ; _ } @@ -81,7 +81,7 @@ let find_inline_task typedtree pos = match item.str_desc with | Tstr_value ( Nonrecursive - , [ { vb_pat = { pat_desc = Tpat_var (inlined_var, { loc; _ }, _); _ } + , [ { vb_pat = { pat_desc = Tpat_var (inlined_var, { loc; _ }); _ } ; vb_expr = inlined_expr ; _ } @@ -137,11 +137,44 @@ let strip_attribute attr_name expr = mapper.expr mapper expr ;; +(** Overapproximation of the number of uses of a [Path.t] in an expression. *) +module Uses : sig + type t + + val find : t -> Path.t -> int option + val of_typedtree : Typedtree.expression -> t +end = struct + type t = int Path.Map.t + + let find m k = Path.Map.find_opt k m + + let of_typedtree (expr : Typedtree.expression) = + let module I = Ocaml_typing.Tast_iterator in + let uses = ref Path.Map.empty in + let expr_iter (iter : I.iterator) (expr : Typedtree.expression) = + match expr.exp_desc with + | Texp_ident (path, _, _) -> + uses + := Path.Map.update + path + (function + | Some c -> Some (c + 1) + | None -> Some 1) + !uses + | _ -> I.default_iterator.expr iter expr + in + let iterator = { I.default_iterator with expr = expr_iter } in + iterator.expr iterator expr; + !uses + ;; +end + (** Mapping from [Location.t] to [Path.t]. Computed from the typedtree. Useful for determining whether two parsetree identifiers refer to the same path. *) module Paths : sig type t + val find : t -> Loc.t -> Path.t option val of_typedtree : Typedtree.expression -> t val same_path : t -> Loc.t -> Loc.t -> bool end = struct @@ -159,8 +192,8 @@ end = struct in let pat_iter (type k) (iter : I.iterator) (pat : k Typedtree.general_pattern) = match pat.pat_desc with - | Tpat_var (id, { loc; _ }, _) -> paths := Loc.Map.set !paths loc (Pident id) - | Tpat_alias (pat, id, { loc; _ }, _) -> + | Tpat_var (id, { loc; _ }) -> paths := Loc.Map.set !paths loc (Pident id) + | Tpat_alias (pat, id, { loc; _ }) -> paths := Loc.Map.set !paths loc (Pident id); I.default_iterator.pat iter pat | _ -> I.default_iterator.pat iter pat @@ -189,7 +222,7 @@ let subst same subst_expr subst_id body = ;; (** Rough check for expressions that can be duplicated without duplicating any - side effects (or introducing a sigificant performance difference). *) + side effects. *) let rec is_pure (expr : Parsetree.expression) = match expr.pexp_desc with | Pexp_ident _ | Pexp_constant _ | Pexp_unreachable -> true @@ -197,50 +230,69 @@ let rec is_pure (expr : Parsetree.expression) = | _ -> false ;; -let all_unlabeled_params = - List.for_all ~f:(fun p -> - match p.Parsetree.pparam_desc with - | Pparam_val (Nolabel, _, _) -> true - | _ -> false) -;; - -let same_path paths (id : _ H.with_loc) (id' : _ H.with_loc) = - Paths.same_path paths id.loc id'.loc +let rec find_map_remove ~f = function + | [] -> None, [] + | x :: xs -> + (match f x with + | Some x' -> Some x', xs + | None -> + let ret, xs' = find_map_remove ~f xs in + ret, x :: xs') ;; -let beta_reduce (paths : Paths.t) (app : Parsetree.expression) = - let rec beta_reduce_arg body (pat : Parsetree.pattern) arg = - let with_let () = H.Exp.let_ Nonrecursive [ H.Vb.mk pat arg ] body in - let with_subst param = subst (same_path paths) arg param body in +let rec beta_reduce (uses : Uses.t) (paths : Paths.t) (app : Parsetree.expression) = + let rec beta_reduce_arg (pat : Parsetree.pattern) body arg = + let default () = + H.Exp.let_ Nonrecursive [ H.Vb.mk pat arg ] (beta_reduce uses paths body) + in match pat.ppat_desc with | Ppat_any | Ppat_construct ({ txt = Lident "()"; _ }, _) -> - if is_pure arg then body else with_let () + beta_reduce uses paths body | Ppat_var param | Ppat_constraint ({ ppat_desc = Ppat_var param; _ }, _) -> - if is_pure arg then with_subst param else with_let () + let open Option.O in + let m_uses = + let* path = Paths.find paths param.loc in + Uses.find uses path + in + let same_path paths (id : _ H.with_loc) (id' : _ H.with_loc) = + Paths.same_path paths id.loc id'.loc + in + (match m_uses with + | Some 0 -> beta_reduce uses paths body + | Some 1 -> beta_reduce uses paths (subst (same_path paths) arg param body) + | Some _ | None -> + if is_pure arg + then beta_reduce uses paths (subst (same_path paths) arg param body) + else + (* if the parameter is used multiple times in the body, introduce a + let binding so that the parameter is evaluated only once *) + default ()) | Ppat_tuple pats -> (match arg.pexp_desc with - | Pexp_tuple args -> List.fold_left2 ~f:beta_reduce_arg ~init:body pats args - | _ -> with_let ()) - | _ -> with_let () - in - let extract_param_pats params = - List.map params ~f:(fun p -> - match p.Parsetree.pparam_desc with - | Pparam_val (Nolabel, _, pat) -> Some pat - | _ -> None) - |> Option.List.all + | Pexp_tuple args -> + List.fold_left2 + ~f:(fun body pat arg -> beta_reduce_arg pat body arg) + ~init:body + pats + args + | _ -> default ()) + | _ -> default () in + let apply func args = if List.is_empty args then func else H.Exp.apply func args in match app.pexp_desc with - | Pexp_apply ({ pexp_desc = Pexp_function (params, None, Pfunction_body body); _ }, args) - when List.length params = List.length args && all_unlabeled_params params -> - (match extract_param_pats params with - | Some pats -> - List.fold_left2 - ~f:(fun body pat (_, arg) -> beta_reduce_arg body pat arg) - ~init:body - pats - args - | None -> app) + | Pexp_apply + ({ pexp_desc = Pexp_fun (Nolabel, None, pat, body); _ }, (Nolabel, arg) :: args') -> + beta_reduce_arg pat (apply body args') arg + | Pexp_apply ({ pexp_desc = Pexp_fun ((Labelled l as lbl), None, pat, body); _ }, args) + -> + let m_matching_arg, args' = + find_map_remove args ~f:(function + | Asttypes.Labelled l', e when String.equal l l' -> Some e + | _ -> None) + in + (match m_matching_arg with + | Some arg -> beta_reduce_arg pat (apply body args') arg + | None -> H.Exp.fun_ lbl None pat (beta_reduce uses paths (apply body args))) | _ -> app ;; @@ -302,6 +354,7 @@ let inline_edits pipeline task = | Optional _, Some _ -> () | _, _ -> Option.iter m_arg_expr ~f:(iter.expr iter) in + let uses = Uses.of_typedtree task.inlined_expr in let paths = Paths.of_typedtree task.inlined_expr in let inlined_pexpr = find_parsetree_loc_exn pipeline task.inlined_expr.exp_loc in let expr_iter (iter : I.iterator) (expr : Typedtree.expression) = @@ -314,7 +367,7 @@ let inline_edits pipeline task = let app_pexpr = find_parsetree_loc_exn pipeline expr.exp_loc in match app_pexpr.pexp_desc with | Pexp_apply ({ pexp_desc = Pexp_ident _; _ }, args) -> - beta_reduce paths (H.Exp.apply inlined_pexpr args) + beta_reduce uses paths (H.Exp.apply inlined_pexpr args) | _ -> app_pexpr in let newText = diff --git a/ocaml-lsp-server/src/code_actions/action_mark_remove_unused.ml b/ocaml-lsp-server/src/code_actions/action_mark_remove_unused.ml index 0b3d8f23a..ed95f6613 100644 --- a/ocaml-lsp-server/src/code_actions/action_mark_remove_unused.ml +++ b/ocaml-lsp-server/src/code_actions/action_mark_remove_unused.ml @@ -73,7 +73,7 @@ let rec mark_value_unused_edit name contexts = pats ~f: (function - | { loc = field_loc; _ }, _, { pat_desc = Tpat_var (ident, _, _); pat_loc; _ } + | { loc = field_loc; _ }, _, { pat_desc = Tpat_var (ident, _); pat_loc; _ } when Ident.name ident = name -> (* Special case for record shorthand *) if field_loc.loc_start = pat_loc.loc_start @@ -95,7 +95,7 @@ let rec mark_value_unused_edit name contexts = (match m_field_edit with | Some e -> Some e | None -> mark_value_unused_edit name cs) - | Pattern { pat_desc = Tpat_var (ident, _, _); pat_loc = loc; _ } :: _ -> + | Pattern { pat_desc = Tpat_var (ident, _); pat_loc = loc; _ } :: _ -> if Ident.name ident = name then let+ start = Position.of_lexical_position loc.loc_start in @@ -130,7 +130,7 @@ let enclosing_value_binding_range name = { exp_desc = Texp_let ( _ - , [ { vb_pat = { pat_desc = Tpat_var (_, { txt = name'; _ }, _); _ }; _ } ] + , [ { vb_pat = { pat_desc = Tpat_var (_, { txt = name'; _ }); _ }; _ } ] , { exp_loc = { loc_start = let_end; _ }; _ } ) ; exp_loc = { loc_start = let_start; _ } ; _ diff --git a/ocaml-lsp-server/src/document_symbol.ml b/ocaml-lsp-server/src/document_symbol.ml index e803a6594..5858b6735 100644 --- a/ocaml-lsp-server/src/document_symbol.ml +++ b/ocaml-lsp-server/src/document_symbol.ml @@ -177,7 +177,7 @@ let binding_document_symbol | `Parent name -> let kind : SymbolKind.t = match ppx, binding.pvb_expr.pexp_desc with - | None, (Pexp_function _ | Pexp_newtype _) -> Function + | None, (Pexp_function _ | Pexp_fun _ | Pexp_newtype _) -> Function | Some _, _ -> Property | _ -> Variable in diff --git a/ocaml-lsp-server/src/folding_range.ml b/ocaml-lsp-server/src/folding_range.ml index 546adf835..31c5e3864 100644 --- a/ocaml-lsp-server/src/folding_range.ml +++ b/ocaml-lsp-server/src/folding_range.ml @@ -67,9 +67,10 @@ let fold_over_parsetree (parsetree : Mreader.parsetree) = let range = Range.of_loc module_expr.pmod_loc in push range; Ast_iterator.default_iterator.module_expr self module_expr - | _ -> - (* We rely on the wildcard pattern to improve compatibility with - multiple OCaml's parsetree versions *) + | Parsetree.Pmod_ident _ + | Parsetree.Pmod_apply (_, _) + | Parsetree.Pmod_constraint (_, _) + | Parsetree.Pmod_unpack _ | Parsetree.Pmod_extension _ -> Ast_iterator.default_iterator.module_expr self module_expr in let class_declaration @@ -196,6 +197,7 @@ let fold_over_parsetree (parsetree : Mreader.parsetree) = | Pexp_extension _ | Pexp_let _ | Pexp_open _ + | Pexp_fun _ | Pexp_poly _ | Pexp_sequence _ | Pexp_constraint _ diff --git a/ocaml-lsp-server/src/hover_req.ml b/ocaml-lsp-server/src/hover_req.ml index a64b0470b..1df429b96 100644 --- a/ocaml-lsp-server/src/hover_req.ml +++ b/ocaml-lsp-server/src/hover_req.ml @@ -72,13 +72,14 @@ let hover_at_cursor parsetree (`Logical (cursor_line, cursor_col)) = if is_on_field then result := Some `Type_enclosing else Ast_iterator.default_iterator.expr self expr - | Pexp_function _ | Pexp_lazy _ -> + | Pexp_fun _ | Pexp_function _ | Pexp_lazy _ -> (* Anonymous function expressions can be hovered on the keyword [fun] or [function]. Lazy expressions can also be hovered on the [lazy] keyword. *) let is_at_keyword = let keyword_len = match expr.pexp_desc with + | Pexp_fun _ -> 3 | Pexp_function _ -> 8 | Pexp_lazy _ -> 4 | _ -> 0 diff --git a/ocaml-lsp-server/src/import.ml b/ocaml-lsp-server/src/import.ml index 7e25c5f42..9d80a89f2 100644 --- a/ocaml-lsp-server/src/import.ml +++ b/ocaml-lsp-server/src/import.ml @@ -193,7 +193,6 @@ end include struct open Merlin_kernel module Mconfig = Mconfig - module Mconfig_dot = Mconfig_dot module Msource = Msource module Mbrowse = Mbrowse module Mpipeline = Mpipeline diff --git a/ocaml-lsp-server/src/merlin_config.ml b/ocaml-lsp-server/src/merlin_config.ml index a9d152a03..50ce15d5d 100644 --- a/ocaml-lsp-server/src/merlin_config.ml +++ b/ocaml-lsp-server/src/merlin_config.ml @@ -27,6 +27,7 @@ open Import open Fiber.O +open Merlin_kernel module Std = Merlin_utils.Std module Misc = Merlin_utils.Misc diff --git a/ocaml-lsp-server/src/ocaml_lsp_server.ml b/ocaml-lsp-server/src/ocaml_lsp_server.ml index c2f54d1be..ef0559f75 100644 --- a/ocaml-lsp-server/src/ocaml_lsp_server.ml +++ b/ocaml-lsp-server/src/ocaml_lsp_server.ml @@ -414,49 +414,21 @@ let selection_range List.filter_opt ranges ;; -let references - rpc - (state : State.t) - { ReferenceParams.textDocument = { uri }; position; _ } - = +let references (state : State.t) { ReferenceParams.textDocument = { uri }; position; _ } = let doc = Document_store.get state.store uri in match Document.kind doc with | `Other -> Fiber.return None | `Merlin doc -> - let* locs, synced = + let+ locs, _status = Document.Merlin.dispatch_exn ~name:"occurrences" doc - (Occurrences (`Ident_at (Position.logical position), `Project)) - in - let+ () = - match synced with - | `Out_of_sync _ -> - let msg = - let message = - "The index might be out-of-sync. If you use Dune you can build the target \ - `@ocaml-index` to refresh the index." - in - ShowMessageParams.create ~message ~type_:Warning - in - task_if_running state.detached ~f:(fun () -> - Server.notification rpc (ShowMessage msg)) - | _ -> Fiber.return () + (Occurrences (`Ident_at (Position.logical position), `Buffer)) in Some (List.map locs ~f:(fun loc -> let range = Range.of_loc loc in - let uri = - match loc.loc_start.pos_fname with - | "" -> uri - | path -> Uri.of_path path - in - Log.log ~section:"debug" (fun () -> - Log.msg - "merlin returned fname %a" - [ "pos_fname", `String loc.loc_start.pos_fname - ; "uri", `String (Uri.to_string uri) - ]); + (* using original uri because merlin is looking only in local file *) { Location.uri; range })) ;; @@ -469,7 +441,7 @@ let highlight match Document.kind doc with | `Other -> Fiber.return None | `Merlin m -> - let+ locs, _synced = + let+ locs, _status = Document.Merlin.dispatch_exn ~name:"occurrences" m @@ -634,7 +606,7 @@ let on_request | Some _ | None -> Hover_req.Default in later (fun (_ : State.t) () -> Hover_req.handle rpc req mode) () - | TextDocumentReferences req -> later (references rpc) req + | TextDocumentReferences req -> later references req | TextDocumentCodeLensResolve codeLens -> now codeLens | TextDocumentCodeLens req -> (match state.configuration.data.codelens with @@ -656,7 +628,7 @@ let on_request match Document.kind doc with | `Other -> Fiber.return None | `Merlin doc -> - let+ locs, _synced = + let+ locs, _status = Document.Merlin.dispatch_exn ~name:"occurrences" doc diff --git a/ocaml-lsp-server/src/rename.ml b/ocaml-lsp-server/src/rename.ml index eb810e516..b826dd7ff 100644 --- a/ocaml-lsp-server/src/rename.ml +++ b/ocaml-lsp-server/src/rename.ml @@ -10,7 +10,7 @@ let rename (state : State.t) { RenameParams.textDocument = { uri }; position; ne let command = Query_protocol.Occurrences (`Ident_at (Position.logical position), `Buffer) in - let+ locs, _desync = Document.Merlin.dispatch_exn ~name:"rename" merlin command in + let+ locs, _status = Document.Merlin.dispatch_exn ~name:"rename" merlin command in let version = Document.version doc in let source = Document.source doc in let edits = diff --git a/ocaml-lsp-server/src/semantic_highlighting.ml b/ocaml-lsp-server/src/semantic_highlighting.ml index 622c1cdc7..df77548fd 100644 --- a/ocaml-lsp-server/src/semantic_highlighting.ml +++ b/ocaml-lsp-server/src/semantic_highlighting.ml @@ -386,15 +386,13 @@ end = struct add_token tp.loc (Token_type.of_builtin TypeParameter) Token_modifiers_set.empty); self.typ self ct; `Custom_iterator - | Ptyp_any -> `Custom_iterator | Ptyp_variant (_, _, _) | Ptyp_alias (_, _) - | Ptyp_arrow _ - | Ptyp_extension _ - | Ptyp_package _ - | Ptyp_object _ - | Ptyp_tuple _ - | Ptyp_open _ -> `Default_iterator + | Ptyp_arrow _ | Ptyp_extension _ | Ptyp_package _ | Ptyp_object _ | Ptyp_tuple _ -> + `Default_iterator + | Ptyp_any -> + (); + `Custom_iterator in match iter with | `Default_iterator -> Ast_iterator.default_iterator.typ self ct @@ -429,13 +427,13 @@ end = struct let value_binding (self : Ast_iterator.iterator) - ({ pvb_pat; pvb_expr; pvb_attributes; _ } as vb : Parsetree.value_binding) + ({ pvb_pat; pvb_expr; pvb_attributes; pvb_loc = _ } as vb : Parsetree.value_binding) = match match pvb_pat.ppat_desc, pvb_expr.pexp_desc with | Parsetree.Ppat_var fn_name, _ -> (match pvb_expr.pexp_desc with - | Pexp_function _ -> + | Pexp_fun _ | Pexp_function _ -> add_token fn_name.loc (Token_type.of_builtin Function) @@ -569,6 +567,19 @@ end = struct `Custom_iterator | Pexp_apply (expr, args) -> pexp_apply self expr args | Pexp_function _ | Pexp_let (_, _, _) -> `Default_iterator + | Pexp_fun (_, expr_opt, pat, expr) -> + (match expr_opt with + | None -> self.pat self pat + | Some e -> + if Loc.compare e.pexp_loc pat.ppat_loc < 0 + then ( + self.expr self e; + self.pat self pat) + else ( + self.pat self pat; + self.expr self e)); + self.expr self expr; + `Custom_iterator | Pexp_try (_, _) | Pexp_tuple _ | Pexp_variant (_, _) @@ -635,7 +646,6 @@ end = struct then self.expr self pbop_exp); self.expr self body; `Custom_iterator - | Pexp_unreachable -> `Custom_iterator | Pexp_array _ | Pexp_ifthenelse (_, _, _) | Pexp_while (_, _) @@ -649,6 +659,7 @@ end = struct | Pexp_object _ | Pexp_pack _ | Pexp_open (_, _) | Pexp_extension _ -> `Default_iterator + | Pexp_unreachable -> `Custom_iterator with | `Default_iterator -> Ast_iterator.default_iterator.expr self exp | `Custom_iterator -> self.attributes self pexp_attributes @@ -751,10 +762,7 @@ end = struct self.module_type self mt); `Custom_iterator | Pmod_extension _ -> `Custom_iterator - | _ -> - (* We rely on the wildcard pattern to improve compatibility with - multiple OCaml's parsetree versions *) - `Default_iterator + | Pmod_unpack _ | Pmod_apply (_, _) | Pmod_structure _ -> `Default_iterator with | `Custom_iterator -> self.attributes self pmod_attributes | `Default_iterator -> Ast_iterator.default_iterator.module_expr self me @@ -787,8 +795,7 @@ end = struct | Ptyp_alias (_, _) | Ptyp_variant (_, _, _) | Ptyp_poly (_, _) - | Ptyp_tuple _ | Ptyp_any | Ptyp_var _ | Ptyp_open _ -> - Token_type.of_builtin Variable) + | Ptyp_tuple _ | Ptyp_any | Ptyp_var _ -> Token_type.of_builtin Variable) (Token_modifiers_set.singleton Declaration); self.typ self pval_type; (* TODO: handle pval_prim ? *) diff --git a/ocaml-lsp-server/src/workspace_symbol.ml b/ocaml-lsp-server/src/workspace_symbol.ml index 27457ab26..c6d7f66fb 100644 --- a/ocaml-lsp-server/src/workspace_symbol.ml +++ b/ocaml-lsp-server/src/workspace_symbol.ml @@ -71,7 +71,7 @@ end = struct open Browse_tree let id_of_patt = function - | { pat_desc = Tpat_var (id, _, _); _ } -> Some id + | { pat_desc = Tpat_var (id, _); _ } -> Some id | _ -> None ;; diff --git a/ocaml-lsp-server/test/dune b/ocaml-lsp-server/test/dune index 34bfff3c6..e2c3b9866 100644 --- a/ocaml-lsp-server/test/dune +++ b/ocaml-lsp-server/test/dune @@ -15,7 +15,7 @@ ;; This is because of the (implicit_transitive_deps false) ;; in dune-project base - ppx_expect + ppx_expect.common ppx_expect.config ppx_expect.config_types ppx_inline_test.config) diff --git a/ocaml-lsp-server/test/e2e-new/action_inline.ml b/ocaml-lsp-server/test/e2e-new/action_inline.ml index 228312bc9..0ad51bdc7 100644 --- a/ocaml-lsp-server/test/e2e-new/action_inline.ml +++ b/ocaml-lsp-server/test/e2e-new/action_inline.ml @@ -219,7 +219,7 @@ let _ = [%expect {| let _ = let f x y = x + y in - ((fun x y -> x + y) 0) |}] + (fun y -> 0 + y) |}] ;; let%expect_test "" = @@ -243,7 +243,7 @@ let _ = [%expect {| let _ = let f ~x y = x + y in - ((fun ~x y -> x + y) ~x:0) |}] + (fun y -> 0 + y) |}] ;; let%expect_test "" = @@ -252,11 +252,10 @@ let _ = let $f ~x ~y = x + y in f ~y:0 |}; - [%expect - {| + [%expect {| let _ = let f ~x ~y = x + y in - ((fun ~x ~y -> x + y) ~y:0) |}] + (fun ~x -> x + 0) |}] ;; let%expect_test "" = @@ -282,17 +281,19 @@ let _ = {| let _ = let f (type a) (x : a) = x in - ((fun (type a) (x : a) -> x) 0) |}] + ((fun (type a) -> fun (x : a) -> x) 0) |}] ;; -(* FIXME this test broke with the update to OCaml 5.2 *) let%expect_test "" = inline_test {| let _ = let $f : int -> int = fun x -> x in f 0 |}; - [%expect {| |}] + [%expect {| + let _ = + let f : int -> int = fun x -> x in + (0) |}] ;; let%expect_test "" = @@ -483,15 +484,3 @@ let h = M.f end let h = M.f |}] ;; - -let%expect_test "" = - inline_test {| -let _ = - let $f _ = 0 in - f (print_endline "hi") -|}; - [%expect {| - let _ = - let f _ = 0 in - (let _ = print_endline "hi" in 0) |}] -;; diff --git a/ocaml-lsp-server/test/e2e-new/documentation.ml b/ocaml-lsp-server/test/e2e-new/documentation.ml index c8b81d53a..6255d1aa4 100644 --- a/ocaml-lsp-server/test/e2e-new/documentation.ml +++ b/ocaml-lsp-server/test/e2e-new/documentation.ml @@ -109,7 +109,7 @@ let%expect_test "Documentation when List module is shadowed" = { "doc": { "kind": "plaintext", - "value": "[iter f [a1; ...; an]] applies function [f] in turn to\n [[a1; ...; an]]. It is equivalent to\n [f a1; f a2; ...; f an]." + "value": "[iter f [a1; ...; an]] applies function [f] in turn to\n [a1; ...; an]. It is equivalent to\n [begin f a1; f a2; ...; f an; () end]." } } |}] ;; diff --git a/ocaml-lsp-server/test/e2e-new/dune b/ocaml-lsp-server/test/e2e-new/dune index add8bed2a..fda9703ae 100644 --- a/ocaml-lsp-server/test/e2e-new/dune +++ b/ocaml-lsp-server/test/e2e-new/dune @@ -30,7 +30,7 @@ ;; This is because of the (implicit_transitive_deps false) ;; in dune-project base - ppx_expect + ppx_expect.common ppx_expect.config ppx_expect.config_types ppx_inline_test.config) diff --git a/ocaml-lsp-server/test/e2e-new/type_search.ml b/ocaml-lsp-server/test/e2e-new/type_search.ml index ece053402..194ca560a 100644 --- a/ocaml-lsp-server/test/e2e-new/type_search.ml +++ b/ocaml-lsp-server/test/e2e-new/type_search.ml @@ -57,8 +57,8 @@ let%expect_test "Polarity Search for a simple query that takes an int and return "name": "string_of_int", "typ": "int -> string", "loc": { - "end": { "character": 33, "line": 740 }, - "start": { "character": 0, "line": 740 } + "end": { "character": 33, "line": 749 }, + "start": { "character": 0, "line": 749 } }, "doc": { "kind": "markdown", @@ -71,8 +71,8 @@ let%expect_test "Polarity Search for a simple query that takes an int and return "name": "string_of_int", "typ": "int -> string", "loc": { - "end": { "character": 33, "line": 740 }, - "start": { "character": 0, "line": 740 } + "end": { "character": 33, "line": 749 }, + "start": { "character": 0, "line": 749 } }, "doc": { "kind": "markdown", @@ -110,8 +110,8 @@ let%expect_test "Polarity Search for a simple query that takes an int and return "name": "string_of_int", "typ": "int -> string", "loc": { - "end": { "character": 33, "line": 740 }, - "start": { "character": 0, "line": 740 } + "end": { "character": 33, "line": 749 }, + "start": { "character": 0, "line": 749 } }, "doc": null, "cost": 4, @@ -121,8 +121,8 @@ let%expect_test "Polarity Search for a simple query that takes an int and return "name": "string_of_int", "typ": "int -> string", "loc": { - "end": { "character": 33, "line": 740 }, - "start": { "character": 0, "line": 740 } + "end": { "character": 33, "line": 749 }, + "start": { "character": 0, "line": 749 } }, "doc": null, "cost": 4, @@ -156,8 +156,8 @@ let%expect_test "Type Search for a simple query that takes an int and returns a "name": "string_of_int", "typ": "int -> string", "loc": { - "end": { "character": 33, "line": 740 }, - "start": { "character": 0, "line": 740 } + "end": { "character": 33, "line": 749 }, + "start": { "character": 0, "line": 749 } }, "doc": null, "cost": 0, @@ -167,8 +167,8 @@ let%expect_test "Type Search for a simple query that takes an int and returns a "name": "string_of_int", "typ": "int -> string", "loc": { - "end": { "character": 33, "line": 740 }, - "start": { "character": 0, "line": 740 } + "end": { "character": 33, "line": 749 }, + "start": { "character": 0, "line": 749 } }, "doc": null, "cost": 0, @@ -205,8 +205,8 @@ let%expect_test "Type Search for a simple query that takes an int and returns a "name": "string_of_int", "typ": "int -> string", "loc": { - "end": { "character": 33, "line": 740 }, - "start": { "character": 0, "line": 740 } + "end": { "character": 33, "line": 749 }, + "start": { "character": 0, "line": 749 } }, "doc": { "kind": "plaintext", @@ -219,8 +219,8 @@ let%expect_test "Type Search for a simple query that takes an int and returns a "name": "string_of_int", "typ": "int -> string", "loc": { - "end": { "character": 33, "line": 740 }, - "start": { "character": 0, "line": 740 } + "end": { "character": 33, "line": 749 }, + "start": { "character": 0, "line": 749 } }, "doc": { "kind": "plaintext", diff --git a/ocaml-lsp-server/test/e2e-new/with_ppx.ml b/ocaml-lsp-server/test/e2e-new/with_ppx.ml index 30181353b..8da004358 100644 --- a/ocaml-lsp-server/test/e2e-new/with_ppx.ml +++ b/ocaml-lsp-server/test/e2e-new/with_ppx.ml @@ -76,7 +76,7 @@ let%expect_test "with-ppx" = Received 0 diagnostics { "contents": { - "value": "(* ppx expect expansion *)\nPpx_expect_runtime.Current_file.unset ()", + "value": "(* ppx expect expansion *)\nExpect_test_collector.Current_file.unset ()", "language": "ocaml" }, "range": { diff --git a/ocaml-lsp-server/test/e2e/__tests__/completionItem-resolve.test.ts b/ocaml-lsp-server/test/e2e/__tests__/completionItem-resolve.test.ts index 3e2d1122e..232dd86f1 100644 --- a/ocaml-lsp-server/test/e2e/__tests__/completionItem-resolve.test.ts +++ b/ocaml-lsp-server/test/e2e/__tests__/completionItem-resolve.test.ts @@ -59,7 +59,7 @@ describe("textDocument/completion", () => { "documentation": "[map2 f [a1; ...; an] [b1; ...; bn]] is [[f a1 b1; ...; f an bn]]. @raise Invalid_argument if the two lists are determined - to have different lengths.", + to have different lengths. Not tail-recursive.", "label": "map2", } `); diff --git a/ocaml-lsp-server/test/e2e/__tests__/textDocument-declaration.test.ts b/ocaml-lsp-server/test/e2e/__tests__/textDocument-declaration.test.ts index f5eae3e4a..60299f419 100644 --- a/ocaml-lsp-server/test/e2e/__tests__/textDocument-declaration.test.ts +++ b/ocaml-lsp-server/test/e2e/__tests__/textDocument-declaration.test.ts @@ -70,11 +70,11 @@ describe("textDocument/declaration", () => { expect(result[0].range).toMatchInlineSnapshot(` Object { "end": Object { - "character": 4, + "character": 0, "line": 0, }, "start": Object { - "character": 4, + "character": 0, "line": 0, }, } diff --git a/ocaml-lsp-server/test/e2e/__tests__/textDocument-selectionRange.test.ts b/ocaml-lsp-server/test/e2e/__tests__/textDocument-selectionRange.test.ts index 475477c2f..f0a606932 100644 --- a/ocaml-lsp-server/test/e2e/__tests__/textDocument-selectionRange.test.ts +++ b/ocaml-lsp-server/test/e2e/__tests__/textDocument-selectionRange.test.ts @@ -55,13 +55,25 @@ Array [ "parent": Object { "parent": Object { "parent": Object { + "parent": Object { + "range": Object { + "end": Object { + "character": 17, + "line": 3, + }, + "start": Object { + "character": 0, + "line": 0, + }, + }, + }, "range": Object { "end": Object { "character": 17, "line": 3, }, "start": Object { - "character": 0, + "character": 8, "line": 0, }, }, @@ -72,7 +84,7 @@ Array [ "line": 3, }, "start": Object { - "character": 8, + "character": 10, "line": 0, }, }, @@ -146,6 +158,18 @@ Array [ "parent": Object { "parent": Object { "parent": Object { + "parent": Object { + "range": Object { + "end": Object { + "character": 3, + "line": 6, + }, + "start": Object { + "character": 0, + "line": 0, + }, + }, + }, "range": Object { "end": Object { "character": 3, @@ -153,7 +177,7 @@ Array [ }, "start": Object { "character": 0, - "line": 0, + "line": 3, }, }, }, @@ -163,19 +187,19 @@ Array [ "line": 6, }, "start": Object { - "character": 0, + "character": 11, "line": 3, }, }, }, "range": Object { "end": Object { - "character": 3, - "line": 6, + "character": 24, + "line": 5, }, "start": Object { - "character": 11, - "line": 3, + "character": 2, + "line": 4, }, }, }, @@ -186,7 +210,7 @@ Array [ }, "start": Object { "character": 2, - "line": 4, + "line": 5, }, }, }, @@ -196,7 +220,7 @@ Array [ "line": 5, }, "start": Object { - "character": 2, + "character": 8, "line": 5, }, }, @@ -207,7 +231,7 @@ Array [ "line": 5, }, "start": Object { - "character": 8, + "character": 9, "line": 5, }, }, @@ -245,36 +269,48 @@ Array [ "parent": Object { "parent": Object { "parent": Object { + "parent": Object { + "range": Object { + "end": Object { + "character": 4, + "line": 3, + }, + "start": Object { + "character": 0, + "line": 0, + }, + }, + }, "range": Object { "end": Object { "character": 4, "line": 3, }, "start": Object { - "character": 0, + "character": 11, "line": 0, }, }, }, "range": Object { "end": Object { - "character": 4, + "character": 3, "line": 3, }, "start": Object { - "character": 11, + "character": 21, "line": 0, }, }, }, "range": Object { "end": Object { - "character": 3, - "line": 3, + "character": 39, + "line": 2, }, "start": Object { - "character": 21, - "line": 0, + "character": 2, + "line": 1, }, }, }, @@ -285,7 +321,7 @@ Array [ }, "start": Object { "character": 2, - "line": 1, + "line": 2, }, }, }, @@ -295,7 +331,7 @@ Array [ "line": 2, }, "start": Object { - "character": 2, + "character": 14, "line": 2, }, }, @@ -306,7 +342,7 @@ Array [ "line": 2, }, "start": Object { - "character": 14, + "character": 16, "line": 2, }, }, diff --git a/ocaml-lsp-server/test/e2e/__tests__/textDocument-typeDefinition.test.ts b/ocaml-lsp-server/test/e2e/__tests__/textDocument-typeDefinition.test.ts index ab7141bf7..43f4746b3 100644 --- a/ocaml-lsp-server/test/e2e/__tests__/textDocument-typeDefinition.test.ts +++ b/ocaml-lsp-server/test/e2e/__tests__/textDocument-typeDefinition.test.ts @@ -62,11 +62,11 @@ describe("textDocument/definition", () => { expect(result[0].range).toMatchInlineSnapshot(` Object { "end": Object { - "character": 5, + "character": 0, "line": 1, }, "start": Object { - "character": 5, + "character": 0, "line": 1, }, } @@ -89,11 +89,11 @@ Object { expect(result[0].range).toMatchInlineSnapshot(` Object { "end": Object { - "character": 5, + "character": 0, "line": 1, }, "start": Object { - "character": 5, + "character": 0, "line": 1, }, } @@ -115,11 +115,11 @@ Object { expect(result[0].range).toMatchInlineSnapshot(` Object { "end": Object { - "character": 5, + "character": 0, "line": 1, }, "start": Object { - "character": 5, + "character": 0, "line": 1, }, } diff --git a/ocaml-lsp-server/test/e2e/__tests__/workspace-symbol.test.ts b/ocaml-lsp-server/test/e2e/__tests__/workspace-symbol.test.ts index 0345e4264..7d77fa570 100644 --- a/ocaml-lsp-server/test/e2e/__tests__/workspace-symbol.test.ts +++ b/ocaml-lsp-server/test/e2e/__tests__/workspace-symbol.test.ts @@ -114,6 +114,7 @@ describe("workspace/symbol", () => { "a_x 12 /workspace_symbol_A/bin/a.ml 0:0 0:11", "main_y 12 /workspace_symbol_A/bin/main.ml 0:0 0:22", "vendored_x 12 /workspace_symbol_A/lib/lib.ml 14:0 14:31", + "lib_type 12 /workspace_symbol_A/lib/lib.ml 12:0 12:38", "lib_private_fn 12 /workspace_symbol_A/lib/lib.ml 10:0 10:38", "hd 12 /workspace_symbol_A/lib/lib.ml 8:0 8:16", "lib_x 12 /workspace_symbol_A/lib/lib.ml 6:0 6:14", @@ -160,7 +161,7 @@ describe("workspace/symbol", () => { let symbols = await queryWorkspaceSymbol({ query: "", }); - /* FIXME: symbol lib_type from lib.ml is missing */ + expect(symbols.map(toTestResult)).toMatchInlineSnapshot(` Array [ "stack_of_ints 5 /workspace_symbol_A/bin/a.ml 51:0 65:5", @@ -193,6 +194,7 @@ describe("workspace/symbol", () => { "a_x 12 /workspace_symbol_A/bin/a.ml 0:0 0:11", "main_y 12 /workspace_symbol_A/bin/main.ml 0:0 0:22", "vendored_x 12 /workspace_symbol_A/lib/lib.ml 14:0 14:31", + "lib_type 12 /workspace_symbol_A/lib/lib.ml 12:0 12:38", "lib_private_fn 12 /workspace_symbol_A/lib/lib.ml 10:0 10:38", "hd 12 /workspace_symbol_A/lib/lib.ml 8:0 8:16", "lib_x 12 /workspace_symbol_A/lib/lib.ml 6:0 6:14", diff --git a/submodules/lev/lev-fiber-csexp/test/dune b/submodules/lev/lev-fiber-csexp/test/dune index 2bbfcf47d..0d144a3c7 100644 --- a/submodules/lev/lev-fiber-csexp/test/dune +++ b/submodules/lev/lev-fiber-csexp/test/dune @@ -13,7 +13,7 @@ ;; in dune-project ppx_expect.config ppx_expect.config_types - ppx_expect + ppx_expect.common base ppx_inline_test.config) (inline_tests) diff --git a/submodules/lev/lev-fiber/test/dune b/submodules/lev/lev-fiber/test/dune index 441635ffc..fb24190ea 100644 --- a/submodules/lev/lev-fiber/test/dune +++ b/submodules/lev/lev-fiber/test/dune @@ -11,7 +11,7 @@ ;; in dune-project ppx_expect.config ppx_expect.config_types - ppx_expect + ppx_expect.common base ppx_inline_test.config) (inline_tests) diff --git a/submodules/lev/lev-fiber/test/util/dune b/submodules/lev/lev-fiber/test/util/dune index 2929abb75..e903c60fe 100644 --- a/submodules/lev/lev-fiber/test/util/dune +++ b/submodules/lev/lev-fiber/test/util/dune @@ -9,7 +9,7 @@ ;; in dune-project ppx_expect.config ppx_expect.config_types - ppx_expect + ppx_expect.common base ppx_inline_test.config) (inline_tests) diff --git a/submodules/lev/lev/test/dune b/submodules/lev/lev/test/dune index 5bc7a911b..e4b014b71 100644 --- a/submodules/lev/lev/test/dune +++ b/submodules/lev/lev/test/dune @@ -7,7 +7,7 @@ ;; in dune-project ppx_expect.config ppx_expect.config_types - ppx_expect + ppx_expect.common base ppx_inline_test.config) (inline_tests) @@ -23,7 +23,7 @@ ;; in dune-project ppx_expect.config ppx_expect.config_types - ppx_expect + ppx_expect.common base ppx_inline_test.config) (inline_tests @@ -42,7 +42,7 @@ ;; in dune-project ppx_expect.config ppx_expect.config_types - ppx_expect + ppx_expect.common base ppx_inline_test.config) (inline_tests