branch: elpa/tuareg
commit fa87a105dab53d3d17553c071dae53a2e5c744e5
Author: Mattias Engdegård <matti...@acm.org>
Commit: Stefan Monnier <monn...@iro.umontreal.ca>
Put indentation tests in ERT
Move the currently failing parts of indent-test.ml to
indent-test-failed.ml and test them both as separate tests
in tuareg-tests.el. They are now run as part of the CI.
Similarly, move everything from sample.ml to indent-test{-failed}.ml.
---
.travis.yml | 3 +-
Makefile | 6 +-
indent-test-failed.ml | 241 +++++++++
indent-test.ml | 1322 ++++++++++++++++++++++++++++++++++++++++++++-----
sample.ml | 1296 ------------------------------------------------
tuareg-tests.el | 47 ++
6 files changed, 1481 insertions(+), 1434 deletions(-)
diff --git a/.travis.yml b/.travis.yml
index 491b08b..2c93b41 100644
--- a/.travis.yml
+++ b/.travis.yml
@@ -19,8 +19,7 @@ before_install:
script:
- emacs --version
- make elc
- - make check-ert
- - make indent-test
+ - make check
notifications:
email: true
diff --git a/Makefile b/Makefile
index 7e23a23..a7163c0 100644
--- a/Makefile
+++ b/Makefile
@@ -65,10 +65,8 @@ uninstall :
.PHONY: refresh
refresh:
-check : sample.ml.test check-ert
-
-.PHONY: check-ert
-check-ert:
+.PHONY: check
+check:
$(EMACS) -batch -Q -L . -l tuareg-tests -f ert-run-tests-batch-and-exit
%.test: % $(ELC) refresh
diff --git a/indent-test-failed.ml b/indent-test-failed.ml
new file mode 100644
index 0000000..8936ddf
--- /dev/null
+++ b/indent-test-failed.ml
@@ -0,0 +1,241 @@
+(* This fail contains code samples that are currently not indented
+ properly.
+
+ As indentation bugs are fixed, the corresponding samples should
+ be moved to the file indent-test.ml. *)
+
+let quux list = List.map list ~f:(fun item ->
+ print_item item
+ )
+
+let h x =
+ try ff a b
+ c d;
+ gg 1 2
+ 3 4;
+ with e -> raise e
+
+let x = foo ~f:(fun _ -> 0 (* Comment. *)
+ )
+
+let () =
+ foo (sprintf ("a: %s"
+ ^ " b: %s")
+ a
+ b)
+
+let () =
+ Hashtbl.iter times ~f:(fun ~key:time ~data:azot ->
+ Clock.at time
+ >>> fun () ->
+ Db.iter t.db ~f:(fun dbo ->
+ if S.mem azot (Dbo.azo dbo) then
+ Dbo.dont dbo))
+
+let w f =
+ List.map f ~f:(fun (a, b) ->
+ L.r a
+ >>= function
+ | Ok s -> `Fst (b, s)
+ | Error e -> `Snd (b, a, e))
+
+let a =
+ B.c d ~e:f [
+ "g";
+ "h";
+ ]
+
+let a =
+ foo
+ ~f:(fun () -> a
+ )
+
+let () =
+ (* Comment. *)
+ bar a b
+ c d;
+ foo ~size
+ (* Comment. *)
+ ~min:foo
+ ?reduce
+ ?override
+ ()
+
+let foo =
+ (* Comment. *)
+ List.map z
+ ~f:(fun m ->
+ M.q m
+ |! T.u ~pr ~verbose:false
+ ~p:H.P.US ~is_bar:false)
+ |! List.sort ~cmp:(fun a b ->
+ compare
+ (I.r a.T.s)
+ (I.r b.T.s))
+
+let () =
+ snoo ~f:(fun foo ->
+ foo = bar
+ && snoo)
+
+let () =
+ snoo ~f:(fun foo ->
+ foo + bar
+ && snoo)
+
+let () =
+ snoo ~f:(fun foo ->
+ foo
+ && snoo)
+
+let variants a =
+ match String.split a ~on:'-' with
+ | [ s1; s2; s3 ] ->
+ let a0 = String.concat ~sep:"" [ s1; s2] in
+ let a1 = String.concat ~sep:"-" [ s1; s2; s3; "055" ] in (* Comment. *)
+ List.map [ a0; a1; a]
+ ~f:(fun a_s -> lookup a_s)
+ |! List.flatten
+ | _ -> failwith "bad"
+
+let optional_sci_float =
+ do_something ~a:1e-7
+ ~b:(fun x -> x + 1)
+
+let array_args =
+ fold s multi_sms.(0).message_number folder
+ more_args (* FIXME *)
+
+let () =
+ match var with
+ | <:expr< $lid:f$ >> ->
+ KO
+ | <:expr< $lid:f$ >> when f x ->
+ KO
+ | y when f y ->
+ OK
+ | long_pattern
+ when f long_pattern -> (* Should be more indented than the clause body
*)
+ z
+
+let subscribe_impl dir topic ~aborted =
+ return (
+ match Directory.subscribe dir topic with
+ | None -> Error ()
+ | Some pipe ->
+ whenever (aborted >>| fun () -> Pipe.close_read pipe);
+ Ok pipe
+ )
+ next_argument (* should be indented correctly, given the braces *)
+
+
+let command =
+ Command.Spec.(
+ empty
+ +> flag "-hello" (optional_with_default "Hello" string)
+ ~doc:" The 'hello' of 'hello world'"
+ +> flag "-world" (optional_with_default "World" string)
+ ~doc:" The 'world' of 'hello world'"
+ )
+
+let server_comments request t =
+ t >>= Grep.server_comments
+ lazy
+ parser
+ every
+
+let x = match y, z with
+ | A, (B | C)
+ | X, Y -> do_something() (* Issue #78 *)
+
+type t = a
+ and typey = 4
+ and x = b
+
+type 'a v = id:O.t ->
+ ssss:Ssss.t ->
+ dddd:ddd.t ->
+ t:S_m.t ->
+ mmm:Safe_float.t ->
+ qqq:int ->
+ c:C.t ->
+ uuuu:string option ->
+ aaaaaa:Aaaaaa.t ->
+ a:A.t ->
+ rrrrr:Rrrrr.t ->
+ time:Time.t ->
+ typ:[ `L_p of Safe_float.t ] ->
+ bazonk:present option ->
+ o_p_e:O_m.t option ->
+ only_hjkl:present option ->
+ show_junk:int option ->
+ d_p_o: Safe_float.t option ->
+ asdf:present option ->
+ generic:Sexp.t list ->
+ 'a
+
+let () =
+ try f a
+ with A () ->
+ ()
+ | B () ->
+ ()
+ | C () ->
+ ()
+
+let () =
+ match _ with
+ | foo ->
+ bar
+ >>| function _ ->
+ _
+
+let foo x =
+ f1 x >= f2 x
+ && f3
+ (f4 x)
+
+let foo x =
+ (>=)
+ (f1 x) (f2 x)
+ && f3
+ (f4 x)
+
+let splitting_long_expression =
+ quad.{band, i3} <- quad.{band, i3} +. g +.
+ area_12 *. (P.potential x13 y13 +. P.potential x23 y23)
+
+let x =
+ try a
+ with Not_found ->
+ b
+ | _ ->
+ c
+let x =
+ try a
+ with Not_found ->
+ if a then b
+ | flag when String.is_prefix flag ~prefix:"-" ->
+ a
+ | _ ->
+ c
+
+let () =
+ match var with
+ | <:expr< $lid:f$ >> ->
+ KO
+ | <:expr< $lid:f$ >> when f x ->
+ KO
+ | y when f y ->
+ OK
+ | long_pattern
+ when f long_pattern -> (* Should be more indented than the clause body
*)
+ z
+
+let _ =
+ List.map
+ (function x ->
+ blabla (* FIXME: indentation afer "(function" *)
+ blabla
+ blabla)
+ l
diff --git a/indent-test.ml b/indent-test.ml
index 1bd4ac7..87e0dab 100644
--- a/indent-test.ml
+++ b/indent-test.ml
@@ -4,12 +4,10 @@
* - the indentation is acceptable (maybe not perfect for everyone,
* but at least correct for some users).
* - the indentation code does find this indentation.
- * We use this for regression testing: "make indent-test" should normally
- * show no changes, and if it does show changes it should be improvements.
+ * This file is used for regression testing in tuareg-tests.el.
*
- * This is in contrast to sample.ml which contains indentation layouts
- * which the indentation code doesn't know how to find, so it's normal
- * for "make sample.ml.test" to show changes which are regressions.
+ * This is in contrast to indent-test-failed.ml which contains indentation
+ * layouts which the indentation code doesn't know how to find.
*)
let server_comments request t =
@@ -443,10 +441,6 @@ let foo =
else c
)
-let quux list = List.map list ~f:(fun item ->
- print_item item
- )
-
let foo x = function
| Some _ -> true
| None -> false
@@ -482,13 +476,6 @@ let g x =
y x;
with e -> raise e
-let h x =
- try ff a b
- c d;
- gg 1 2
- 3 4;
- with e -> raise e
-
let () =
try
_
@@ -538,9 +525,6 @@ let a f = function
| 4 -> 3
| 5 -> 7)
-let x = foo ~f:(fun _ -> 0 (* Comment. *)
- )
-
let f = function x ->
y
@@ -620,12 +604,6 @@ let () = (try
with _ -> ())
let () =
- foo (sprintf ("a: %s"
- ^ " b: %s")
- a
- b)
-
-let () =
try f a
with A () ->
()
@@ -802,14 +780,6 @@ let () =
x
let () =
- Hashtbl.iter times ~f:(fun ~key:time ~data:azot ->
- Clock.at time
- >>> fun () ->
- Db.iter t.db ~f:(fun dbo ->
- if S.mem azot (Dbo.azo dbo) then
- Dbo.dont dbo))
-
-let () =
f 1
|! (fun x ->
g x x)
@@ -880,13 +850,6 @@ let () =
step1
>>= fun () -> step2)
-let w f =
- List.map f ~f:(fun (a, b) ->
- L.r a
- >>= function
- | Ok s -> `Fst (b, s)
- | Error e -> `Snd (b, a, e))
-
class c (a : b) =
object
inherit d
@@ -912,12 +875,6 @@ let () =
printf "%d" i;
done
-let a =
- B.c d ~e:f [
- "g";
- "h";
- ]
-
let () =
f a ~b:c ~d ~e:g
u ~q:[
@@ -1018,64 +975,11 @@ let a =
(fun () -> a
)
-let a =
- foo
- ~f:(fun () -> a
- )
-
-let () =
- (* Comment. *)
- bar a b
- c d;
- foo ~size
- (* Comment. *)
- ~min:foo
- ?reduce
- ?override
- ()
-
-let foo =
- (* Comment. *)
- List.map z
- ~f:(fun m ->
- M.q m
- |! T.u ~pr ~verbose:false
- ~p:H.P.US ~is_bar:false)
- |! List.sort ~cmp:(fun a b ->
- compare
- (I.r a.T.s)
- (I.r b.T.s))
-
let check =
a lsr 30 >= 3
&& b lsr 20 >= 1
&& c * 10 > f
-let () =
- snoo ~f:(fun foo ->
- foo = bar
- && snoo)
-
-let () =
- snoo ~f:(fun foo ->
- foo + bar
- && snoo)
-
-let () =
- snoo ~f:(fun foo ->
- foo
- && snoo)
-
-let variants a =
- match String.split a ~on:'-' with
- | [ s1; s2; s3 ] ->
- let a0 = String.concat ~sep:"" [ s1; s2] in
- let a1 = String.concat ~sep:"-" [ s1; s2; s3; "055" ] in (* Comment. *)
- List.map [ a0; a1; a]
- ~f:(fun a_s -> lookup a_s)
- |! List.flatten
- | _ -> failwith "bad"
-
let f a1 a2 a3
b1 b2 b3 d1 d2 d3 = {
aa = func1 a1 a2 a3;
@@ -1197,32 +1101,12 @@ let x =
let x = "toto try \
tata"
-let optional_sci_float =
- do_something ~a:1e-7
- ~b:(fun x -> x + 1)
-
let () =
f x ~tol:1.0
more arguments;
f x ~tol:1.
more arguments
-let array_args =
- fold s multi_sms.(0).message_number folder
- more_args (* FIXME *)
-
-let () =
- match var with
- | <:expr< $lid:f$ >> ->
- KO
- | <:expr< $lid:f$ >> when f x ->
- KO
- | y when f y ->
- OK
- | long_pattern
- when f long_pattern -> (* Should be more indented than the clause body
*)
- z
-
type t = {
mutable a: float;
b : int;
@@ -1298,17 +1182,6 @@ val f :
int ->
int
-let subscribe_impl dir topic ~aborted =
- return (
- match Directory.subscribe dir topic with
- | None -> Error ()
- | Some pipe ->
- whenever (aborted >>| fun () -> Pipe.close_read pipe);
- Ok pipe
- )
- next_argument (* should be indented correctly, given the braces *)
-
-
let x = List.map
(function x ->
blabla
@@ -1316,11 +1189,1196 @@ let x = List.map
blabla)
l
+let server_comments request t =
+ let module M = N in
+ let class M = N in
+ let m M = N in
+ let module M = N in
+ let open Grep.Server in
+ let x = 5 in
+ let modue x y = 5 in
+ let open M in
+ something
+
+let qs1 = {| quoted string |} (* (issue #24) *)
+let qs2 = {eof| other quoted string |noteof} |eof}
+
+(* ocp-indent does it as follows:
+let test1 = with_connection (fun conn ->
+ do_something conn x;
+ ...
+ )
+ toto
+ *)
+let test1 = with_connection (fun conn ->
+ do_something conn x;
+ ...
+ )
+ toto
+
+let x = match y with (* Issue #71 *)
+ | A | B ->
+ do_something ()
+
+let x =
+ begin match y with
+ | A -> 1 (* Issue #73 *)
+ end
+
+(* The two "let"s below are indented under the assumption that
+ tuareg-indent-align-with-first-arg is nil! *)
+let x = List.map (fun x -> 5)
+ my list
+
+let x =
+ logf `Info "User %s has %i new messages" ba
+ (Uid.to_string uid)
+ (List.length new_messages)
+
+let x =
+ let open M in
+ let x = 5 in
+ x + x
+;;
+
+(* FIXME: MAJOR "function" sends SMIE into a loop (fine with "fun").
+ Use M-q to test. *)
+let () =
+ let z = function t -> a in
+ foo z
+
+let () =
+ foo(function t -> a)
+;;
+
+(* FIXME: MAJOR: M-q on the "(" raises 'Scan error: "Unbalanced
+ parentheses"'. It is fine if both () are on the same line. *)
+let () =
+ begin
+ (begin
+ end)
+ end
+;;
+
+;; (* http://caml.inria.fr/mantis/view.php?id=4247 *)
+let x = {
+ Foo.
+ a = b;
+ c = d;
+ e = {Bar.
+ f = 1;
+ g = 2;
+ };
+ h = { Quux.
+ i = 3;
+ j = 4;
+ };
+ }
+
+;; (* http://caml.inria.fr/mantis/view.php?id=4249 *)
+let x = { a = b;
+ c = d;
+ }
+
+;; (* http://caml.inria.fr/mantis/view.php?id=4255 *)
+{ foo: [ `Foo of int
+ | `Bar of string ];
+}
+
+let s = { a with
+ b = 1;
+ }
+;;
+
+let a = {
+ M.
+ foo = foo;
+ bar = bar;
+ }
+
+let a = { t with M.
+ foo = foo;
+ bar = bar;
+ }
+
+(* MetaOCaml thingies, issue #195. *)
+let f x = .< 0.0 + g .~ x
+ 5
+ * 7
+ + .<.~x
+ +. 10>.
+ >.
+
+let a = { t with
+ M.
+ foo = foo;
+ bar = bar;
+ }
+
+type t = [ `Foo of int
+ | `Bar of string ]
+
+type t =
+ | A
+ | B (* issue #76 *)
+ | C
+with sexp
+
+type t = | A
+ | B
+ | C
+
+type t = [
+ | `A
+ | `B
+ | `C
+ ]
+
+type t = [ (* Comment. *)
+ | `A
+ | `B
+ | `C
+ ]
+
+module M = struct
+ type t =
+ | A
+ | B
+ | C
+ with sexp
+
+ type s = [
+ | `A
+ | `B
+ | `C
+ ]
+
+ type u =
+ | D
+ | E
+ with sexp
+end
+
+module N =
+ struct
+ type u =
+ | D
+ | E
+ with sexp
+ end
+
+type m =
+ | T
+with sexp
+
+let f = function
+ | A -> 1
+ | B | C -> 2
+
+;; (* http://caml.inria.fr/mantis/view.php?id=4334 *)
+type foo =
+ a
+ -> b
+ -> c
+ -> d
+
+val f :
+ a:a
+ -> b:b
+ -> c:c
+
+type bar = a -> b
+ -> c -> d
+ -> e -> f
+
+type baz = a -> b ->
+ c -> d ->
+ e -> f
+
+val quux : a -> b ->
+ c -> d ->
+ e -> f
+
+type t : a:b -> c:d
+ -> e:f -> g
+
+val f : a:b -> c:d
+ -> e:f -> g
+
+type t = {
+ foo : (a
+ -> b
+ -> c
+ -> d);
+ }
+
+type t = {
+ foo : ( a ->
+ b ->
+ c ->
+ d);
+ }
+
+type t = {
+ foo : a
+ -> b
+ -> c
+ -> d;
+ bar :
+ a
+ -> b
+ -> c;
+ }
+
+type t = {
+ foo : a ->
+ b ->
+ c ->
+ d;
+ bar :
+ a ->
+ b ->
+ c;
+ }
+
+type t = {
+ a : B.t;
+ c : D.t;
+
+ e : F.t;
+
+ g : H.t I.t;
+ j :
+ K.t L.t;
+ m : N.t O.t;
+ p :
+ ((q:R.t
+ -> s:T.U.t
+ -> v:(W.t -> X.t option)
+ -> y:(Z.t -> A.t -> B.t C.D.t E.t)
+ -> f:(G.t -> H.t I.t option)
+ -> j:(K.t -> L.t M.t option)
+ -> n:(O.t -> p option)
+ -> q:R.t
+ -> s:(string -> unit) -> T.t
+ )
+ -> U.t
+ -> V.W.t
+ -> X.t);
+ y : Z.t A.t;
+ b : C.t D.t E.t;
+ f : (G.t -> H.t -> I.t J.t);
+ } with sexp_of
+
+type 'a v =
+ id:O.t
+ -> ssss:Ssss.t
+ -> dddd:ddd.t
+ -> t:S_m.t
+ -> mmm:Safe_float.t
+ -> qqq:int
+ -> c:C.t
+ -> uuuu:string option
+ -> aaaaaa:Aaaaaa.t
+ -> a:A.t
+ -> rrrrr:Rrrrr.t
+ -> time:Time.t
+ -> typ:[ `L_p of Safe_float.t ]
+ -> bazonk:present option
+ -> o_p_e:O_m.t option
+ -> only_hjkl:present option
+ -> show_junk:int option
+ -> d_p_o: Safe_float.t option
+ -> asdf:present option
+ -> generic:Sexp.t list
+ -> 'a
+
+;; (* Not in mantis. *)
+let bar x =
+ if y
+ then x
+ else z
+
+let zot x =
+ quux ~f:(if x
+ then y
+ else z)
+
+let zot x = quux ~f:(if x
+ then y
+ else z)
+
+let () =
+ if foo
+ then bar
+ else if foo1
+ then zot
+ else bazonk
+
+let () =
+ if foo
+ then bar
+ else
+ if foo1
+ then zot
+ else bazonk
+
+let _ =
+ if until
+ then _
+
+let () =
+ if a then (
+ b
+ ) else (
+ c
+ )
+
+let rec count_append l1 l2 count =
+ (* http://caml.inria.fr/resources/doc/guides/guidelines.en.html *)
+ match l1 with
+ | [] -> l2
+ | [x1] -> x1 :: l2
+ | [x1; x2] -> x1 :: x2 :: l2
+ | [x1; x2; x3] -> x1 :: x2 :: x3 :: l2
+ | [x1; x2; x3; x4] -> x1 :: x2 :: x3 :: x4 :: l2
+ | x1 :: x2 :: x3 :: x4 :: x5 :: tl ->
+ x1 :: x2 :: x3 :: x4 :: x5 ::
+ (if count > 1000
+ then slow_append tl l2
+ else count_append tl l2 (count + 1))
+ (* New in OCaml-4.02. *)
+ | exception Not_Found ->
+ l2
+
+
+let x =
+ match x with
+ | Foo of
+ < tag : t; (* FIXME *)
+ md : t;
+ is_me : t;
+ >
+;;
+
+let x =
+ match x with
+ | Foo of
+ <
+ tag : t; (* FIXME *)
+ md : t;
+ is_me : t;
+ >
+;;
+
+let foo =
+ (
+ if a
+ then b
+ else c
+ )
+
+let quux list = List.map list ~f:(fun item ->
+ print_item item
+ )
+
+let foo x = function
+ | Some _ -> true
+ | None -> false
+
+let bar x = fun u ->
+ match u with
+ | Some _ -> true
+ | None -> false
+
+let zot u = match u with
+ | Some _ -> true
+ | None -> false
+
+let () = match x with
+ Foo -> 1
+ | Bar -> 2
+
+let () =
+ match x with
+ Foo -> 1
+ | Bar -> 2
+
+let r x =
+ try f x;
+ g x;
+ y x;
+ with e -> raise e
+
+let g x =
+ try let a = b in
+ f x;
+ g x;
+ y x;
+ with e -> raise e
+
+let h x =
+ try ff a b
+ c d;
+ gg 1 2
+ 3 4;
+ with e -> raise e
+
+let () =
+ try
+ _
+ with
+ Bar -> ()
+
+let () =
+ (* http://caml.inria.fr/resources/doc/guides/guidelines.en.html *)
+ try () with
+ | e ->
+ let x = z in
+
+ yyyyy
+ (a b)
+
+let d x = function
+ (* FIXME: Should we leave it like this or align "|" with "match"?
+ I chose with "match" because it looks otherwise odd and is more
+ consistent with the "try" alignments above. *)
+ | A -> (match x with
+ | X ->
+ false
+ | Y -> true
+ | Z ->
+ false)
+ | B -> false
+
+let a f = function
+ | A ->
+ 1
+ | B ->
+ 2
+ | C ->
+ (function
+ | X ->
+ a
+ | Y ->
+ b) 12
+ | D ->
+ (match z with
+ | 4 -> 3
+ | 5 -> 7)
+
+let x = foo ~f:(fun _ -> 0 (* Comment. *)
+ )
+
+let f x =
+ (let y = x in
+ f x;
+ g y;
+ h z)
+
+let f x =
+ (let y = x in
+ f x);
+ g y;
+ h z
+
+let g y =
+ a b;
+ c d;
+ e f;
+ (* Comment. *)
+ g h;
+ i j
+
+let () =
+ (let a = 1 in
+ let b = 2 in
+ ( a,
+ b))
+
+let () =
+ ((a b
+ c d e,
+ f g h),
+ ( i j
+ k l,
+ m n
+ o p))
+
+let () =
+ if a
+ then
+ let b = P.s ~b ~a ~m in
+ a +. e *. b,
+ b -. e *. b
+ else
+ q.a -. s *. z,
+ q.b +. s *. z
+
+let () =
+ (* Comment. *)
+ (let x =
+ 3
+ in
+ x + 5)
+
+let x =
+ let foo = 1 and bar = 2 and zot = 3 in
+ let quux = 4 in
+ foo
+ + bar
+ + zot
+ + quux
+
+(* Indent comment to following code. *)
+let () =
+ try (* foo!
+ bar *)
+ let a = f g c d in
+ a b
+ with _ -> ()
+
+let () = try
+ f x;
+ with _ -> ()
+
+let () = (try
+ f x;
+ with _ -> ())
+
+let () =
+ foo (sprintf ("a: %s"
+ ^ " b: %s")
+ a
+ b)
+
+let f errors input =
+ let ( @@ ) string bool = if not bool then errors := string :: !errors in
+ input @@ false
+
+let x =
+ if mode = foo then bar;
+ conn
+ >>| fun x -> x + 1
+ >>| fun x -> x + 1
+ >>| fun x -> x + 1
+
+let () =
+ a
+ >>= fun () ->
+ b
+ >>| fun () ->
+ Deferred.all
+
+let x =
+ v
+ >>= fun x -> y
+ >>= fun z -> w
+ >>= fun q -> r
+
+let x =
+ v 1 2
+ 3 4
+ 5 6 >>= fun x ->
+ y+1 >>= (* foo! *) fun z ->
+ f 1 2 3
+ 4 5 6 >>= fun y ->
+ w*3 >>= fun q -> r
+
+(* This does not work, see comment in tuareg-compute-arrow-indent.
+ * Workaround: wrap code in parens. *)
+(* let () =
+ * match
+ * a 1 2 3
+ * 4 5 6 >>= fun a ->
+ * b >>= fun b ->
+ * c
+ * with
+ * | A -> _ *)
+
+let () =
+ match
+ let a = a in
+ let b = b in
+ c
+ with
+ | A -> _
+
+let () =
+ match
+ (a >>= fun a ->
+ b >>= fun b ->
+ c)
+ with
+ A -> _
+
+let f t =
+ let (a, b) = to_open in
+ let c = g t a b in
+ ()
+
+let () =
+ begin
+ foo bar
+ end
+ >>= fun () ->
+ begin
+ foo
+ bar
+ end
+ >>= fun () ->
+ ()
+
+let () =
+ (
+ foo bar
+ )
+ >>= fun () ->
+ (
+ foo
+ bar
+ )
+ >>= fun () ->
+ ()
+
+let () =
+ match e with
+ | `T d ->
+ notify `O `T d;
+ cancel t u ~now
+
+let () =
+ let a = 1
+ and b = 2
+ and c = 3 in
+ a + b + c
+
+let _ =
+ foo bar
+ || snoo blue
+
+let _ =
+ (
+ foo bar
+ || snoo blue
+ )
+
+let _ =
+ (foo bar
+ || snoo blue)
+
+let () =
+ Config.load ()
+ >>> fun config ->
+ let quux = config.Config.bazonk.Config.Bazonk.quux in
+ load_quux ~input quux config
+ >>> fun quux ->
+ let da = Poo.Snapshot.merge quux in
+ load_foobar config ~input
+ >>> fun foobar ->
+ whatever foobar
+
+let () =
+ a
+ >>> fun () ->
+ b
+
+let () =
+ a
+ >>= function
+ | b -> c
+ | d ->
+ e
+ >>= f
+
+let () =
+ foo >>> fun bar ->
+ baz >>> fun zot ->
+ quux
+
+let () =
+ Config.load ()
+ >>> fun config ->
+ let quux = x in
+ x
+ >>= fun quux ->
+ x
+
+let () =
+ Config.load ()
+ >>= fun config ->
+ let quux = x in
+ x
+ >>= fun quux ->
+ x
+
+let () =
+ Hashtbl.iter times ~f:(fun ~key:time ~data:azot ->
+ Clock.at time
+ >>> fun () ->
+ Db.iter t.db ~f:(fun dbo ->
+ if S.mem azot (Dbo.azo dbo) then
+ Dbo.dont dbo))
+
+let () =
+ f 1
+ |> (fun x ->
+ g x x)
+ |> (fun y ->
+ h y y)
+
+let () =
+ (let a,b = match c with
+ | D -> e,f
+ | G -> h,i in
+ let j = a + b in
+ j * j),
+ 12
+
+module type M = M2
+ with type t1 = int
+ and type t2 = int
+ and module S = M3
+ with type t2 = int
+ with type t3 = int
+
+let () =
+ try
+ match () with
+ | () -> ()
+ with _ -> ()
+
+let () =
+ try
+ ()
+ with _ -> ()
+
+let () =
+ ( try ()
+ with _ -> ())
+
+let x =
+ foo ~bar
+ @ snoo
+
+let x =
+ foo ~bar:snoo
+ @ snoo
+
+let () =
+ tagL "ol" (List.map ~f:(tag ~a:[] "li") (
+ (List.map results ~f:(fun (what,_) ->
+ tag "a" ~a:[("href","#" ^ what)] (what_title what)))
+ @ [tag "a" ~a:[("href","#" ^ message_id)] message_title;
+ tag "a" ~a:[("href","#" ^ legend_id)] legend_title]))
+ |> IO.println out
+
+let x =
+ let y =
+ (a
+ ^ b
+ ^ c) in
+ f ~a:b ?c:d
+ ?e:f ~g:(h i j)
+ ~k:(l m)
+ (n o p)
+
+let () =
+ foobar (fun () ->
+ step1
+ >>= fun () -> step2)
+
+let w f =
+ List.map f ~f:(fun (a, b) ->
+ L.r a
+ >>= function
+ | Ok s -> `Fst (b, s)
+ | Error e -> `Snd (b, a, e))
+
+class c (a : b) =
+object
+ inherit d
+ method m = 1
+end
+
+let f = {
+ a = 1;
+ }
+
+let f a = {
+ a = a;
+ }
+
+let f a
+ b = {
+ a = a;
+ b = b;
+ }
+
+let () =
+ for i = 10 to 17 do
+ printf "%d" i;
+ done
+
+let a =
+ B.c d ~e:f [
+ "g";
+ "h";
+ ]
+
+let () =
+ f a ~b:c ~d ~e:g
+ u ~q:[
+ "a";
+ "b";
+ ]
+
+let a = match b with
+ | Some c -> Some {
+ d = c;
+ e = e
+ }
+ | None -> {
+ d = c;
+ e = e
+ }
+
+let a = {
+ b = (
+ let z = f u in
+ z + z;
+ );
+ c = (let a = b in {
+ z = z;
+ y = h;
+ });
+ }
+
+let () =
+ { A.
+ b =
+ C.d e ~f:(fun g -> (h.I.j.K.l, m))
+ |> begin fun n ->
+ match O.p n with
+ | `Q r -> r
+ | `S _k -> assert false
+ end;
+ t =
+ u ~v:w
+ ~x:(Y.z a);
+ b =
+ c ~d:e
+ ~f:(G.h i);
+ j =
+ K.l (fun m -> (N.o p m).R.S.t);
+ u =
+ V.w (fun x -> (Y.x a x).R.S.t);
+ v =
+ V.w (fun d ->
+ (D.g i d).R.S.z);
+ }
+
+let x =
+ [(W.background `Blue (W.hbox [
+ x
+ ]));
+ ]
+
+let c f =
+ if S.is_file f then
+ S.load f C.t
+ |> fun x -> c := Some x
+ else
+ C.s C.default |> S.save f
+ |> fun () -> c := None
+
+let c f =
+ if S.is_file f then (
+ S.load f C.t
+ |> fun x -> c := Some x
+ ) else (
+ C.s C.default |> S.save f
+ |> fun () -> c := None)
+
+let a =
+ foo
+ (fun () ->
+ a)
+
+let a =
+ foo
+ ~f:(fun () ->
+ a)
+
+let a =
+ foo
+ (fun () -> a
+ )
+
+let a =
+ foo
+ ~f:(fun () -> a
+ )
+
+let () =
+ (* Comment. *)
+ bar a b
+ c d;
+ foo ~size
+ (* Comment. *)
+ ~min:foo
+ ?reduce
+ ?override
+ ()
+
+let foo =
+ (* Comment. *)
+ List.map z
+ ~f:(fun m ->
+ M.q m
+ |> T.u ~pr ~verbose:false
+ ~p:H.P.US ~is_bar:false)
+ |> List.sort ~cmp:(fun a b ->
+ compare
+ (I.r a.T.s)
+ (I.r b.T.s))
+
+let check =
+ a lsr 30 >= 3
+ && b lsr 20 >= 1
+ && c * 10 > f
+
+let () =
+ snoo ~f:(fun foo ->
+ foo = bar
+ && snoo)
+
+let () =
+ snoo ~f:(fun foo ->
+ foo + bar
+ && snoo)
+
+let () =
+ snoo ~f:(fun foo ->
+ foo
+ && snoo)
+
+let variants a =
+ match String.split a ~on:'-' with
+ | [ s1; s2; s3 ] ->
+ let a0 = String.concat ~sep:"" [ s1; s2] in
+ let a1 = String.concat ~sep:"-" [ s1; s2; s3; "055" ] in (* Comment. *)
+ List.map [ a0; a1; a]
+ ~f:(fun a_s -> lookup a_s)
+ |> List.flatten
+ | _ -> failwith "bad"
+
+let f a1 a2 a3
+ b1 b2 b3 d1 d2 d3 = {
+ aa = func1 a1 a2 a3;
+ bb = func2
+ b1 b2 b3;
+ (* FIXME: Here it is reasonable to have '|' aligned with 'match' *)
+ cc = (match c with
+ | A -> 1
+ | B -> 2);
+ dd = func3
+ d1 d2 d3;
+ }
+
+let fv =
+ map3
+ a
+ b
+ c
+ ~f:(fun
+ x
+ y
+ z
+ ->
+ match x y z with
+ | `No)
+
+(*
https://forge.ocamlcore.org/tracker/index.php?func=detail&aid=644&group_id=43&atid=255
*)
+let b =
+ match z with
+ | 0 -> fun x -> x
+ | 1 -> fun x -> 1
+
+
+module type X =
+ struct
+ val f : float -> float
+ (** This comment should be under "val", like other doc comments and not
+ aligned to the left margin. *)
+ end
+
+let test () = (* bug#927 *)
+ if a then
+ if b then x
+ else if c then y
+ else z
+ else something
+
+let f x =
+ if x = 1 then print "hello";
+ print "there";
+ print "everywhere"
+
+let f x =
+ if print "hello"; x = 1 then print "hello";
+ print "there"
+
+let f x =
+ if x = 1 then let y = 2 in print "hello";
+ print "there"
+ else print "toto"
+
+let f x =
+ match x with
+ | 1 -> let x = 2 in
+ if x = 1 then print "hello"
+ | 2 -> print "there"
+
+let f x =
+ if x = 1 then match x with
+ | 1 -> print "hello"
+ | 2 -> print "there"
+ else print "toto"
+
+let f x =
+ x + 4 +
+ x + 5 +
+ x + 6
+
+let () =
+ (* Beware of lexing ".;" as a single token! *)
+ A.Axes.box vp;
+ A.fx vp (E.on_ray u0) 0. 2000.;
+ A.Viewport.set_color vp A.Color.green
+
+let f x =
+ 1
+and g y =
+ 2
+
+let x =
+ let module M =
+ struct
+ end
+ in 0
+
+let x =
+ try a
+ with Not_found ->
+ b
+let x = "toto try \
+ tata"
+
+let optional_sci_float =
+ do_something ~a:1e-7
+ ~b:(fun x -> x + 1)
+
+let () =
+ f x ~tol:1.0
+ more arguments;
+ f x ~tol:1.
+ more arguments
+
+let array_args =
+ fold s multi_sms.(0).message_number folder
+ more_args (* FIXME *)
+
+type t = {
+ mutable a: float;
+ b : int;
+ }
+
+(* [struct] and [sig] must be treated the same way. *)
+module Base64 : sig
+ val f : int -> int
+end
+
+external f :
+ int -> unit (* Treated as [val]. *)
+ = "f_stub"
+
+let () =
+ g a.[k]
+ x (* aligned with [a], despite the dot *)
+
+let () =
+ g a.[k] 1.0
+ x (* aligned with [a], despite the dots *)
+
+(* OOP elements (from Marc Simpson <marc AT 0branch DOT com>). *)
+
+class useless = object
+ val n = 10
+
+ method incremented () =
+ succ n
+
+ method add_option = function
+ | Some x -> Some(n + x)
+ | None -> None
+end
+
+class useless' = object(self)
+ val n = 10
+
+ method incremented () =
+ succ n
+
+ method add_option = function
+ | Some x -> Some(n + x)
+ | None -> None
+end
+
+class useless' = object(self)
+ val n = 10
+
+ initializer
+ print_endline "Initialised."
+
+ method incremented () =
+ succ n
+
+ method private add x =
+ n + x
+
+ method add_option = function
+ | Some x -> Some(self#add x)
+ | None -> None
+end
+
+(* Signatures with labeled arguments *)
+
+val f :
+ x : int ->
+ int ->
+ int
+
+val f :
+ ?x: int ->
+ int ->
+ int
+
+let subscribe_impl dir topic ~aborted =
+ return (
+ match Directory.subscribe dir topic with
+ | None -> Error ()
+ | Some pipe ->
+ whenever (aborted >>| fun () -> Pipe.close_read pipe);
+ Ok pipe
+ )
+ next_argument (* should be indented correctly, given the braces *)
+
let command =
Command.Spec.(
empty
+> flag "-hello" (optional_with_default "Hello" string)
- ~doc:" The 'hello' of 'hello world'"
+ ~doc:" The 'hello' of 'hello world'"
+> flag "-world" (optional_with_default "World" string)
- ~doc:" The 'world' of 'hello world'"
+ ~doc:" The 'world' of 'hello world'"
)
diff --git a/sample.ml b/sample.ml
deleted file mode 100644
index 1d278f9..0000000
--- a/sample.ml
+++ /dev/null
@@ -1,1296 +0,0 @@
-(* Sample file indented as we want it to be. -*- tuareg -*- *)
-
-let server_comments request t =
- let module M = N in
- let class M = N in
- let m M = N in
- let module M = N in
- let open Grep.Server in
- let x = 5 in
- let modue x y = 5 in
- let open M in
-
- t >>= Grep.server_comments
- lazy
- parser
- every
-
-let qs1 = {| quoted string |} (* (issue #24) *)
-let qs2 = {eof| other quoted string |noteof} |eof}
-
-(* ocp-indent does it as follows:
-let test1 = with_connection (fun conn ->
- do_something conn x;
- ...
- )
- toto
- *)
-let test1 = with_connection (fun conn ->
- do_something conn x;
- ...
- )
- toto
-
-let x = match y with (* Issue #71 *)
- | A | B ->
- do_something ()
-
-let x = match y, z with
- | A, (B | C)
- | X, Y -> do_something() (* Issue #78 *)
-
-let x =
- begin match y with
- | A -> 1 (* Issue #73 *)
- end
-
-(* The two "let"s below are indented under the assumption that
- tuareg-indent-align-with-first-arg is nil! *)
-let x = List.map (fun x -> 5)
- my list
-
-let x =
- logf `Info "User %s has %i new messages" ba
- (Uid.to_string uid)
- (List.length new_messages)
-
-let x =
- let open M in
- let x = 5 in
- x + x
-;;
-
-(* FIXME: MAJOR "function" sends SMIE into a loop (fine with "fun").
- Use M-q to test. *)
-let () =
- let z = function t -> a in
- foo z
-
-let () =
- foo(function t -> a)
-;;
-
-(* FIXME: MAJOR: M-q on the "(" raises 'Scan error: "Unbalanced
- parentheses"'. It is fine if both () are on the same line. *)
-let () =
- begin
- (begin
- end)
- end
-;;
-
-;; (* http://caml.inria.fr/mantis/view.php?id=4247 *)
-let x = {
- Foo.
- a = b;
- c = d;
- e = {Bar.
- f = 1;
- g = 2;
- };
- h = { Quux.
- i = 3;
- j = 4;
- };
- }
-
-;; (* http://caml.inria.fr/mantis/view.php?id=4249 *)
-let x = { a = b;
- c = d;
- }
-
-;; (* http://caml.inria.fr/mantis/view.php?id=4255 *)
-{ foo: [ `Foo of int
- | `Bar of string ];
-}
-
-let s = { a with
- b = 1;
- }
-;;
-
-let a = {
- M.
- foo = foo;
- bar = bar;
- }
-
-let a = { t with M.
- foo = foo;
- bar = bar;
- }
-
-(* MetaOCaml thingies, issue #195. *)
-let f x = .< 0.0 + g .~ x
- 5
- * 7
- + .<.~x
- +. 10>.
- >.
-
-let a = { t with
- M.
- foo = foo;
- bar = bar;
- }
-
-type t = [ `Foo of int
- | `Bar of string ]
-
-type t =
- | A
- | B (* issue #76 *)
- | C
-with sexp
-
-type t = | A
- | B
- | C
-
-type t = [
- | `A
- | `B
- | `C
- ]
-
-type t = [ (* Comment. *)
- | `A
- | `B
- | `C
- ]
-
-type t = a
- and typey = 4
- and x = b
-
-module M = struct
- type t =
- | A
- | B
- | C
- with sexp
-
- type s = [
- | `A
- | `B
- | `C
- ]
-
- type u =
- | D
- | E
- with sexp
-end
-
-module N =
- struct
- type u =
- | D
- | E
- with sexp
- end
-
-type m =
- | T
-with sexp
-
-let f = function
- | A -> 1
- | B | C -> 2
-
-;; (* http://caml.inria.fr/mantis/view.php?id=4334 *)
-type foo =
- a
- -> b
- -> c
- -> d
-
-val f :
- a:a
- -> b:b
- -> c:c
-
-type bar = a -> b
- -> c -> d
- -> e -> f
-
-type baz = a -> b ->
- c -> d ->
- e -> f
-
-val quux : a -> b ->
- c -> d ->
- e -> f
-
-type t : a:b -> c:d
- -> e:f -> g
-
-val f : a:b -> c:d
- -> e:f -> g
-
-type t = {
- foo : (a
- -> b
- -> c
- -> d);
- }
-
-type t = {
- foo : ( a ->
- b ->
- c ->
- d);
- }
-
-type t = {
- foo : a
- -> b
- -> c
- -> d;
- bar :
- a
- -> b
- -> c;
- }
-
-type t = {
- foo : a ->
- b ->
- c ->
- d;
- bar :
- a ->
- b ->
- c;
- }
-
-type t = {
- a : B.t;
- c : D.t;
-
- e : F.t;
-
- g : H.t I.t;
- j :
- K.t L.t;
- m : N.t O.t;
- p :
- ((q:R.t
- -> s:T.U.t
- -> v:(W.t -> X.t option)
- -> y:(Z.t -> A.t -> B.t C.D.t E.t)
- -> f:(G.t -> H.t I.t option)
- -> j:(K.t -> L.t M.t option)
- -> n:(O.t -> p option)
- -> q:R.t
- -> s:(string -> unit) -> T.t
- )
- -> U.t
- -> V.W.t
- -> X.t);
- y : Z.t A.t;
- b : C.t D.t E.t;
- f : (G.t -> H.t -> I.t J.t);
- } with sexp_of
-
-type 'a v = id:O.t ->
- ssss:Ssss.t ->
- dddd:ddd.t ->
- t:S_m.t ->
- mmm:Safe_float.t ->
- qqq:int ->
- c:C.t ->
- uuuu:string option ->
- aaaaaa:Aaaaaa.t ->
- a:A.t ->
- rrrrr:Rrrrr.t ->
- time:Time.t ->
- typ:[ `L_p of Safe_float.t ] ->
- bazonk:present option ->
- o_p_e:O_m.t option ->
- only_hjkl:present option ->
- show_junk:int option ->
- d_p_o: Safe_float.t option ->
- asdf:present option ->
- generic:Sexp.t list ->
- 'a
-
-type 'a v =
- id:O.t
- -> ssss:Ssss.t
- -> dddd:ddd.t
- -> t:S_m.t
- -> mmm:Safe_float.t
- -> qqq:int
- -> c:C.t
- -> uuuu:string option
- -> aaaaaa:Aaaaaa.t
- -> a:A.t
- -> rrrrr:Rrrrr.t
- -> time:Time.t
- -> typ:[ `L_p of Safe_float.t ]
- -> bazonk:present option
- -> o_p_e:O_m.t option
- -> only_hjkl:present option
- -> show_junk:int option
- -> d_p_o: Safe_float.t option
- -> asdf:present option
- -> generic:Sexp.t list
- -> 'a
-
-;; (* Not in mantis. *)
-let bar x =
- if y
- then x
- else z
-
-let zot x =
- quux ~f:(if x
- then y
- else z)
-
-let zot x = quux ~f:(if x
- then y
- else z)
-
-let () =
- if foo
- then bar
- else if foo1
- then zot
- else bazonk
-
-let () =
- if foo
- then bar
- else
- if foo1
- then zot
- else bazonk
-
-let _ =
- if until
- then _
-
-let () =
- if a then (
- b
- ) else (
- c
- )
-
-let rec count_append l1 l2 count =
- (* http://caml.inria.fr/resources/doc/guides/guidelines.en.html *)
- match l1 with
- | [] -> l2
- | [x1] -> x1 :: l2
- | [x1; x2] -> x1 :: x2 :: l2
- | [x1; x2; x3] -> x1 :: x2 :: x3 :: l2
- | [x1; x2; x3; x4] -> x1 :: x2 :: x3 :: x4 :: l2
- | x1 :: x2 :: x3 :: x4 :: x5 :: tl ->
- x1 :: x2 :: x3 :: x4 :: x5 ::
- (if count > 1000
- then slow_append tl l2
- else count_append tl l2 (count + 1))
- (* New in OCaml-4.02. *)
- | exception Not_Found ->
- l2
-
-
-let x =
- match x with
- | Foo of
- < tag : t; (* FIXME *)
- md : t;
- is_me : t;
- >
-;;
-
-let x =
- match x with
- | Foo of
- <
- tag : t; (* FIXME *)
- md : t;
- is_me : t;
- >
-;;
-
-let foo =
- (
- if a
- then b
- else c
- )
-
-let quux list = List.map list ~f:(fun item ->
- print_item item
- )
-
-let foo x = function
- | Some _ -> true
- | None -> false
-
-let bar x = fun u ->
- match u with
- | Some _ -> true
- | None -> false
-
-let zot u = match u with
- | Some _ -> true
- | None -> false
-
-let () = match x with
- Foo -> 1
- | Bar -> 2
-
-let () =
- match x with
- Foo -> 1
- | Bar -> 2
-
-let r x =
- try f x;
- g x;
- y x;
- with e -> raise e
-
-let g x =
- try let a = b in
- f x;
- g x;
- y x;
- with e -> raise e
-
-let h x =
- try ff a b
- c d;
- gg 1 2
- 3 4;
- with e -> raise e
-
-let () =
- try
- _
- with
- Bar -> ()
-
-let () =
- (* http://caml.inria.fr/resources/doc/guides/guidelines.en.html *)
- try () with
- | e ->
- let x = z in
-
- yyyyy
- (a b)
-
-let d x = function
- (* FIXME: Should we leave it like this or align "|" with "match"?
- I chose with "match" because it looks otherwise odd and is more
- consistent with the "try" alignments above. *)
- | A -> (match x with
- | X ->
- false
- | Y -> true
- | Z ->
- false)
- | B -> false
-
-let a f = function
- | A ->
- 1
- | B ->
- 2
- | C ->
- (function
- | X ->
- a
- | Y ->
- b) 12
- | D ->
- (match z with
- | 4 -> 3
- | 5 -> 7)
-
-let x = foo ~f:(fun _ -> 0 (* Comment. *)
- )
-
-let f x =
- (let y = x in
- f x;
- g y;
- h z)
-
-let f x =
- (let y = x in
- f x);
- g y;
- h z
-
-let g y =
- a b;
- c d;
- e f;
- (* Comment. *)
- g h;
- i j
-
-let () =
- (let a = 1 in
- let b = 2 in
- ( a,
- b))
-
-let () =
- ((a b
- c d e,
- f g h),
- ( i j
- k l,
- m n
- o p))
-
-let () =
- if a
- then
- let b = P.s ~b ~a ~m in
- a +. e *. b,
- b -. e *. b
- else
- q.a -. s *. z,
- q.b +. s *. z
-
-let () =
- (* Comment. *)
- (let x =
- 3
- in
- x + 5)
-
-let x =
- let foo = 1 and bar = 2 and zot = 3 in
- let quux = 4 in
- foo
- + bar
- + zot
- + quux
-
-(* Indent comment to following code. *)
-let () =
- try (* foo!
- bar *)
- let a = f g c d in
- a b
- with _ -> ()
-
-let () = try
- f x;
- with _ -> ()
-
-let () = (try
- f x;
- with _ -> ())
-
-let () =
- foo (sprintf ("a: %s"
- ^ " b: %s")
- a
- b)
-
-let () =
- try f a
- with A () ->
- ()
- | B () ->
- ()
- | C () ->
- ()
-
-let f errors input =
- let ( @@ ) string bool = if not bool then errors := string :: !errors in
- input @@ false
-
-let x =
- if mode = foo then bar;
- conn
- >>| fun x -> x + 1
- >>| fun x -> x + 1
- >>| fun x -> x + 1
-
-let () =
- match _ with
- | foo ->
- bar
- >>| function _ ->
- _
-
-let () =
- a
- >>= fun () ->
- b
- >>| fun () ->
- Deferred.all
-
-let x =
- v
- >>= fun x -> y
- >>= fun z -> w
- >>= fun q -> r
-
-let x =
- v 1 2
- 3 4
- 5 6 >>= fun x ->
- y+1 >>= (* foo! *) fun z ->
- f 1 2 3
- 4 5 6 >>= fun y ->
- w*3 >>= fun q -> r
-
-(* This does not work, see comment in tuareg-compute-arrow-indent.
- * Workaround: wrap code in parens. *)
-(* let () =
- * match
- * a 1 2 3
- * 4 5 6 >>= fun a ->
- * b >>= fun b ->
- * c
- * with
- * | A -> _ *)
-
-let () =
- match
- let a = a in
- let b = b in
- c
- with
- | A -> _
-
-let () =
- match
- (a >>= fun a ->
- b >>= fun b ->
- c)
- with
- A -> _
-
-let f t =
- let (a, b) = to_open in
- let c = g t a b in
- ()
-
-let () =
- begin
- foo bar
- end
- >>= fun () ->
- begin
- foo
- bar
- end
- >>= fun () ->
- ()
-
-let () =
- (
- foo bar
- )
- >>= fun () ->
- (
- foo
- bar
- )
- >>= fun () ->
- ()
-
-let () =
- match e with
- | `T d ->
- notify `O `T d;
- cancel t u ~now
-
-let () =
- let a = 1
- and b = 2
- and c = 3 in
- a + b + c
-
-let _ =
- foo bar
- || snoo blue
-
-let _ =
- (
- foo bar
- || snoo blue
- )
-
-let _ =
- (foo bar
- || snoo blue)
-
-let () =
- Config.load ()
- >>> fun config ->
- let quux = config.Config.bazonk.Config.Bazonk.quux in
- load_quux ~input quux config
- >>> fun quux ->
- let da = Poo.Snapshot.merge quux in
- load_foobar config ~input
- >>> fun foobar ->
- whatever foobar
-
-let () =
- a
- >>> fun () ->
- b
-
-let () =
- a
- >>= function
- | b -> c
- | d ->
- e
- >>= f
-
-let () =
- foo >>> fun bar ->
- baz >>> fun zot ->
- quux
-
-let () =
- Config.load ()
- >>> fun config ->
- let quux = x in
- x
- >>= fun quux ->
- x
-
-let () =
- Config.load ()
- >>= fun config ->
- let quux = x in
- x
- >>= fun quux ->
- x
-
-let () =
- Hashtbl.iter times ~f:(fun ~key:time ~data:azot ->
- Clock.at time
- >>> fun () ->
- Db.iter t.db ~f:(fun dbo ->
- if S.mem azot (Dbo.azo dbo) then
- Dbo.dont dbo))
-
-let () =
- f 1
- |> (fun x ->
- g x x)
- |> (fun y ->
- h y y)
-
-let () =
- (let a,b = match c with
- | D -> e,f
- | G -> h,i in
- let j = a + b in
- j * j),
- 12
-
-module type M = M2
- with type t1 = int
- and type t2 = int
- and module S = M3
- with type t2 = int
- with type t3 = int
-
-let () =
- try
- match () with
- | () -> ()
- with _ -> ()
-
-let () =
- try
- ()
- with _ -> ()
-
-let () =
- ( try ()
- with _ -> ())
-
-let x =
- foo ~bar
- @ snoo
-
-let x =
- foo ~bar:snoo
- @ snoo
-
-let () =
- tagL "ol" (List.map ~f:(tag ~a:[] "li") (
- (List.map results ~f:(fun (what,_) ->
- tag "a" ~a:[("href","#" ^ what)] (what_title what)))
- @ [tag "a" ~a:[("href","#" ^ message_id)] message_title;
- tag "a" ~a:[("href","#" ^ legend_id)] legend_title]))
- |> IO.println out
-
-let x =
- let y =
- (a
- ^ b
- ^ c) in
- f ~a:b ?c:d
- ?e:f ~g:(h i j)
- ~k:(l m)
- (n o p)
-
-let () =
- foobar (fun () ->
- step1
- >>= fun () -> step2)
-
-let w f =
- List.map f ~f:(fun (a, b) ->
- L.r a
- >>= function
- | Ok s -> `Fst (b, s)
- | Error e -> `Snd (b, a, e))
-
-class c (a : b) =
-object
- inherit d
- method m = 1
-end
-
-let f = {
- a = 1;
- }
-
-let f a = {
- a = a;
- }
-
-let f a
- b = {
- a = a;
- b = b;
- }
-
-let () =
- for i = 10 to 17 do
- printf "%d" i;
- done
-
-let a =
- B.c d ~e:f [
- "g";
- "h";
- ]
-
-let () =
- f a ~b:c ~d ~e:g
- u ~q:[
- "a";
- "b";
- ]
-
-let a = match b with
- | Some c -> Some {
- d = c;
- e = e
- }
- | None -> {
- d = c;
- e = e
- }
-
-let a = {
- b = (
- let z = f u in
- z + z;
- );
- c = (let a = b in {
- z = z;
- y = h;
- });
- }
-
-let () =
- { A.
- b =
- C.d e ~f:(fun g -> (h.I.j.K.l, m))
- |> begin fun n ->
- match O.p n with
- | `Q r -> r
- | `S _k -> assert false
- end;
- t =
- u ~v:w
- ~x:(Y.z a);
- b =
- c ~d:e
- ~f:(G.h i);
- j =
- K.l (fun m -> (N.o p m).R.S.t);
- u =
- V.w (fun x -> (Y.x a x).R.S.t);
- v =
- V.w (fun d ->
- (D.g i d).R.S.z);
- }
-
-let x =
- [(W.background `Blue (W.hbox [
- x
- ]));
- ]
-
-let c f =
- if S.is_file f then
- S.load f C.t
- |> fun x -> c := Some x
- else
- C.s C.default |> S.save f
- |> fun () -> c := None
-
-let c f =
- if S.is_file f then (
- S.load f C.t
- |> fun x -> c := Some x
- ) else (
- C.s C.default |> S.save f
- |> fun () -> c := None)
-
-let foo x =
- f1 x >= f2 x
- && f3
- (f4 x)
-
-let foo x =
- (>=)
- (f1 x) (f2 x)
- && f3
- (f4 x)
-
-let a =
- foo
- (fun () ->
- a)
-
-let a =
- foo
- ~f:(fun () ->
- a)
-
-let a =
- foo
- (fun () -> a
- )
-
-let a =
- foo
- ~f:(fun () -> a
- )
-
-let () =
- (* Comment. *)
- bar a b
- c d;
- foo ~size
- (* Comment. *)
- ~min:foo
- ?reduce
- ?override
- ()
-
-let foo =
- (* Comment. *)
- List.map z
- ~f:(fun m ->
- M.q m
- |> T.u ~pr ~verbose:false
- ~p:H.P.US ~is_bar:false)
- |> List.sort ~cmp:(fun a b ->
- compare
- (I.r a.T.s)
- (I.r b.T.s))
-
-let check =
- a lsr 30 >= 3
- && b lsr 20 >= 1
- && c * 10 > f
-
-let () =
- snoo ~f:(fun foo ->
- foo = bar
- && snoo)
-
-let () =
- snoo ~f:(fun foo ->
- foo + bar
- && snoo)
-
-let () =
- snoo ~f:(fun foo ->
- foo
- && snoo)
-
-let variants a =
- match String.split a ~on:'-' with
- | [ s1; s2; s3 ] ->
- let a0 = String.concat ~sep:"" [ s1; s2] in
- let a1 = String.concat ~sep:"-" [ s1; s2; s3; "055" ] in (* Comment. *)
- List.map [ a0; a1; a]
- ~f:(fun a_s -> lookup a_s)
- |> List.flatten
- | _ -> failwith "bad"
-
-let f a1 a2 a3
- b1 b2 b3 d1 d2 d3 = {
- aa = func1 a1 a2 a3;
- bb = func2
- b1 b2 b3;
- (* FIXME: Here it is reasonable to have '|' aligned with 'match' *)
- cc = (match c with
- | A -> 1
- | B -> 2);
- dd = func3
- d1 d2 d3;
- }
-
-let fv =
- map3
- a
- b
- c
- ~f:(fun
- x
- y
- z
- ->
- match x y z with
- | `No)
-
-(*
https://forge.ocamlcore.org/tracker/index.php?func=detail&aid=644&group_id=43&atid=255
*)
-let b =
- match z with
- | 0 -> fun x -> x
- | 1 -> fun x -> 1
-
-
-module type X =
- struct
- val f : float -> float
- (** This comment should be under "val", like other doc comments and not
- aligned to the left margin. *)
- end
-
-let test () = (* bug#927 *)
- if a then
- if b then x
- else if c then y
- else z
- else something
-
-let f x =
- if x = 1 then print "hello";
- print "there";
- print "everywhere"
-
-let f x =
- if print "hello"; x = 1 then print "hello";
- print "there"
-
-let f x =
- if x = 1 then let y = 2 in print "hello";
- print "there"
- else print "toto"
-
-let f x =
- match x with
- | 1 -> let x = 2 in
- if x = 1 then print "hello"
- | 2 -> print "there"
-
-let f x =
- if x = 1 then match x with
- | 1 -> print "hello"
- | 2 -> print "there"
- else print "toto"
-
-let f x =
- x + 4 +
- x + 5 +
- x + 6
-
-let splitting_long_expression =
- quad.{band, i3} <- quad.{band, i3} +. g +.
- area_12 *. (P.potential x13 y13 +. P.potential x23 y23)
-
-let () =
- (* Beware of lexing ".;" as a single token! *)
- A.Axes.box vp;
- A.fx vp (E.on_ray u0) 0. 2000.;
- A.Viewport.set_color vp A.Color.green
-
-let f x =
- 1
-and g y =
- 2
-
-let x =
- let module M =
- struct
- end
- in 0
-
-let x =
- try a
- with Not_found ->
- b
-let x =
- try a
- with Not_found ->
- b
- | _ ->
- c
-let x =
- try a
- with Not_found ->
- if a then b
- | flag when String.is_prefix flag ~prefix:"-" ->
- a
- | _ ->
- c
-
-let x = "toto try \
- tata"
-
-let optional_sci_float =
- do_something ~a:1e-7
- ~b:(fun x -> x + 1)
-
-let () =
- f x ~tol:1.0
- more arguments;
- f x ~tol:1.
- more arguments
-
-let array_args =
- fold s multi_sms.(0).message_number folder
- more_args (* FIXME *)
-
-let () =
- match var with
- | <:expr< $lid:f$ >> ->
- KO
- | <:expr< $lid:f$ >> when f x ->
- KO
- | y when f y ->
- OK
- | long_pattern
- when f long_pattern -> (* Should be more indented than the clause body
*)
- z
-
-type t = {
- mutable a: float;
- b : int;
- }
-
-(* [struct] and [sig] must be treated the same way. *)
-module Base64 : sig
- val f : int -> int
-end
-
-external f :
- int -> unit (* Treated as [val]. *)
- = "f_stub"
-
-let () =
- g a.[k]
- x (* aligned with [a], despite the dot *)
-
-let () =
- g a.[k] 1.0
- x (* aligned with [a], despite the dots *)
-
-(* OOP elements (from Marc Simpson <marc AT 0branch DOT com>). *)
-
-class useless = object
- val n = 10
-
- method incremented () =
- succ n
-
- method add_option = function
- | Some x -> Some(n + x)
- | None -> None
-end
-
-class useless' = object(self)
- val n = 10
-
- method incremented () =
- succ n
-
- method add_option = function
- | Some x -> Some(n + x)
- | None -> None
-end
-
-class useless' = object(self)
- val n = 10
-
- initializer
- print_endline "Initialised."
-
- method incremented () =
- succ n
-
- method private add x =
- n + x
-
- method add_option = function
- | Some x -> Some(self#add x)
- | None -> None
-end
-
-(* Signatures with labeled arguments *)
-
-val f :
- x : int ->
- int ->
- int
-
-val f :
- ?x: int ->
- int ->
- int
-
-let subscribe_impl dir topic ~aborted =
- return (
- match Directory.subscribe dir topic with
- | None -> Error ()
- | Some pipe ->
- whenever (aborted >>| fun () -> Pipe.close_read pipe);
- Ok pipe
- )
- next_argument (* should be indented correctly, given the braces *)
-
-
-let _ =
- List.map
- (function x ->
- blabla (* FIXME: indentation afer "(function" *)
- blabla
- blabla)
- l
-
-let command =
- Command.Spec.(
- empty
- +> flag "-hello" (optional_with_default "Hello" string)
- ~doc:" The 'hello' of 'hello world'"
- +> flag "-world" (optional_with_default "World" string)
- ~doc:" The 'world' of 'hello world'"
- )
diff --git a/tuareg-tests.el b/tuareg-tests.el
index 44dc525..c0fc1b6 100644
--- a/tuareg-tests.el
+++ b/tuareg-tests.el
@@ -3,6 +3,53 @@
(require 'tuareg)
(require 'ert)
+(defconst tuareg-test-dir
+ (file-name-directory (or load-file-name buffer-file-name)))
+
+(defun tuareg-test--remove-indentation ()
+ "Remove all indentation in the current buffer."
+ (goto-char (point-min))
+ (while (re-search-forward (rx bol (+ (in " \t"))) nil t)
+ (let ((syntax (save-match-data (syntax-ppss))))
+ (unless (or (nth 3 syntax) ; not in string literal
+ (nth 4 syntax)) ; nor in comment
+ (replace-match "")))))
+
+(ert-deftest tuareg-indent-good ()
+ "Check indentation that we do handle satisfactorily."
+ (let ((file (expand-file-name "indent-test.ml" tuareg-test-dir))
+ (text (lambda () (buffer-substring-no-properties
+ (point-min) (point-max)))))
+ (with-temp-buffer
+ (insert-file-contents file)
+ (tuareg-mode)
+ (let ((orig (funcall text)))
+ ;; Remove the indentation and check that we get the original text.
+ (tuareg-test--remove-indentation)
+ (indent-region (point-min) (point-max))
+ (should (equal (funcall text) orig))
+ ;; Indent again to verify idempotency.
+ (indent-region (point-min) (point-max))
+ (should (equal (funcall text) orig))))))
+
+(ert-deftest tuareg-indent-bad ()
+ "Check indentation that we do not yet handle satisfactorily."
+ :expected-result :failed
+ (let ((file (expand-file-name "indent-test-failed.ml" tuareg-test-dir))
+ (text (lambda () (buffer-substring-no-properties
+ (point-min) (point-max)))))
+ (with-temp-buffer
+ (insert-file-contents file)
+ (tuareg-mode)
+ (let ((orig (funcall text)))
+ ;; Remove the indentation and check that we get the original text.
+ (tuareg-test--remove-indentation)
+ (indent-region (point-min) (point-max))
+ (should (equal (funcall text) orig))
+ ;; Indent again to verify idempotency.
+ (indent-region (point-min) (point-max))
+ (should (equal (funcall text) orig))))))
+
(ert-deftest tuareg-beginning-of-defun ()
;; Check that `beginning-of-defun' works as expected: move backwards
;; to the beginning of the current top-level definition (defun), or
