diff --git a/CHANGES.md b/CHANGES.md index 9d8068409f..679c421a94 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -17,6 +17,8 @@ unreleased to scopes bit masks when backtracking the typer cache (#1935) - Add a new selection field to outline results that contains the location of the symbol itself. (#1942) + - Fix destruct hanging when printing patterns with (::). (#1944, fixes + ocaml/ocaml-lsp#1489) + ocaml-index - Improve the granularity of index reading by segmenting the marshalization of the involved data-structures. (#1889) diff --git a/src/ocaml/parsing/pprintast.ml b/src/ocaml/parsing/pprintast.ml index 9a1b9bd9a4..29c997cbf0 100644 --- a/src/ocaml/parsing/pprintast.ml +++ b/src/ocaml/parsing/pprintast.ml @@ -548,37 +548,28 @@ and pattern_or ctxt f x = pp f "@[%a@]" (list ~sep:"@ | " (pattern1 ctxt)) orpats and pattern1 ctxt (f:Format.formatter) (x:pattern) : unit = - let rec pattern_list_helper f = function - | {ppat_desc = - Ppat_construct - ({ txt = Lident("::") ;_}, - Some ([], {ppat_desc = Ppat_tuple([pat1; pat2]);_})); - ppat_attributes = []} - - -> - pp f "%a::%a" (simple_pattern ctxt) pat1 pattern_list_helper pat2 (*RA*) - | p -> pattern1 ctxt f p - in if x.ppat_attributes <> [] then pattern ctxt f x else match x.ppat_desc with | Ppat_variant (l, Some p) -> pp f "@[<2>`%a@;%a@]" ident_of_name l (simple_pattern ctxt) p | Ppat_construct (({txt=Lident("()"|"[]"|"true"|"false");_}), _) -> simple_pattern ctxt f x - | Ppat_construct (({txt;_} as li), po) -> + | Ppat_construct ( + {txt=Lident("::");_}, + Some ([], {ppat_desc = Ppat_tuple([pat1; pat2]);_})) + when x.ppat_attributes = [] -> + pp f "%a::%a" (simple_pattern ctxt) pat1 (pattern1 ctxt) pat2 (*RA*) + | Ppat_construct (li, po) -> (* FIXME The third field always false *) - if txt = Lident "::" then - pp f "%a" pattern_list_helper x - else - (match po with - | Some ([], x) -> - (* [true] and [false] are handled above *) - pp f "%a@;%a" value_longident_loc li (simple_pattern ctxt) x - | Some (vl, x) -> - pp f "%a@ (type %a)@;%a" value_longident_loc li - (list ~sep:"@ " ident_of_name_loc) vl - (simple_pattern ctxt) x - | None -> pp f "%a" value_longident_loc li) + (match po with + | Some ([], x) -> + (* [true] and [false] are handled above *) + pp f "%a@;%a" value_longident_loc li (simple_pattern ctxt) x + | Some (vl, x) -> + pp f "%a@ (type %a)@;%a" value_longident_loc li + (list ~sep:"@ " ident_of_name_loc) vl + (simple_pattern ctxt) x + | None -> pp f "%a" value_longident_loc li) | _ -> simple_pattern ctxt f x and simple_pattern ctxt (f:Format.formatter) (x:pattern) : unit = diff --git a/tests/test-dirs/lsp-issue1489.t b/tests/test-dirs/lsp-issue1489.t new file mode 100644 index 0000000000..03c4d082e1 --- /dev/null +++ b/tests/test-dirs/lsp-issue1489.t @@ -0,0 +1,25 @@ + $ cat >repro.ml <<'EOF' + > type t = ( :: ) + > let f (x: t) = x + > EOF + +This should not hang and return a matching. + $ $MERLIN single case-analysis -start 2:16 -end 2:17 \ + > -filename repro.ml _" + ], + "notifications": [] + }