From 81fdf03ffba01675a914d97e9d097895f7e804f7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Tue, 24 Jun 2025 14:31:09 +0200 Subject: [PATCH 1/3] Add a test triggering the infinite loop. Reproducing issue #1489 --- tests/test-dirs/lsp-issue1489.t | 8 ++++++++ 1 file changed, 8 insertions(+) create mode 100644 tests/test-dirs/lsp-issue1489.t diff --git a/tests/test-dirs/lsp-issue1489.t b/tests/test-dirs/lsp-issue1489.t new file mode 100644 index 0000000000..ab099e741c --- /dev/null +++ b/tests/test-dirs/lsp-issue1489.t @@ -0,0 +1,8 @@ + $ cat >repro.ml <<'EOF' + > type t = ( :: ) + > let f (x: t) = x + > EOF + +FIXME: this should not hang and return a matching. +$ $MERLIN single case-analysis -start 2:16 -end 2:17 \ +> -filename repro.ml Date: Tue, 24 Jun 2025 14:32:23 +0200 Subject: [PATCH 2/3] Pprintast hangs when printing some patterns with the `(::)` constructor. Fixes ocaml/ocaml-lsp#1489 --- src/ocaml/parsing/pprintast.ml | 39 +++++++++++++-------------------- tests/test-dirs/lsp-issue1489.t | 23 ++++++++++++++++--- 2 files changed, 35 insertions(+), 27 deletions(-) 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 index ab099e741c..03c4d082e1 100644 --- a/tests/test-dirs/lsp-issue1489.t +++ b/tests/test-dirs/lsp-issue1489.t @@ -3,6 +3,23 @@ > let f (x: t) = x > EOF -FIXME: this should not hang and return a matching. -$ $MERLIN single case-analysis -start 2:16 -end 2:17 \ -> -filename repro.ml -filename repro.ml _" + ], + "notifications": [] + } From 44ff26a91bdb14ff564ae997f3e24c5e8a553a60 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ulysse=20G=C3=A9rard?= Date: Tue, 24 Jun 2025 14:39:45 +0200 Subject: [PATCH 3/3] Add changelog entry for #1944 --- CHANGES.md | 2 ++ 1 file changed, 2 insertions(+) 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)