Fix 'function' indent in methods with no-wrap-fun-args (#2590)

* test: More coverage of --no-wrap-fun-args

* Fix 'function' indent in methods with no-wrap-fun-args

Fix a recent bug that impacts js_of_ocaml.

CHANGES.md

@@ -8,7 +8,7 @@ profile. This started with version 0.26.0.
 
 ### Added
 
-- \* Support OCaml 5.2 syntax (#2519, #2544, @Julow, @EmileTrotignon)
+- \* Support OCaml 5.2 syntax (#2519, #2544, #2590, @Julow, @EmileTrotignon)
   This includes local open in types and changed syntax for functions.
   This might change the formatting of some functions due to the formatting code
   being completely rewritten.

lib/Params.ml

@@ -275,18 +275,12 @@ module Exp = struct
 
   let indent_function (c : Conf.t) ~ctx ~ctx0 ~parens =
     if ctx_is_rhs_of_infix ~ctx0 ~ctx then if ocp c && parens then 1 else 0
+    else if Poly.equal c.fmt_opts.function_indent_nested.v `Always then
+      c.fmt_opts.function_indent.v
     else
-      let extra = if c.fmt_opts.wrap_fun_args.v then 0 else 2 in
-      if Poly.equal c.fmt_opts.function_indent_nested.v `Always then
-        c.fmt_opts.function_indent.v + extra
-      else if ocp c then
-        match ctx_is_apply_and_exp_is_arg ~ctx ctx0 with
-        | Some _ -> 2
-        | None -> if parens then 2 else 0
-      else
-        match ctx_is_apply_and_exp_is_arg ~ctx ctx0 with
-        | Some _ -> 2 + extra
-        | None -> extra
+      match ctx_is_apply_and_exp_is_arg ~ctx ctx0 with
+      | Some _ -> 2
+      | None -> if ocp c && parens then 2 else 0
 
   let box_function_cases c ?indent ~ctx ~ctx0 ~parens =
     let indent =

test/passing/dune.inc

@@ -2204,6 +2204,24 @@
  (package ocamlformat)
  (action (diff tests/for_while.ml.err for_while.ml.stderr)))
 
+(rule
+ (deps tests/.ocamlformat )
+ (package ocamlformat)
+ (action
+  (with-stdout-to fun_decl-no-wrap-fun-args.ml.stdout
+   (with-stderr-to fun_decl-no-wrap-fun-args.ml.stderr
+     (run %{bin:ocamlformat} --margin-check --no-wrap-fun-args %{dep:tests/fun_decl.ml})))))
+
+(rule
+ (alias runtest)
+ (package ocamlformat)
+ (action (diff tests/fun_decl-no-wrap-fun-args.ml.ref fun_decl-no-wrap-fun-args.ml.stdout)))
+
+(rule
+ (alias runtest)
+ (package ocamlformat)
+ (action (diff tests/fun_decl-no-wrap-fun-args.ml.err fun_decl-no-wrap-fun-args.ml.stderr)))
+
 (rule
  (deps tests/.ocamlformat )
  (package ocamlformat)
@@ -2215,7 +2233,7 @@
 (rule
  (alias runtest)
  (package ocamlformat)
- (action (diff tests/fun_decl.ml fun_decl.ml.stdout)))
+ (action (diff tests/fun_decl.ml.ref fun_decl.ml.stdout)))
 
 (rule
  (alias runtest)

test/passing/tests/fun_decl-no-wrap-fun-args.ml.opts

@@ -0,0 +1 @@
+--no-wrap-fun-args

test/passing/tests/fun_decl-no-wrap-fun-args.ml.ref

@@ -0,0 +1,117 @@
+let _ = fun (x : int) : int -> some_large_computation
+
+let _ = fun (x : int) : int -> (some_large_computation : int)
+
+let fooo = List.foooo ~f:(fun foooo foooo : bool -> foooooooooooooooooooooo)
+
+let _ =
+ fun (x : int)
+     (x : int)
+     (x : int)
+     (x : int)
+     (x : int)
+     :
+     fooooooooooooooooooooooooooo foooooooooooooo foooooooooo ->
+  some_large_computation
+
+let _ =
+ fun (x : int)
+     (x : int)
+     (x : int)
+     (x : int)
+     (x : int)
+     (x : int)
+     (x : int)
+     :
+     fooooooooooooooooooooooooooo foooooooooooooo foooooooooo ->
+  some_large_computation
+
+let () =
+ fun x : int ->
+  fun r : int ->
+   fun u ->
+    foooooooooooooooooooooooooooooooooooooooooooooooooooooooo
+      foooooooooooooooooooooooooooooooooooooooooooooooooooooooo
+
+let to_loc_trace
+    ?(desc_of_source =
+      fun source ->
+        let callsite = Source.call_site source in
+        Format.asprintf
+          "return from %a"
+          Typ.Procname.pp
+          (CallSite.pname callsite)) ?(source_should_nest = fun _ -> true)
+    ?(desc_of_sink =
+      fun sink ->
+        let callsite = Sink.call_site sink in
+        Format.asprintf
+          "call to %a"
+          Typ.Procname.pp
+          (CallSite.pname callsite)) ?(sink_should_nest = fun _ -> true)
+    (passthroughs, sources, sinks) =
+  ()
+
+let translate_captured
+    { Clang_ast_t.lci_captured_var
+    ; lci_init_captured_vardecl
+    ; lci_capture_this
+    ; lci_capture_kind } ((trans_results_acc, captured_vars_acc) as acc) =
+  ()
+
+let f ssssssssss =
+  String.fold
+    ssssssssss
+    ~init:innnnnnnnnnit
+    ~f:(fun accuuuuuuuuuum -> function
+    | '0' -> g accuuuuuuuuuum
+    | '1' -> h accuuuuuuuuuum
+    | _ -> i accuuuuuuuuuum )
+
+let f ssssssssss =
+  String.fold ssssssssss ~init:innnnnnnnnnit ~f:(function
+    | '0' -> g accuuuuuuuuuum
+    | '1' -> h accuuuuuuuuuum
+    | _ -> i accuuuuuuuuuum )
+
+let f _ =
+  let foooooooooooooooooooooooooooo = foooooooooooooooooooooooooooo in
+  fun x ->
+    let foooooooooooooooooooooooooooo = foooooooooooooooooooooooooooo in
+    x
+
+let f _ =
+  let foooooooooooooooooooooooooooo = foooooooooooooooooooooooooooo in
+  (* foo *)
+  fun x ->
+    let foooooooooooooooooooooooooooo = foooooooooooooooooooooooooooo in
+    x
+
+let space_break =
+  (* a stack is useless here, this would require adding a unit parameter *)
+  with_pp (fun fs ->
+      Box_debug.space_break fs ;
+      Format_.pp_print_space fs () )
+
+let _ =
+  (fun k ->
+    let _ = 42 in
+    () )
+  @@ ()
+
+let _ =
+  let _ = () in
+  fun (context : Context.t)
+      ~(local_bins : origin Appendable_list.t Filename.Map.t Memo.Lazy.t)
+    ->
+    let _ = () in
+    ()
+
+class traverse_labels h =
+  object
+    method statement =
+      function
+      | Labelled_statement (L l, (s, _)) ->
+          let m = {<ldepth = ldepth + 1>} in
+          Hashtbl.add h l ldepth ; m#statement s
+      | s -> super#statement s
+  end

test/passing/tests/fun_decl.ml

@@ -21,35 +21,6 @@ let () =
     foooooooooooooooooooooooooooooooooooooooooooooooooooooooo
       foooooooooooooooooooooooooooooooooooooooooooooooooooooooo
 
-[@@@ocamlformat "wrap-fun-args=false"]
-
-let to_loc_trace
-    ?(desc_of_source =
-      fun source ->
-        let callsite = Source.call_site source in
-        Format.asprintf
-          "return from %a"
-          Typ.Procname.pp
-          (CallSite.pname callsite)) ?(source_should_nest = fun _ -> true)
-    ?(desc_of_sink =
-      fun sink ->
-        let callsite = Sink.call_site sink in
-        Format.asprintf
-          "call to %a"
-          Typ.Procname.pp
-          (CallSite.pname callsite)) ?(sink_should_nest = fun _ -> true)
-    (passthroughs, sources, sinks) =
-  ()
-
-let translate_captured
-    { Clang_ast_t.lci_captured_var
-    ; lci_init_captured_vardecl
-    ; lci_capture_this
-    ; lci_capture_kind } ((trans_results_acc, captured_vars_acc) as acc) =
-  ()
-
-[@@@ocamlformat "wrap-fun-args=true"]
-
 let to_loc_trace
     ?(desc_of_source =
       fun source ->
@@ -115,3 +86,13 @@ let _ =
       ~(local_bins : origin Appendable_list.t Filename.Map.t Memo.Lazy.t) ->
     let _ = () in
     ()
+
+class traverse_labels h =
+  object
+    method statement =
+      function
+      | Labelled_statement (L l, (s, _)) ->
+          let m = {<ldepth = ldepth + 1>} in
+          Hashtbl.add h l ldepth ; m#statement s
+      | s -> super#statement s
+  end

test/passing/tests/fun_decl.ml.ref

@@ -0,0 +1,98 @@
+let _ = fun (x : int) : int -> some_large_computation
+
+let _ = fun (x : int) : int -> (some_large_computation : int)
+
+let fooo = List.foooo ~f:(fun foooo foooo : bool -> foooooooooooooooooooooo)
+
+let _ =
+ fun (x : int) (x : int) (x : int) (x : int) (x : int) :
+     fooooooooooooooooooooooooooo foooooooooooooo foooooooooo ->
+  some_large_computation
+
+let _ =
+ fun (x : int) (x : int) (x : int) (x : int) (x : int) (x : int) (x : int) :
+     fooooooooooooooooooooooooooo foooooooooooooo foooooooooo ->
+  some_large_computation
+
+let () =
+ fun x : int ->
+  fun r : int ->
+   fun u ->
+    foooooooooooooooooooooooooooooooooooooooooooooooooooooooo
+      foooooooooooooooooooooooooooooooooooooooooooooooooooooooo
+
+let to_loc_trace
+    ?(desc_of_source =
+      fun source ->
+        let callsite = Source.call_site source in
+        Format.asprintf "return from %a" Typ.Procname.pp
+          (CallSite.pname callsite)) ?(source_should_nest = fun _ -> true)
+    ?(desc_of_sink =
+      fun sink ->
+        let callsite = Sink.call_site sink in
+        Format.asprintf "call to %a" Typ.Procname.pp
+          (CallSite.pname callsite)) ?(sink_should_nest = fun _ -> true)
+    (passthroughs, sources, sinks) =
+  ()
+
+let translate_captured
+    { Clang_ast_t.lci_captured_var
+    ; lci_init_captured_vardecl
+    ; lci_capture_this
+    ; lci_capture_kind } ((trans_results_acc, captured_vars_acc) as acc) =
+  ()
+
+let f ssssssssss =
+  String.fold ssssssssss ~init:innnnnnnnnnit
+    ~f:(fun accuuuuuuuuuum -> function
+    | '0' -> g accuuuuuuuuuum
+    | '1' -> h accuuuuuuuuuum
+    | _ -> i accuuuuuuuuuum )
+
+let f ssssssssss =
+  String.fold ssssssssss ~init:innnnnnnnnnit ~f:(function
+    | '0' -> g accuuuuuuuuuum
+    | '1' -> h accuuuuuuuuuum
+    | _ -> i accuuuuuuuuuum )
+
+let f _ =
+  let foooooooooooooooooooooooooooo = foooooooooooooooooooooooooooo in
+  fun x ->
+    let foooooooooooooooooooooooooooo = foooooooooooooooooooooooooooo in
+    x
+
+let f _ =
+  let foooooooooooooooooooooooooooo = foooooooooooooooooooooooooooo in
+  (* foo *)
+  fun x ->
+    let foooooooooooooooooooooooooooo = foooooooooooooooooooooooooooo in
+    x
+
+let space_break =
+  (* a stack is useless here, this would require adding a unit parameter *)
+  with_pp (fun fs ->
+      Box_debug.space_break fs ;
+      Format_.pp_print_space fs () )
+
+let _ =
+  (fun k ->
+    let _ = 42 in
+    () )
+  @@ ()
+
+let _ =
+  let _ = () in
+  fun (context : Context.t)
+      ~(local_bins : origin Appendable_list.t Filename.Map.t Memo.Lazy.t) ->
+    let _ = () in
+    ()
+
+class traverse_labels h =
+  object
+    method statement =
+      function
+      | Labelled_statement (L l, (s, _)) ->
+          let m = {<ldepth = ldepth + 1>} in
+          Hashtbl.add h l ldepth ; m#statement s
+      | s -> super#statement s
+  end

test/passing/tests/issue289.ml

@@ -12,22 +12,22 @@ let foo =
       ~args:[]
       ~typ:(non_null guid)
       ~resolve:(function
-        | A -> x.id
-        | B -> c )
+      | A -> x.id
+      | B -> c )
   ; field "id" ~doc:"Toy ID." ~args:[] ~resolve:(function
-        | A -> x.id
-        | B -> c )
+      | A -> x.id
+      | B -> c )
   ; field
       "id"
       ~doc:"Toy ID."
       ~args:[]
       ~typppppppppppppppppppp
       ~resolve:(function
-        | AAAAAAAAAAAAAAAAAAAa -> x.idddddddddddddddddddddddddd
-        | BBBBBBBBBBBBBBBB -> ccccccccccccccccccccccc )
+      | AAAAAAAAAAAAAAAAAAAa -> x.idddddddddddddddddddddddddd
+      | BBBBBBBBBBBBBBBB -> ccccccccccccccccccccccc )
   ; field "id" ~doc:"Toy ID." ~args:[] ~resolve:(function
-        | AAAAAAAAAAAAAAAAAAAa -> x.idddddddddddddddddddddddddd
-        | BBBBBBBBBBBBBBBB -> ccccccccccccccccccccccc )
+      | AAAAAAAAAAAAAAAAAAAa -> x.idddddddddddddddddddddddddd
+      | BBBBBBBBBBBBBBBB -> ccccccccccccccccccccccc )
   ; field
       "id"
       ~doc:"Toy ID."