Do not re-format Qtest comments

CHANGES.md

@@ -8,9 +8,11 @@
 
 #### Changes
 
+  + Qtest comments are not re-formatted (#2034, @gpetiot)
+
 #### New features
 
-  +  New syntax `(*= ... *)` for verbatim comments (#2028, @gpetiot)
+  + New syntax `(*= ... *)` for verbatim comments (#2028, @gpetiot)
 
 ### 0.21.0 (2022-02-25)
 

lib/Cmts.ml

@@ -574,6 +574,8 @@ let fmt_cmt (cmt : Cmt.t) ~wrap:wrap_comments ~ocp_indent_compat ~fmt_code
     | "*" when Location.width cmt.loc = 4 -> `Verbatim ""
     | "*" -> `Verbatim "*"
     | "$" -> `Verbatim "$"
+    | str when Char.(str.[0] = '$' && not (is_whitespace str.[1])) ->
+        `Qtest cmt
     | str when Char.equal str.[0] '$' -> (
         let dollar_suf = Char.equal str.[String.length str - 1] '$' in
         let cls : Fmt.s = if dollar_suf then "$*)" else "*)" in
@@ -599,6 +601,7 @@ let fmt_cmt (cmt : Cmt.t) ~wrap:wrap_comments ~ocp_indent_compat ~fmt_code
   | `Wrapped (x, epi) -> str "(*" $ fill_text x ~epi
   | `Unwrapped x when ocp_indent_compat -> Verbatim.fmt x.txt pos
   | `Unwrapped x -> Unwrapped.fmt x
+  | `Qtest x -> Verbatim.fmt x.txt pos
   | `Asterisk_prefixed x -> Asterisk_prefixed.fmt x
 
 let fmt_cmts_aux t (conf : Conf.t) cmts ~fmt_code pos =

test/passing/dune.inc

@@ -4213,6 +4213,24 @@
  (package ocamlformat)
  (action (diff tests/protected_object_types.ml.err protected_object_types.ml.stderr)))
 
+(rule
+ (deps tests/.ocamlformat )
+ (package ocamlformat)
+ (action
+  (with-stdout-to qtest.ml.stdout
+   (with-stderr-to qtest.ml.stderr
+     (run %{bin:ocamlformat} --margin-check %{dep:tests/qtest.ml})))))
+
+(rule
+ (alias runtest)
+ (package ocamlformat)
+ (action (diff tests/qtest.ml qtest.ml.stdout)))
+
+(rule
+ (alias runtest)
+ (package ocamlformat)
+ (action (diff tests/qtest.ml.err qtest.ml.stderr)))
+
 (rule
  (deps tests/.ocamlformat )
  (package ocamlformat)

test/passing/tests/qtest.ml

@@ -0,0 +1,59 @@
+(*$T
+  false
+*)
+
+(*$T foo
+  foo  0 ( + ) [1;2;3] = 6  (* hehe *)
+  foo  0 ( * ) [1;2;3] = 0  (* haha (*hoho *) *)
+  foo  1 ( * ) [4;5]   = 20
+  foo 12 ( + ) []      = 12
+*)
+
+(*$T foo
+  foo 1 ( * ) [4;5] = foo 2 ( * ) [1;5;2]
+*)
+
+(*$= foo & ~printer:string_of_int
+  (foo 1 ( * ) [4;5]) (foo 2 ( * ) [1;5;2])
+*)
+
+(*$Q foo
+  Q.small_int (fun i-> foo i (+) [1;2;3] = List.fold_left (+) i [1;2;3])
+  (Q.pair Q.small_int (Q.list Q.small_int)) (fun (i,l)-> foo i (+) l = List.fold_left (+) i l)
+*)
+
+(*$R foo
+  let thing = foo  1 ( * )
+  and li = [4;5] in
+  assert_bool "something_witty" (thing li = 20);
+   (* pertinent comment *)
+  assert_bool "something_wittier" (1=1)
+*)
+
+(*$inject let brom = baz *)
+(*$T brom
+  brom.[2] = 'z'
+*)
+
+(*$T &
+             1    = 2-1
+            2+3 \
+              = \
+              \
+              5
+
+  1+1=2
+*)
+
+(*$T & 6 \
+  & =
+  2*3
+*)
+
+(*$Q & ~count:10
+  (Q.small_int_corners ()) (fun n-> n+3 -2 -1 = abs n)
+*)
+
+(*$Q & ~max_gen:1000000 ~count:1000000
+    (Q.make (fun _ -> ())) (fun () -> true)
+*)

test/passing/tests/qtest.ml.err

@@ -0,0 +1 @@
+Warning: tests/qtest.ml:21 exceeds the margin