Improve generators tests v2

Makefile

@@ -38,12 +38,7 @@ serve :
 
 .PHONY : test
 test : build
-	$(DUNE) runtest $(DUNE_ARGS) src/parser/test
-	$(DUNE) build $(DUNE_ARGS) @test/model/runtest --no-buffer -j 1
-	$(DUNE) build $(DUNE_ARGS) @test/html/runtest --no-buffer -j 1
-	$(DUNE) build $(DUNE_ARGS) @test/man/runtest --no-buffer -j 1
-	$(DUNE) build $(DUNE_ARGS) @test/latex/runtest --no-buffer -j 1
-	$(DUNE) build $(DUNE_ARGS) @test/xref2/runtest --no-buffer -j 1
+	$(DUNE) runtest $(DUNE_ARGS)
 
 ODOC_RELATIVE_PATH := ../../_build/install/default/bin/
 

test/cases/labels.mli → test/generators/cases/labels.mli

@@ -2,44 +2,44 @@
 
 (** {1:L2 Attached to nothing} *)
 
-(** {1:L3 Attached to module} *)
 module A : sig end
+(** {1:L3 Attached to module} *)
 
-(** {1:L4 Attached to type} *)
 type t
+(** {1:L4 Attached to type} *)
 
-(** {1:L5 Attached to value} *)
 val f : t
+(** {1:L5 Attached to value} *)
 
-(** {1:L5bis Attached to external} *)
 external e : unit -> t = "t"
+(** {1:L5bis Attached to external} *)
 
-(** {1:L6 Attached to module type} *)
 module type S = sig end
+(** {1:L6 Attached to module type} *)
 
-(** {1:L6 Attached to class} *)
 class c : object end
+(** {1:L6 Attached to class} *)
 
-(** {1:L7 Attached to class type} *)
 class type cs = object end
+(** {1:L7 Attached to class type} *)
 
-(** {1:L8 Attached to exception} *)
 exception E
+(** {1:L8 Attached to exception} *)
 
 type x = ..
 
 (** {1:L9 Attached to extension} *)
 type x += X
 
-(** {1:L10 Attached to module subst} *)
 module S := A
+(** {1:L10 Attached to module subst} *)
 
-(** {1:L11 Attached to type subst} *)
 type s := t
+(** {1:L11 Attached to type subst} *)
 
-type u = A' (** {1:L12 Attached to constructor} *)
+type u = A'  (** {1:L12 Attached to constructor} *)
 
-type v = { f : t (** {1:L13 Attached to field} *) }
+type v = { f : t  (** {1:L13 Attached to field} *) }
 
 (** Testing that labels can be referenced
     - {!L1}

test/generators/cases/ocamlary.mli

@@ -0,0 +1 @@
+../../../src/ocamlary/ocamlary.mli

test/cases/recent.mli → test/generators/cases/recent.mli

@@ -4,37 +4,34 @@
 
 module type S = sig end
 
-module type S1 = S -> S
+module type S1 = functor (_ : S) -> S
 
 type variant =
   | A
   | B of int
-  | C (** foo *)
-  | D (** {e bar} *)
-  | E of {a : int}
+  | C  (** foo *)
+  | D  (** {e bar} *)
+  | E of { a : int }
 
 type _ gadt =
   | A : int gadt
-  | B : int -> string gadt (** foo *)
-  | C : {a : int} -> unit gadt
+  | B : int -> string gadt  (** foo *)
+  | C : { a : int } -> unit gadt
 
-type polymorphic_variant = [
-  | `A
-  | `B of int
-  | `C (** foo *)
-  | `D (** bar *)
-]
+type polymorphic_variant = [ `A | `B of int | `C  (** foo *) | `D  (** bar *) ]
 
 type empty_variant = |
 
 type nonrec nonrec_ = int
 
-
 (* Conjunctive types: dune compilation scheme exposes a bug in old
    versions of the compiler *)
-type empty_conj= X: [< `X of & 'a & int * float  ] -> empty_conj
-type conj = X: [< `X of int & [< `B of int & float ] ] -> conj
-val empty_conj: [< `X of & 'a & int * float  ]
+type empty_conj = X : [< `X of  & 'a & int * float ] -> empty_conj
+
+type conj = X : [< `X of int & [< `B of int & float ] ] -> conj
+
+val empty_conj : [< `X of  & 'a & int * float ]
+
 val conj : [< `X of int & [< `B of int & float ] ]
 
 module Z : sig
@@ -47,12 +44,17 @@ end
 
 module X : sig
   module L := Z.Y
+
   type t = int L.X.t
+
   type u := int
+
   type v = u L.X.t
 end
 
-module type PolyS =
-  sig type a = [ `A ] type t = [ a | `B ] end with type a := [ `A ]
-
+module type PolyS = sig
+  type a = [ `A ]
 
+  type t = [ a | `B ]
+end
+with type a := [ `A ]

test/generators/cases/recent_impl.ml

@@ -0,0 +1,38 @@
+module Foo = struct
+  module A = struct
+    type t = A
+  end
+
+  module B = struct
+    type t = B
+  end
+end
+
+open (Foo : module type of Foo with module A := Foo.A)
+
+module B = B
+
+open Set.Make (struct
+  type t = Foo.A.t
+
+  let compare = compare
+end)
+
+type u = t
+
+module type S = sig
+  module F (_ : sig end) : sig
+    type t
+  end
+
+  module X : sig end
+
+  open F(X)
+
+  val f : t
+end
+
+open Foo
+
+(* Check that regular open still works as expected *)
+module B' = B

test/generators/dune

@@ -0,0 +1,29 @@
+(include link.dune.inc)
+
+(rule
+ (deps
+  (glob_files cases/*)
+  (glob_files html/*.targets)
+  (glob_files latex/*.targets)
+  (glob_files man/*.targets))
+ (enabled_if
+  (>= %{ocaml_version} 4.04))
+ (action
+  (with-stdout-to
+   link.dune.inc.gen
+   (pipe-stdout
+    (run gen_rules/gen_rules.exe)
+    (run dune format-dune-file)))))
+
+(rule
+ (alias runtest)
+ (enabled_if
+  (>= %{ocaml_version} 4.04))
+ (action
+  (diff link.dune.inc link.dune.inc.gen)))
+
+(library
+ (name gen_rules_lib)
+ (libraries sexplib0 unix fpath)
+ (enabled_if
+  (>= %{ocaml_version} 4.04)))

test/generators/gen_rules/dune

@@ -0,0 +1,5 @@
+(executable
+ (name gen_rules)
+ (libraries gen_rules_lib)
+ (enabled_if
+  (>= %{ocaml_version} 4.04)))

test/generators/gen_rules/gen_rules.ml

@@ -0,0 +1,102 @@
+let html_target_rule path : Gen_rules_lib.sexp =
+  List
+    [
+      Atom "action";
+      List
+        [
+          Atom "progn";
+          List
+            [
+              Atom "run";
+              Atom "odoc";
+              Atom "html-generate";
+              Atom "--indent";
+              Atom "--flat";
+              Atom "--extra-suffix";
+              Atom "gen";
+              Atom "-o";
+              Atom ".";
+              Atom ("%{dep:" ^ Fpath.to_string path ^ "}");
+            ];
+        ];
+    ]
+
+let latex_target_rule path : Gen_rules_lib.sexp =
+  List
+    [
+      Atom "action";
+      List
+        [
+          Atom "progn";
+          List
+            [
+              Atom "run";
+              Atom "odoc";
+              Atom "latex-generate";
+              Atom "-o";
+              Atom ".";
+              Atom "--extra-suffix";
+              Atom "gen";
+              Atom ("%{dep:" ^ Fpath.to_string path ^ "}");
+            ];
+        ];
+    ]
+
+let man_target_rule path : Gen_rules_lib.sexp =
+  List
+    [
+      Atom "action";
+      List
+        [
+          Atom "progn";
+          List
+            [
+              Atom "run";
+              Atom "odoc";
+              Atom "man-generate";
+              Atom "-o";
+              Atom ".";
+              Atom "--extra-suffix";
+              Atom "gen";
+              Atom ("%{dep:" ^ Fpath.to_string path ^ "}");
+            ];
+        ];
+    ]
+
+let read_file_from_dir dir =
+  let filenames =
+    let arr = Sys.readdir dir in
+    Array.sort String.compare arr;
+    Array.to_list arr
+  in
+  let dir = Fpath.v dir in
+  List.map (Fpath.( / ) dir) filenames
+
+let constraints =
+  let open Gen_rules_lib in
+  [
+    (Fpath.v "stop_dead_link_doc.mli", Min "4.04");
+    (Fpath.v "bugs_post_406.mli", Min "4.06");
+    (Fpath.v "ocamlary.mli", Min "4.07");
+    (Fpath.v "recent.mli", Min "4.09");
+    (Fpath.v "labels.mli", Min "4.09");
+    (Fpath.v "recent_impl.ml", Min "4.09");
+    (Fpath.v "bugs_pre_410.ml", Max "4.09");
+    (Fpath.v "module_type_subst.mli", Min "4.13");
+  ]
+
+let () =
+  let paths = read_file_from_dir (Fpath.filename Gen_rules_lib.cases) in
+  let paths =
+    List.filter (fun p -> not (Gen_rules_lib.is_dot_ocamlformat p)) paths
+  in
+  let stanzas =
+    Gen_rules_lib.gen_rule constraints
+      [
+        (html_target_rule, Fpath.v "html", Some "--flat");
+        (latex_target_rule, Fpath.v "latex", None);
+        (man_target_rule, Fpath.v "man", None);
+      ]
+      paths
+  in
+  List.iter (Sexplib0.Sexp.pp Format.std_formatter) stanzas