Imported Upstream version 3.3

10 files changed, 934 insertions, 0 deletions

diff --git a/src_test/test_deriving_create.ml b/src_test/test_deriving_create.ml
new file mode 100644
index 0000000..8c53740
--- /dev/null
+++ b/src_test/test_deriving_create.ml
@@ -0,0 +1,56 @@
+open OUnit2
+
+module M : sig
+  type a = {
+    a1  : int option;
+    a2  : int list;
+    a3  : int [@default 42];
+    a4s : (int * int list) [@split];
+    a5  : int;
+  } [@@deriving show, create]
+
+  type b = {
+    b1  : int option;
+    b2  : int list;
+    b3  : int [@default 42];
+    b4s : (int * int list) [@split];
+    b5  : int [@main];
+  } [@@deriving show, create]
+end = struct
+  type a = {
+    a1  : int option;
+    a2  : int list;
+    a3  : int [@default 42];
+    a4s : (int * int list) [@split];
+    a5  : int;
+  } [@@deriving show, create]
+
+  type b = {
+    b1  : int option;
+    b2  : int list;
+    b3  : int [@default 42];
+    b4s : (int * int list) [@split];
+    b5  : int [@main];
+  } [@@deriving show, create]
+end
+
+let test_no_main ctxt =
+  assert_equal ~printer:M.show_a
+               { M.a1 = None; a2 = []; a3 = 42; a4s = 2, []; a5 = 1 }
+               (M.create_a ~a4:2 ~a5:1 ());
+  assert_equal ~printer:M.show_a
+               { M.a1 = Some 1; a2 = [2]; a3 = 3; a4s = 4, [5]; a5 = 6 }
+               (M.create_a ~a1:1 ~a2:[2] ~a3:3 ~a4:4 ~a4s:[5] ~a5:6 ())
+
+let test_main ctxt =
+  assert_equal ~printer:M.show_b
+               { M.b1 = None; b2 = []; b3 = 42; b4s = 2, []; b5 = 1 }
+               (M.create_b ~b4:2 1);
+  assert_equal ~printer:M.show_b
+               { M.b1 = Some 1; b2 = [2]; b3 = 3; b4s = 4, [5]; b5 = 6 }
+               (M.create_b ~b1:1 ~b2:[2] ~b3:3 ~b4:4 ~b4s:[5] 6)
+
+let suite = "Test deriving(create)" >::: [
+    "test_no_main" >:: test_no_main;
+    "test_main"    >:: test_main;
+  ]
diff --git a/src_test/test_deriving_enum.ml b/src_test/test_deriving_enum.ml
new file mode 100644
index 0000000..6970acd
--- /dev/null
+++ b/src_test/test_deriving_enum.ml
@@ -0,0 +1,42 @@
+open OUnit2
+
+let get o = match o with Some v -> v | None -> assert false
+
+type va = Aa | Ba | Ca [@@deriving enum, show]
+let test_auto ctxt =
+  assert_equal ~printer:string_of_int 0  (va_to_enum Aa);
+  assert_equal ~printer:string_of_int 1  (va_to_enum Ba);
+  assert_equal ~printer:string_of_int 2  (va_to_enum Ca);
+  assert_equal ~printer:show_va       Aa (get (va_of_enum 0));
+  assert_equal ~printer:show_va       Ba (get (va_of_enum 1));
+  assert_equal ~printer:show_va       Ca (get (va_of_enum 2));
+  assert_equal ~printer:string_of_int 0 min_va;
+  assert_equal ~printer:string_of_int 2 max_va
+
+type vm = Am [@value 1] | Bm [@value 3] | Cm [@@deriving enum, show]
+let test_manual ctxt =
+  assert_equal ~printer:string_of_int 1  (vm_to_enum Am);
+  assert_equal ~printer:string_of_int 3  (vm_to_enum Bm);
+  assert_equal ~printer:string_of_int 4  (vm_to_enum Cm);
+  assert_equal ~printer:show_vm       Am (get (vm_of_enum 1));
+  assert_equal ~printer:show_vm       Bm (get (vm_of_enum 3));
+  assert_equal ~printer:show_vm       Cm (get (vm_of_enum 4));
+  assert_equal ~printer:string_of_int 1 min_vm;
+  assert_equal ~printer:string_of_int 4 max_vm
+
+type pv = [ `A | `B | `C ] [@@deriving enum, show]
+let test_poly ctxt =
+  assert_equal ~printer:string_of_int 0  (pv_to_enum `A);
+  assert_equal ~printer:string_of_int 1  (pv_to_enum `B);
+  assert_equal ~printer:string_of_int 2  (pv_to_enum `C);
+  assert_equal ~printer:show_pv       `A (get (pv_of_enum 0));
+  assert_equal ~printer:show_pv       `B (get (pv_of_enum 1));
+  assert_equal ~printer:show_pv       `C (get (pv_of_enum 2));
+  assert_equal ~printer:string_of_int 0 min_pv;
+  assert_equal ~printer:string_of_int 2 max_pv
+
+let suite = "Test deriving(enum)" >::: [
+    "test_auto"   >:: test_auto;
+    "test_manual" >:: test_manual;
+    "test_poly"   >:: test_poly;
+  ]
diff --git a/src_test/test_deriving_eq.cppo.ml b/src_test/test_deriving_eq.cppo.ml
new file mode 100644
index 0000000..ab3100c
--- /dev/null
+++ b/src_test/test_deriving_eq.cppo.ml
@@ -0,0 +1,139 @@
+open OUnit2
+
+(* Mostly it is sufficient to test that the derived code compiles. *)
+
+let printer = string_of_bool
+
+type a1 = int        [@@deriving eq]
+type a2 = int32      [@@deriving eq]
+type a3 = int64      [@@deriving eq]
+type a4 = nativeint  [@@deriving eq]
+type a5 = float      [@@deriving eq]
+type a6 = bool       [@@deriving eq]
+type a7 = char       [@@deriving eq]
+type a8 = string     [@@deriving eq]
+type a9 = bytes      [@@deriving eq]
+type r  = int ref    [@@deriving eq]
+type l  = int list   [@@deriving eq]
+type a  = int array  [@@deriving eq]
+type o  = int option [@@deriving eq]
+type y  = int lazy_t [@@deriving eq]
+
+let test_simple ctxt =
+  assert_equal ~printer true  (equal_a1 1 1);
+  assert_equal ~printer false (equal_a1 1 2)
+
+let test_arr ctxt =
+  assert_equal ~printer true (equal_a [||] [||]);
+  assert_equal ~printer true (equal_a [|1|] [|1|]);
+  assert_equal ~printer false (equal_a [||] [|1|]);
+  assert_equal ~printer false (equal_a [|2|] [|1|]);
+
+type v = Foo | Bar of int * string | Baz of string [@@deriving eq]
+
+#if OCAML_VERSION >= (4, 03, 0)
+type rv = RFoo | RBar of { x: int; y: string; } [@@deriving eq]
+#endif
+
+type pv1 = [ `Foo | `Bar of int * string ] [@@deriving eq]
+type pv2 = [ `Baz | pv1 ] [@@deriving eq]
+
+type ty = int * string [@@deriving eq]
+
+type re = {
+  f1 : int;
+  f2 : string;
+} [@@deriving eq]
+
+module M : sig
+  type t = int [@@deriving eq]
+end = struct
+  type t = int [@@deriving eq]
+end
+
+type z = M.t [@@deriving eq]
+
+type file = {
+  name : string;
+  perm : int     [@equal (<>)];
+} [@@deriving eq]
+let test_custom ctxt =
+  assert_equal ~printer false (equal_file { name = ""; perm = 1 }
+                                          { name = ""; perm = 1 });
+  assert_equal ~printer true  (equal_file { name = ""; perm = 1 }
+                                          { name = ""; perm = 2 })
+
+type 'a pt = { v : 'a } [@@deriving eq]
+
+let test_placeholder ctxt =
+  assert_equal ~printer true ([%eq: _] 1 2)
+
+
+type mrec_variant =
+  | MrecFoo of string
+  | MrecBar of int
+
+and mrec_variant_list = mrec_variant list [@@deriving eq]
+
+let test_mrec ctxt =
+  assert_equal ~printer true  (equal_mrec_variant_list [MrecFoo "foo"; MrecBar 1]
+                                                       [MrecFoo "foo"; MrecBar 1]);
+  assert_equal ~printer false (equal_mrec_variant_list [MrecFoo "foo"; MrecBar 1]
+                                                       [MrecFoo "bar"; MrecBar 1])
+
+type e = Bool of be | Plus of e * e | IfE  of (be, e) if_e | Unit
+and be = True | False | And of be * be | IfB of (be, be) if_e
+and ('cond, 'a) if_e = 'cond * 'a * 'a
+  [@@deriving eq]
+
+let test_mut_rec ctxt =
+  let e1 = IfE (And (False, True), Unit, Plus (Unit, Unit)) in
+  let e2 = Plus (Unit, Bool False) in
+  assert_equal ~printer true (equal_e e1 e1);
+  assert_equal ~printer true (equal_e e2 e2);
+  assert_equal ~printer false (equal_e e1 e2);
+  assert_equal ~printer false (equal_e e2 e1)
+
+type es =
+  | ESBool of (bool [@nobuiltin])
+  | ESString of (string [@nobuiltin])
+and bool =
+  | Bfoo of int * ((int -> int) [@equal fun _ _ -> true])
+and string =
+  | Sfoo of (String.t [@equal (=)]) * ((int -> int) [@equal fun _ _ -> true])
+[@@deriving eq]
+
+let test_std_shadowing ctxt =
+  let e1 = ESBool (Bfoo (1, (+) 1)) in
+  let e2 = ESString (Sfoo ("lalala", (+) 3)) in
+  assert_equal ~printer false (equal_es e1 e2);
+  assert_equal ~printer false (equal_es e2 e1);
+  assert_equal ~printer true (equal_es e1 e1);
+  assert_equal ~printer true (equal_es e2 e2)
+
+type poly_app = float poly_abs
+and 'a poly_abs = 'a
+[@@deriving eq]
+
+let test_poly_app ctxt =
+  assert_equal ~printer true (equal_poly_app 1.0 1.0);
+  assert_equal ~printer false (equal_poly_app 1.0 2.0)
+
+module List = struct
+  type 'a t = [`Cons of 'a | `Nil]
+  [@@deriving eq]
+end
+type 'a std_clash = 'a List.t option
+[@@deriving eq]
+
+let suite = "Test deriving(eq)" >::: [
+    "test_simple"        >:: test_simple;
+    "test_array"         >:: test_arr;
+    "test_custom"        >:: test_custom;
+    "test_placeholder"   >:: test_placeholder;
+    "test_mrec"          >:: test_mrec;
+    "test_mut_rec"       >:: test_mut_rec;
+    "test_std_shadowing" >:: test_std_shadowing;
+    "test_poly_app"      >:: test_poly_app
+  ]
+
diff --git a/src_test/test_deriving_fold.cppo.ml b/src_test/test_deriving_fold.cppo.ml
new file mode 100644
index 0000000..dfa4a1d
--- /dev/null
+++ b/src_test/test_deriving_fold.cppo.ml
@@ -0,0 +1,20 @@
+open OUnit2
+
+type 'a btree = Node of 'a btree * 'a * 'a btree | Leaf
+[@@deriving fold]
+
+let test_btree ctxt =
+  let btree  = (Node (Node (Leaf, 3, Leaf), 1, Node (Leaf, 2, Leaf))) in
+  assert_equal ~printer:string_of_int 6 (fold_btree (+) 0 btree)
+
+#if OCAML_VERSION >= (4, 03, 0)
+type 'a btreer = Node of { lft: 'a btree; elt: 'a; rgt: 'a btree } | Leaf
+[@@deriving fold]
+#endif
+
+type 'a ty = 'a * int list
+[@@deriving fold]
+
+let suite = "Test deriving(fold)" >::: [
+    "test_btree" >:: test_btree;
+  ]
diff --git a/src_test/test_deriving_iter.cppo.ml b/src_test/test_deriving_iter.cppo.ml
new file mode 100644
index 0000000..3a47832
--- /dev/null
+++ b/src_test/test_deriving_iter.cppo.ml
@@ -0,0 +1,54 @@
+open OUnit2
+
+module T : sig
+
+  type 'a btree = Node of 'a btree * 'a * 'a btree | Leaf
+  [@@deriving iter]
+
+  (* test for #82: iter_record : ('a -> unit) -> ('b -> unit) -> ('a,'b) record -> unit) *)
+  type ('a,'b) record = { a : 'a; b : 'b }
+  [@@deriving iter]
+
+end = struct
+
+  type 'a btree = Node of 'a btree * 'a * 'a btree | Leaf
+  [@@deriving iter]
+
+  type ('a,'b) record = { a : 'a; b : 'b }
+  [@@deriving iter]
+
+end
+
+open T
+
+let test_btree ctxt =
+  let lst = ref [] in
+  iter_btree (fun x -> lst := x :: !lst)
+             (Node (Node (Leaf, 0, Leaf), 1, Node (Leaf, 2, Leaf)));
+  assert_equal [2;1;0] !lst
+
+let test_record ctxt = 
+  let lst : string list ref = ref [] in
+  lst := [];
+  iter_record (fun a -> lst := string_of_int a :: !lst) 
+              (fun b -> lst := string_of_float b :: ! lst) {a=1; b=1.2};
+  assert_equal ["1.2"; "1"] !lst;
+  lst := [];
+  iter_record (fun a -> lst := string_of_int (a+1) :: !lst) 
+              (fun b -> lst := Int64.to_string b :: ! lst) {a=3; b=4L};
+  assert_equal ["4"; "4"] !lst
+
+#if OCAML_VERSION >= (4, 03, 0)
+type 'a btreer = Node of { lft: 'a btree; elt: 'a; rgt: 'a btree } | Leaf
+[@@deriving iter]
+#endif
+
+type 'a ty = 'a * int list
+[@@deriving iter]
+
+let suite = "Test deriving(iter)" >::: [
+    "test_btree" >:: test_btree;
+    "test_record" >:: test_record;
+  ]
+
+
diff --git a/src_test/test_deriving_make.ml b/src_test/test_deriving_make.ml
new file mode 100644
index 0000000..28a963e
--- /dev/null
+++ b/src_test/test_deriving_make.ml
@@ -0,0 +1,72 @@
+open OUnit2
+
+module M : sig
+  type a = {
+    a1  : int option;
+    a2  : int list;
+    a3  : int [@default 42];
+    a4s : (int * int list) [@split];
+    a5  : int;
+  } [@@deriving show, make]
+
+  type b = {
+    b1  : int option;
+    b2  : int list;
+    b3  : int [@default 42];
+    b4s : (int * int list) [@split];
+    b5  : int [@main];
+  } [@@deriving show, make]
+
+  type c = {
+    c1 : int;
+    c2 : string
+  } [@@deriving show, make]
+end = struct
+  type a = {
+    a1  : int option;
+    a2  : int list;
+    a3  : int [@default 42];
+    a4s : (int * int list) [@split];
+    a5  : int;
+  } [@@deriving show, make]
+
+  type b = {
+    b1  : int option;
+    b2  : int list;
+    b3  : int [@default 42];
+    b4s : (int * int list) [@split];
+    b5  : int [@main];
+  } [@@deriving show, make]
+
+  type c = {
+    c1 : int;
+    c2 : string
+  } [@@deriving show, make]
+end
+
+let test_no_main ctxt =
+  assert_equal ~printer:M.show_a
+               { M.a1 = None; a2 = []; a3 = 42; a4s = 2, []; a5 = 1 }
+               (M.make_a ~a4:2 ~a5:1 ());
+  assert_equal ~printer:M.show_a
+               { M.a1 = Some 1; a2 = [2]; a3 = 3; a4s = 4, [5]; a5 = 6 }
+               (M.make_a ~a1:1 ~a2:[2] ~a3:3 ~a4:4 ~a4s:[5] ~a5:6 ())
+
+let test_main ctxt =
+  assert_equal ~printer:M.show_b
+               { M.b1 = None; b2 = []; b3 = 42; b4s = 2, []; b5 = 1 }
+               (M.make_b ~b4:2 1);
+  assert_equal ~printer:M.show_b
+               { M.b1 = Some 1; b2 = [2]; b3 = 3; b4s = 4, [5]; b5 = 6 }
+               (M.make_b ~b1:1 ~b2:[2] ~b3:3 ~b4:4 ~b4s:[5] 6)
+
+let test_no_unit ctxt =
+  assert_equal ~printer:M.show_c
+    { M.c1 = 0; M.c2 = "" }
+    (M.make_c ~c1:0 ~c2:"")
+
+let suite = "Test deriving(make)" >::: [
+    "test_no_main" >:: test_no_main;
+    "test_main"    >:: test_main;
+    "test_no_unit" >:: test_no_unit
+  ]
diff --git a/src_test/test_deriving_map.cppo.ml b/src_test/test_deriving_map.cppo.ml
new file mode 100644
index 0000000..e96aa94
--- /dev/null
+++ b/src_test/test_deriving_map.cppo.ml
@@ -0,0 +1,133 @@
+open OUnit2
+
+module T : sig
+  
+  type 'a btree = Node of 'a btree * 'a * 'a btree | Leaf
+  [@@deriving map, show]
+
+#if OCAML_VERSION >= (4, 03, 0)
+  type 'a btreer = Noder of { lft: 'a btree; elt: 'a; rgt: 'a btree } | Leafr
+  [@@deriving map]
+#endif
+
+  type var0 = A0 of int [@@deriving map,show]
+
+  type 'a var1 = A1 of 'a [@@deriving map,show]
+
+  type 'a var2 = A2 of 'a | B2 of int [@@deriving map,show]
+
+  type ('a,'b) var3 = A3 of 'a | B3 of bool | C3 of 'b * ('a,'b) var3 [@@deriving map,show]
+
+  type record0 = { a0 : int } [@@deriving map,show]
+
+  type 'a record1 = { a1 : 'a } [@@deriving map,show]
+
+  type 'a record2 = { a2 : 'a; b2 : int } [@@deriving map,show]
+
+  type ('a,'b) record3 = { a3 : 'a; b3 : bool; c3 : 'b } [@@deriving map,show]
+
+end = struct
+
+  type 'a btree = Node of 'a btree * 'a * 'a btree | Leaf
+  [@@deriving map, show]
+
+#if OCAML_VERSION >= (4, 03, 0)
+  type 'a btreer = Noder of { lft: 'a btree; elt: 'a; rgt: 'a btree } | Leafr
+  [@@deriving map]
+#endif
+
+  type 'a ty = 'a * int list
+  [@@deriving map]
+
+  (* variants and records with mixtures of poly/nonpoly fields *)
+
+  type var0 = A0 of int [@@deriving map,show]
+
+  type 'a var1 = A1 of 'a [@@deriving map,show]
+
+  type 'a var2 = A2 of 'a | B2 of int [@@deriving map,show]
+
+  type ('a,'b) var3 = A3 of 'a | B3 of bool | C3 of 'b * ('a,'b) var3 [@@deriving map,show]
+
+  type record0 = { a0 : int } [@@deriving map,show]
+
+  type 'a record1 = { a1 : 'a } [@@deriving map,show]
+
+  type 'a record2 = { a2 : 'a; b2 : int } [@@deriving map,show]
+
+  type ('a,'b) record3 = { a3 : 'a; b3 : bool; c3 : 'b } [@@deriving map,show]
+
+end
+
+open T
+
+let fmt_chr fmt = Format.fprintf fmt "%c"
+let fmt_flt fmt = Format.fprintf fmt "%f"
+let fmt_int fmt = Format.fprintf fmt "%d"
+let fmt_str fmt = Format.fprintf fmt "%s"
+
+let test_btree ctxt =
+  let btree  = (Node (Node (Leaf, 0, Leaf), 1, Node (Leaf, 2, Leaf))) in
+  let btree' = map_btree (fun x -> x + 1) btree in
+  assert_equal ~printer:(show_btree fmt_int)
+               (Node (Node (Leaf, 1, Leaf), 2, Node (Leaf, 3, Leaf)))
+               btree'
+
+(* tests for #81 and #82 - allow non-poly fields in records and variants and
+   provide more general type for map signature:
+     ('a -> 'x) -> ... -> ('a,...) t -> ('x,...) t *)
+
+let test_var0 ctxt =
+  assert_equal ~printer:show_var0 (A0 10) (map_var0 (A0 10))
+
+let test_var1 ctxt = 
+  assert_equal ~printer:(show_var1 fmt_int) (A1 1) (map_var1 ((+)1) (A1 0));
+  assert_equal ~printer:(show_var1 fmt_str) (A1 "2") (map_var1 string_of_int (A1 2))
+
+let test_var2 ctxt = 
+  assert_equal ~printer:(show_var2 fmt_int) (B2 7) (map_var2 ((+)1) (B2 7));
+  assert_equal ~printer:(show_var2 fmt_int) (A2 5) (map_var2 ((+)1) (A2 4));
+  assert_equal ~printer:(show_var2 fmt_int) (A2 5) (map_var2 int_of_float (A2 5.))
+
+let test_var3 ctxt = 
+  let show,map = show_var3 fmt_int fmt_str, map_var3 ((+)1) String.uppercase in
+  assert_equal ~printer:show (A3 2) (map (A3 1));
+  assert_equal ~printer:show (B3 false) (map (B3 false));
+  assert_equal ~printer:show (C3("ABC", A3 3)) (map (C3("abc", A3 2)));
+  assert_equal ~printer:show (C3("XYZ", B3 true)) (map (C3("xyz", B3 true)));
+  let show,map = show_var3 fmt_int fmt_flt, map_var3 Char.code float_of_int in
+  assert_equal ~printer:show (A3 97) (map (A3 'a'));
+  assert_equal ~printer:show (B3 false) (map (B3 false));
+  assert_equal ~printer:show (C3(4., A3 98)) (map (C3(4, A3 'b')));
+  assert_equal ~printer:show (C3(5., B3 true)) (map (C3(5, B3 true)))
+
+let test_record0 ctxt = 
+  assert_equal ~printer:show_record0 {a0=10} (map_record0 {a0=10})
+
+let test_record1 ctxt = 
+  assert_equal ~printer:(show_record1 fmt_int) {a1=1} (map_record1 ((+)1) {a1=0});
+  assert_equal ~printer:(show_record1 fmt_str) {a1="2"} (map_record1 string_of_int {a1=2})
+
+let test_record2 ctxt = 
+  assert_equal ~printer:(show_record2 fmt_int) {a2=5;b2=7} (map_record2 ((+)1) {a2=4;b2=7});
+  assert_equal ~printer:(show_record2 fmt_int) {a2=5;b2=0} (map_record2 int_of_float {a2=5.;b2=0})
+
+let test_record3 ctxt = 
+  assert_equal ~printer:(show_record3 fmt_int fmt_str)
+    {a3=5;b3=false;c3="ABC"} (map_record3 ((+)1) String.uppercase {a3=4;b3=false;c3="abc"});
+  assert_equal ~printer:(show_record3 fmt_int fmt_flt)
+    {a3=97;b3=false;c3=4.} (map_record3 Char.code float_of_int {a3='a';b3=false;c3=4})
+
+let suite = "Test deriving(map)" >::: [
+    "test_btree" >:: test_btree;
+    "test_var0" >:: test_var0;
+    "test_var1" >:: test_var1;
+    "test_var2" >:: test_var2;
+    "test_var3" >:: test_var3;
+    "test_record0" >:: test_record0;
+    "test_record1" >:: test_record1;
+    "test_record2" >:: test_record2;
+    "test_record3" >:: test_record3;
+  ]
+
+
diff --git a/src_test/test_deriving_ord.cppo.ml b/src_test/test_deriving_ord.cppo.ml
new file mode 100644
index 0000000..83c8d50
--- /dev/null
+++ b/src_test/test_deriving_ord.cppo.ml
@@ -0,0 +1,158 @@
+open OUnit2
+
+(* Mostly it is sufficient to test that the derived code compiles. *)
+
+let printer = string_of_int
+
+type a1 = int        [@@deriving ord]
+type a2 = int32      [@@deriving ord]
+type a3 = int64      [@@deriving ord]
+type a4 = nativeint  [@@deriving ord]
+type a5 = float      [@@deriving ord]
+type a6 = bool       [@@deriving ord]
+type a7 = char       [@@deriving ord]
+type a8 = string     [@@deriving ord]
+type a9 = bytes      [@@deriving ord]
+type r  = int ref    [@@deriving ord]
+type l  = int list   [@@deriving ord]
+type a  = int array  [@@deriving ord]
+type o  = int option [@@deriving ord]
+type y  = int lazy_t [@@deriving ord]
+
+let test_simple ctxt =
+  assert_equal ~printer  (1) (compare_a1 1 0);
+  assert_equal ~printer  (0) (compare_a1 1 1);
+  assert_equal ~printer (-1) (compare_a1 1 2)
+
+type v = Foo | Bar of int * string | Baz of string [@@deriving ord]
+let test_variant ctxt =
+  assert_equal ~printer (1) (compare_v (Baz "b") (Baz "a"));
+  assert_equal ~printer (1) (compare_v (Bar (1, "")) Foo);
+  assert_equal ~printer (1) (compare_v (Baz "") (Bar (1, "")));
+  assert_equal ~printer (-1) (compare_v Foo (Baz ""))
+
+#if OCAML_VERSION >= (4, 03, 0)
+type rv = RFoo | RBar of { x: int; y: string; } [@@deriving ord]
+#endif
+
+type pv1 = [ `Foo | `Bar of int * string ] [@@deriving ord]
+type pv2 = [ `Baz | pv1 ] [@@deriving ord]
+
+type ty = int * string [@@deriving ord]
+let test_complex ctxt =
+  assert_equal ~printer (0)  (compare_ty (0, "a") (0, "a"));
+  assert_equal ~printer (1)  (compare_ty (1, "a") (0, "a"));
+  assert_equal ~printer (-1) (compare_ty (0, "a") (1, "a"));
+  assert_equal ~printer (-1) (compare_ty (0, "a") (0, "b"));
+  assert_equal ~printer (1)  (compare_ty (0, "b") (0, "a"))
+
+
+type re = {
+  f1 : int;
+  f2 : string;
+} [@@deriving ord]
+
+module M : sig
+  type t = int [@@deriving ord]
+end = struct
+  type t = int [@@deriving ord]
+end
+
+type z = M.t [@@deriving ord]
+
+type file = {
+  name : string;
+  perm : int     [@compare fun a b -> compare b a];
+} [@@deriving ord]
+let test_custom ctxt =
+  assert_equal ~printer (-1) (compare_file { name = ""; perm = 2 }
+                                           { name = ""; perm = 1 });
+  assert_equal ~printer (1)  (compare_file { name = ""; perm = 1 }
+                                           { name = ""; perm = 2 })
+
+type 'a pt = { v : 'a } [@@deriving ord]
+
+let test_placeholder ctxt =
+  assert_equal ~printer 0 ([%ord: _] 1 2)
+
+type mrec_variant =
+  | MrecFoo of string
+  | MrecBar of int
+
+and mrec_variant_list = mrec_variant list
+[@@deriving ord]
+
+let test_mrec ctxt =
+  assert_equal ~printer (0)   (compare_mrec_variant_list [MrecFoo "foo"; MrecBar 1;]
+                                                         [MrecFoo "foo"; MrecBar 1;]);
+  assert_equal ~printer (-1)  (compare_mrec_variant_list [MrecFoo "foo"; MrecBar 1;]
+                                                         [MrecFoo "foo"; MrecBar 2;]);
+  assert_equal ~printer (1)   (compare_mrec_variant_list [MrecFoo "foo"; MrecBar 2;]
+                                                         [MrecFoo "foo"; MrecBar 1;])
+
+type e = Bool of be | Plus of e * e | IfE  of (be, e) if_e
+and be = True | False | And of be * be | IfB of (be, be) if_e
+and ('cond, 'a) if_e = 'cond * 'a * 'a
+  [@@deriving ord]
+
+let test_mrec2 ctxt =
+  let ce1 = Bool (IfB (True, False, True)) in
+  let ce2 = Bool (IfB (True, False, False)) in
+  assert_equal ~printer (0) (compare_e ce1 ce1);
+  assert_equal ~printer (-1) (compare_e ce1 ce2);
+  assert_equal ~printer (1) (compare_e ce2 ce1)
+
+type es =
+  | ESBool of bool
+  | ESString of string
+and bool =
+  | Bfoo of int * ((int -> int) [@compare fun _ _ -> 0])
+and string =
+  | Sfoo of String.t * ((int -> int) [@compare fun _ _ -> 0])
+[@@deriving ord]
+
+let test_std_shadowing ctxt =
+  let e1 = ESBool (Bfoo (1, (+) 1)) in
+  let e2 = ESString (Sfoo ("lalala", (+) 3)) in
+  assert_equal ~printer (-1) (compare_es e1 e2);
+  assert_equal ~printer (1) (compare_es e2 e1);
+  assert_equal ~printer 0 (compare_es e1 e1);
+  assert_equal ~printer 0 (compare_es e2 e2)
+
+type poly_app = float poly_abs
+and 'a poly_abs = 'a
+[@@deriving ord]
+
+let test_poly_app ctxt =
+  assert_equal ~printer 0 (compare_poly_app 1.0 1.0);
+  assert_equal ~printer (-1) (compare_poly_app 1.0 2.0)
+
+module List = struct
+  type 'a t = [`Cons of 'a | `Nil]
+  [@@deriving ord]
+end
+type 'a std_clash = 'a List.t option
+[@@deriving ord]
+
+module Warnings = struct
+  module W4 = struct
+    [@@@ocaml.warning "@4"]
+
+    type t =
+      | A of int
+      | B
+    [@@deriving ord]
+  end
+end
+
+let suite = "Test deriving(ord)" >::: [
+    "test_simple"        >:: test_simple;
+    "test_variant"       >:: test_variant;
+    "test_complex"       >:: test_complex;
+    "test_custom"        >:: test_custom;
+    "test_placeholder"   >:: test_placeholder;
+    "test_mrec"          >:: test_mrec;
+    "test_mrec2"         >:: test_mrec2;
+    "test_std_shadowing" >:: test_std_shadowing;
+    "test_poly_app"      >:: test_poly_app;
+  ]
diff --git a/src_test/test_deriving_show.cppo.ml b/src_test/test_deriving_show.cppo.ml
new file mode 100644
index 0000000..ca638ea
--- /dev/null
+++ b/src_test/test_deriving_show.cppo.ml
@@ -0,0 +1,218 @@
+open OUnit2
+
+let printer = fun x -> x
+
+type a1 = int        [@@deriving show]
+type a2 = int32      [@@deriving show]
+type a3 = int64      [@@deriving show]
+type a4 = nativeint  [@@deriving show]
+type a5 = float      [@@deriving show]
+type a6 = bool       [@@deriving show]
+type a7 = char       [@@deriving show]
+type a8 = string     [@@deriving show]
+type a9 = bytes      [@@deriving show]
+type r  = int ref    [@@deriving show]
+type l  = int list   [@@deriving show]
+type a  = int array  [@@deriving show]
+type o  = int option [@@deriving show]
+type f  = int -> int [@@deriving show]
+type y  = int lazy_t [@@deriving show]
+let test_alias ctxt =
+  assert_equal ~printer "1"       (show_a1 1);
+  assert_equal ~printer "1l"      (show_a2 1l);
+  assert_equal ~printer "1L"      (show_a3 1L);
+  assert_equal ~printer "1n"      (show_a4 1n);
+  assert_equal ~printer "1."      (show_a5 1.);
+  assert_equal ~printer "true"    (show_a6 true);
+  assert_equal ~printer "'a'"     (show_a7 'a');
+  assert_equal ~printer "\"foo\"" (show_a8 "foo");
+  assert_equal ~printer "\"foo\"" (show_a9 (Bytes.of_string "foo"));
+  assert_equal ~printer "ref (1)" (show_r (ref 1));
+  assert_equal ~printer "[1; 2; 3]" (show_l [1;2;3]);
+  assert_equal ~printer "[|1; 2; 3|]" (show_a [|1;2;3|]);
+  assert_equal ~printer "(Some 1)" (show_o (Some 1));
+  assert_equal ~printer "<fun>"   (show_f (fun x -> x));
+  let y = lazy (1 + 1) in
+  assert_equal ~printer "<not evaluated>" (show_y y);
+  ignore (Lazy.force y);
+  assert_equal ~printer "2" (show_y y)
+
+type v = Foo | Bar of int * string | Baz of string [@@deriving show]
+let test_variant ctxt =
+  assert_equal ~printer "Test_deriving_show.Foo"              (show_v Foo);
+  assert_equal ~printer "Test_deriving_show.Bar (1, \"foo\")" (show_v (Bar (1, "foo")));
+  assert_equal ~printer "(Test_deriving_show.Baz \"foo\")"    (show_v (Baz "foo"))
+
+#if OCAML_VERSION >= (4, 03, 0)
+type rv = RFoo | RBar of { x: int; y: string } | RBaz of { z: string } [@@deriving show]
+let test_variant_record ctxt =
+  assert_equal ~printer "Test_deriving_show.RFoo"
+                        (show_rv RFoo);
+  assert_equal ~printer "Test_deriving_show.RBar {x = 1; y = \"foo\"}"
+                        (show_rv (RBar {x=1; y="foo"}));
+  assert_equal ~printer "(Test_deriving_show.RBaz {z = \"foo\"}"
+                        (show_rv (RBaz {z="foo"}))
+#endif
+
+type vn = Foo of int option [@@deriving show]
+let test_variant_nest ctxt =
+  assert_equal ~printer "(Test_deriving_show.Foo (Some 1))" (show_vn (Foo (Some 1)))
+
+type pv1 = [ `Foo | `Bar of int * string ] [@@deriving show]
+let test_poly ctxt =
+  assert_equal ~printer "`Foo"                (show_pv1 `Foo);
+  assert_equal ~printer "`Bar ((1, \"foo\"))" (show_pv1 (`Bar (1, "foo")))
+
+type pv2 = [ `Baz | pv1 ] [@@deriving show]
+let test_poly_inherit ctxt =
+  assert_equal ~printer "`Foo" (show_pv2 `Foo);
+  assert_equal ~printer "`Baz" (show_pv2 `Baz)
+
+type ty = int * string [@@deriving show]
+let test_tuple ctxt =
+  assert_equal ~printer "(1, \"foo\")" (show_ty (1, "foo"))
+
+type re = {
+  f1 : int;
+  f2 : string;
+  f3 : float [@opaque];
+} [@@deriving show]
+let test_record ctxt =
+  assert_equal ~printer "{ Test_deriving_show.f1 = 1; f2 = \"foo\"; f3 = <opaque> }"
+                        (show_re { f1 = 1; f2 = "foo"; f3 = 1.0 })
+
+
+module M : sig
+  type t = A [@@deriving show]
+end = struct
+  type t = A [@@deriving show]
+end
+
+let test_module ctxt =
+  assert_equal ~printer "Test_deriving_show.M.A" (M.show M.A)
+
+type z = M.t [@@deriving show]
+let test_abstr ctxt =
+  assert_equal ~printer "Test_deriving_show.M.A" (show_z M.A)
+
+type file = {
+  name : string;
+  perm : int     [@printer fun fmt -> Format.fprintf fmt "0o%03o"];
+}
+[@@deriving show]
+let test_custom ctxt =
+  assert_equal ~printer "{ Test_deriving_show.name = \"dir\"; perm = 0o755 }"
+                        (show_file { name = "dir"; perm = 0o755 })
+
+type 'a pt = { v : 'a } [@@deriving show]
+let test_parametric ctxt =
+  assert_equal ~printer "{ Test_deriving_show.v = 1 }"
+                        (show_pt (fun fmt -> Format.fprintf fmt "%d") { v = 1 })
+
+type 'a btree = Node of 'a btree * 'a * 'a btree | Leaf
+[@@deriving show]
+
+module M' = struct
+  type t = M.t = A [@@deriving show]
+end
+let test_alias_path ctxt =
+  assert_equal ~printer "M.A" (M'.show M'.A)
+
+let print_hi = fun fmt _ -> Format.fprintf fmt "hi!"
+type polypr = (string [@printer print_hi]) btree [@polyprinter pp_btree]
+[@@deriving show]
+let test_polypr ctxt =
+  assert_equal ~printer "Test_deriving_show.Node (Test_deriving_show.Leaf, hi!,\n\
+                        \  Test_deriving_show.Leaf)"
+                        (show_polypr (Node (Leaf, "x", Leaf)))
+
+let test_placeholder ctxt =
+  assert_equal ~printer "_" ([%show: _] 1)
+
+module rec RecFoo : sig
+  type ('a,'b) t = ('b, 'a) RecBar.t [@@deriving show]
+end = struct
+  type ('a,'b) t = ('b,'a) RecBar.t [@@deriving show]
+end
+and RecBar : sig
+  type ('b, 'a) t = 'b * 'a [@@deriving show]
+end = struct
+  type ('b,'a) t = 'b * 'a [@@deriving show]
+end
+
+
+type foo = F of int | B of int bar | C of float bar
+and 'a bar = { x : 'a ; r : foo }
+[@@deriving show]
+
+let test_mrec ctxt =
+  let e1 =  B { x = 12; r = F 16 } in
+  assert_equal ~printer "(Test_deriving_show.B\n   { Test_deriving_show.x = 12; r = (Test_deriving_show.F 16) })" (show_foo e1)
+
+type es =
+  | ESBool of (bool [@nobuiltin])
+  | ESString of (string [@nobuiltin])
+and bool =
+  | Bfoo of int * (int -> int)
+and string =
+  | Sfoo of String.t * (int -> int)
+[@@deriving show]
+
+let test_std_shadowing ctxt =
+  let e1 = ESBool (Bfoo (1, (+) 1)) in
+  let e2 = ESString (Sfoo ("lalala", (+) 3)) in
+  assert_equal ~printer
+    "(Test_deriving_show.ESBool Test_deriving_show.Bfoo (1, <fun>))"
+    (show_es e1);
+  assert_equal ~printer
+    "(Test_deriving_show.ESString Test_deriving_show.Sfoo (\"lalala\", <fun>))"
+    (show_es e2)
+
+type poly_app = float poly_abs
+and 'a poly_abs = 'a
+[@@deriving show]
+
+let test_poly_app ctxt =
+  assert_equal ~printer "1." (show_poly_app 1.0)
+
+module List = struct
+  type 'a t = [`Cons of 'a | `Nil]
+  [@@deriving show]
+end
+type 'a std_clash = 'a List.t option
+[@@deriving show]
+
+type variant_printer =
+  | First [@printer fun fmt _ -> Format.pp_print_string fmt "first"]
+  | Second of int [@printer fun fmt i -> fprintf fmt "second: %d" i]
+  | Third
+[@@deriving show]
+
+let test_variant_printer ctxt =
+  assert_equal ~printer
+    "first" (show_variant_printer First);
+  assert_equal ~printer
+    "second: 42" (show_variant_printer (Second 42));
+  assert_equal ~printer
+    "Test_deriving_show.Third" (show_variant_printer Third)
+
+let suite = "Test deriving(show)" >::: [
+    "test_alias"           >:: test_alias;
+    "test_variant"         >:: test_variant;
+    "test_variant_nest"    >:: test_variant_nest;
+    "test_tuple"           >:: test_tuple;
+    "test_poly"            >:: test_poly;
+    "test_poly_inherit"    >:: test_poly_inherit;
+    "test_record"          >:: test_record;
+    "test_abstr"           >:: test_abstr;
+    "test_custom"          >:: test_custom;
+    "test_parametric"      >:: test_parametric;
+    "test_alias_path"      >:: test_alias_path;
+    "test_polypr"          >:: test_polypr;
+    "test_placeholder"     >:: test_placeholder;
+    "test_mrec"            >:: test_mrec;
+    "test_std_shadowing"   >:: test_std_shadowing;
+    "test_poly_app"        >:: test_poly_app;
+    "test_variant_printer" >:: test_variant_printer;
+  ]
+
diff --git a/src_test/test_ppx_deriving.ml b/src_test/test_ppx_deriving.ml
new file mode 100644
index 0000000..befacc0
--- /dev/null
+++ b/src_test/test_ppx_deriving.ml
@@ -0,0 +1,42 @@
+open OUnit2
+
+let test_inline ctxt =
+  let sort = List.sort [%derive.ord: int * int] in
+  assert_equal ~printer:[%derive.show: (int * int) list]
+               [(1,1);(2,0);(3,5)] (sort [(2,0);(3,5);(1,1)])
+
+let test_inline_shorthand ctxt =
+  assert_equal ~printer:(fun x -> x)
+               "[(1, 1); (2, 0)]" ([%show: (int * int) list] [(1,1); (2,0)])
+
+type optional_deriver = string
+[@@deriving missing { optional = true }]
+
+type prefix = {
+  field : int [@deriving.eq.compare fun _ _ -> true]
+}
+[@@deriving eq]
+
+let test_prefix ctxt =
+  assert_equal true (equal_prefix {field=1} {field=2})
+
+let test_hash_variant ctxt =
+  ["a"; "b"; "c"; "Dd"] |> List.iter (fun x ->
+    assert_equal (Btype.hash_variant x) (Ppx_deriving.hash_variant x))
+
+let suite = "Test ppx_deriving" >::: [
+    Test_deriving_show.suite;
+    Test_deriving_eq.suite;
+    Test_deriving_ord.suite;
+    Test_deriving_enum.suite;
+    Test_deriving_iter.suite;
+    Test_deriving_map.suite;
+    Test_deriving_fold.suite;
+    Test_deriving_create.suite;
+    Test_deriving_make.suite;
+    "test_inline"           >:: test_inline;
+    "test_inline_shorthand" >:: test_inline_shorthand;
+  ]
+
+let _ =
+  run_test_tt_main suite