1 files changed, 118 insertions, 0 deletions
diff --git a/ocaml-binary-annot/ocamldoc/odoc_test.ml b/ocaml-binary-annot/ocamldoc/odoc_test.ml
new file mode 100644
index 0000000000..7b455f45bf
--- /dev/null
+++ b/ocaml-binary-annot/ocamldoc/odoc_test.ml
@@ -0,0 +1,118 @@
+(***********************************************************************)
+(*                             OCamldoc                                *)
+(*                                                                     *)
+(*            Maxence Guesdon, projet Cristal, INRIA Rocquencourt      *)
+(*                                                                     *)
+(*  Copyright 2004 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* $Id$ *)
+
+(** Custom generator to perform test on ocamldoc. *)
+
+open Odoc_info
+open Odoc_info.Module
+open Odoc_info.Type
+
+type test_kind =
+    Types_display
+
+let p = Format.fprintf
+
+module Generator =
+struct
+class string_gen =
+  object(self)
+    inherit Odoc_info.Scan.scanner
+
+    val mutable test_kinds = []
+    val mutable fmt = Format.str_formatter
+
+    method must_display_types = List.mem Types_display test_kinds
+
+    method set_test_kinds_from_module m =
+      test_kinds <- List.fold_left
+          (fun acc (s, _) ->
+            match s with
+              "test_types_display" -> Types_display :: acc
+            | _ -> acc
+          )
+          []
+          (
+           match m.m_info with
+             None -> []
+           | Some i -> i.i_custom
+          )
+    method! scan_type t =
+      match test_kinds with
+        [] -> ()
+      | _ ->
+          p fmt "# type %s:\n" t.ty_name;
+          if self#must_display_types then
+            (
+             p fmt "# manifest (Odoc_info.string_of_type_expr):\n<[%s]>\n"
+               (match t.ty_manifest with
+                 None -> "None"
+               | Some e -> Odoc_info.string_of_type_expr e
+               );
+            );
+
+
+    method! scan_module_pre m =
+      p fmt "#\n# module %s:\n" m.m_name ;
+      if self#must_display_types then
+        (
+         p fmt "# Odoc_info.string_of_module_type:\n<[%s]>\n"
+           (Odoc_info.string_of_module_type m.m_type);
+         p fmt "# Odoc_info.string_of_module_type ~complete: true :\n<[%s]>\n"
+           (Odoc_info.string_of_module_type ~complete: true m.m_type);
+        );
+      true
+
+    method! scan_module_type_pre m =
+      p fmt "#\n# module type %s:\n" m.mt_name ;
+      if self#must_display_types then
+        (
+         p fmt "# Odoc_info.string_of_module_type:\n<[%s]>\n"
+           (match m.mt_type with
+             None -> "None"
+           | Some t -> Odoc_info.string_of_module_type t
+           );
+         p fmt "# Odoc_info.string_of_module_type ~complete: true :\n<[%s]>\n"
+           (match m.mt_type with
+             None -> "None"
+           | Some t -> Odoc_info.string_of_module_type ~complete: true t
+           );
+        );
+      true
+
+    method generate (module_list: Odoc_info.Module.t_module list) =
+      let oc = open_out !Odoc_info.Global.out_file in
+      fmt <- Format.formatter_of_out_channel oc;
+      (
+       try
+         List.iter
+           (fun m ->
+             self#set_test_kinds_from_module m;
+             self#scan_module_list [m];
+           )
+           module_list
+       with
+         e ->
+           prerr_endline (Printexc.to_string e)
+      );
+      Format.pp_print_flush fmt ();
+      close_out oc
+  end
+
+  class generator =
+    let g = new string_gen in
+    object
+      method generate = g#generate
+    end
+end;;
+
+let _ = Odoc_args.set_generator (Odoc_gen.Other (module Generator : Odoc_gen.Base))