Imported Upstream version 4.0

6 files changed, 117 insertions, 15 deletions

diff --git a/src_test/test_deriving_eq.cppo.ml b/src_test/test_deriving_eq.cppo.ml
index ab3100c..7ba4abe 100644
--- a/src_test/test_deriving_eq.cppo.ml
+++ b/src_test/test_deriving_eq.cppo.ml
@@ -13,7 +13,8 @@ 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 r1 = int ref    [@@deriving eq]
+type r2 = int Pervasives.ref [@@deriving eq]
 type l  = int list   [@@deriving eq]
 type a  = int array  [@@deriving eq]
 type o  = int option [@@deriving eq]
@@ -27,7 +28,13 @@ 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|]);
+  assert_equal ~printer false (equal_a [|2|] [|1|])
+
+let test_ref1 ctxt =
+  assert_equal ~printer true (equal_r1 (ref 0) (ref 0))
+
+let test_ref2 ctxt =
+  assert_equal ~printer true (equal_r2 (ref 0) (ref 0))
 
 type v = Foo | Bar of int * string | Baz of string [@@deriving eq]
 
@@ -126,14 +133,24 @@ end
 type 'a std_clash = 'a List.t option
 [@@deriving eq]
 
+let test_result ctxt =
+  let eq = [%eq: (string, int) Result.result] in
+  let open Result in
+  assert_equal ~printer true (eq (Ok "ttt") (Ok "ttt"));
+  assert_equal ~printer false (eq (Ok "123") (Error 123));
+  assert_equal ~printer false (eq (Error 123) (Error 0))
+
 let suite = "Test deriving(eq)" >::: [
     "test_simple"        >:: test_simple;
     "test_array"         >:: test_arr;
+    "test_ref1"          >:: test_ref1;
+    "test_ref2"          >:: test_ref2;
     "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
+    "test_poly_app"      >:: test_poly_app;
+    "test_result"        >:: test_result
   ]
 
diff --git a/src_test/test_deriving_fold.cppo.ml b/src_test/test_deriving_fold.cppo.ml
index dfa4a1d..2f33b9c 100644
--- a/src_test/test_deriving_fold.cppo.ml
+++ b/src_test/test_deriving_fold.cppo.ml
@@ -7,6 +7,13 @@ 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)
 
+type 'a reflist = 'a Pervasives.ref list
+[@@deriving fold]
+
+let test_reflist ctxt =
+  let reflist  = [ ref 3 ; ref 2 ; ref 1 ] in
+  assert_equal ~printer:string_of_int 6 (fold_reflist (+) 0 reflist)
+
 #if OCAML_VERSION >= (4, 03, 0)
 type 'a btreer = Node of { lft: 'a btree; elt: 'a; rgt: 'a btree } | Leaf
 [@@deriving fold]
@@ -15,6 +22,15 @@ type 'a btreer = Node of { lft: 'a btree; elt: 'a; rgt: 'a btree } | Leaf
 type 'a ty = 'a * int list
 [@@deriving fold]
 
+type ('a, 'b) res = ('a, 'b) Result.result [@@deriving fold]
+
+let test_result ctxt =
+  let f = fold_res (+) (-) in
+  assert_equal ~printer:string_of_int 1 (f 0 (Result.Ok 1));
+  assert_equal ~printer:string_of_int (-1) (f 0 (Result.Error 1))
+
 let suite = "Test deriving(fold)" >::: [
-    "test_btree" >:: test_btree;
-  ]
+  "test_btree" >:: test_btree;
+  "test_result" >:: test_result;
+  "test_reflist" >:: test_reflist;
+]
diff --git a/src_test/test_deriving_iter.cppo.ml b/src_test/test_deriving_iter.cppo.ml
index 3a47832..f54449d 100644
--- a/src_test/test_deriving_iter.cppo.ml
+++ b/src_test/test_deriving_iter.cppo.ml
@@ -9,6 +9,9 @@ module T : sig
   type ('a,'b) record = { a : 'a; b : 'b }
   [@@deriving iter]
 
+  type 'a reflist = 'a Pervasives.ref list
+  [@@deriving iter]
+
 end = struct
 
   type 'a btree = Node of 'a btree * 'a * 'a btree | Leaf
@@ -17,6 +20,9 @@ end = struct
   type ('a,'b) record = { a : 'a; b : 'b }
   [@@deriving iter]
 
+  type 'a reflist = 'a Pervasives.ref list
+  [@@deriving iter]
+
 end
 
 open T
@@ -27,17 +33,23 @@ let test_btree ctxt =
              (Node (Node (Leaf, 0, Leaf), 1, Node (Leaf, 2, Leaf)));
   assert_equal [2;1;0] !lst
 
-let test_record ctxt = 
+let test_record ctxt =
   let lst : string list ref = ref [] in
   lst := [];
-  iter_record (fun a -> lst := string_of_int a :: !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) 
+  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
 
+let test_reflist ctxt =
+  let lst = ref [] in
+  iter_reflist (fun x -> lst := x :: !lst)
+               [ ref 0 ; ref 1 ; ref 2 ] ;
+  assert_equal [2;1;0] !lst
+
 #if OCAML_VERSION >= (4, 03, 0)
 type 'a btreer = Node of { lft: 'a btree; elt: 'a; rgt: 'a btree } | Leaf
 [@@deriving iter]
@@ -46,9 +58,18 @@ type 'a btreer = Node of { lft: 'a btree; elt: 'a; rgt: 'a btree } | Leaf
 type 'a ty = 'a * int list
 [@@deriving iter]
 
-let suite = "Test deriving(iter)" >::: [
-    "test_btree" >:: test_btree;
-    "test_record" >:: test_record;
-  ]
+type 'a res0 = ('a, char) Result.result [@@deriving iter]
 
+let test_iter_res ctxt =
+  let has_ok = ref false in
+  iter_res0 (fun _ -> has_ok := true) (Result.Ok "xxx");
+  assert_bool "set ok" !has_ok;
+  iter_res0 (fun _ -> has_ok := false) (Result.Error 'c');
+  assert_bool "set ok" !has_ok
 
+let suite = "Test deriving(iter)" >::: [
+  "test_btree" >:: test_btree;
+  "test_record" >:: test_record;
+  "test_reflist" >:: test_reflist;
+  "test_iter_res" >:: test_iter_res
+]
diff --git a/src_test/test_deriving_map.cppo.ml b/src_test/test_deriving_map.cppo.ml
index e96aa94..d6f7e9f 100644
--- a/src_test/test_deriving_map.cppo.ml
+++ b/src_test/test_deriving_map.cppo.ml
@@ -118,6 +118,14 @@ let test_record3 ctxt =
   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})
 
+type 'a result0 = ('a, bool) Result.result [@@deriving show, map]
+
+let test_map_result ctxt =
+  let f = map_result0 succ in
+  let printer = show_result0 fmt_int in
+  assert_equal ~printer (Result.Ok 10) (f (Result.Ok 9));
+  assert_equal ~printer (Result.Error true) (f (Result.Error true))
+
 let suite = "Test deriving(map)" >::: [
     "test_btree" >:: test_btree;
     "test_var0" >:: test_var0;
@@ -128,6 +136,7 @@ let suite = "Test deriving(map)" >::: [
     "test_record1" >:: test_record1;
     "test_record2" >:: test_record2;
     "test_record3" >:: test_record3;
+    "test_map_result" >:: test_map_result
   ]
 
 
diff --git a/src_test/test_deriving_ord.cppo.ml b/src_test/test_deriving_ord.cppo.ml
index 83c8d50..8915262 100644
--- a/src_test/test_deriving_ord.cppo.ml
+++ b/src_test/test_deriving_ord.cppo.ml
@@ -13,7 +13,6 @@ 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]
@@ -102,6 +101,25 @@ let test_mrec2 ctxt =
   assert_equal ~printer (-1) (compare_e ce1 ce2);
   assert_equal ~printer (1) (compare_e ce2 ce1)
 
+let test_ord_result ctx =
+  let compare_res0 = [%ord: (unit, unit) Result.result] in
+  let open Result in
+  assert_equal ~printer 0 (compare_res0 (Ok ()) (Ok ()));
+  assert_equal ~printer (-1) (compare_res0 (Ok ()) (Error ()));
+  assert_equal ~printer 1 (compare_res0 (Error ()) (Ok ()))
+
+type r1 = int ref [@@deriving ord]
+let test_ref1 ctxt =
+  assert_equal ~printer (-1) (compare_r1 (ref 0) (ref 1));
+  assert_equal ~printer (0) (compare_r1 (ref 0) (ref 0));
+  assert_equal ~printer (1) (compare_r1 (ref 1) (ref 0))
+
+type r2 = int Pervasives.ref [@@deriving ord]
+let test_ref2 ctxt =
+  assert_equal ~printer (-1) (compare_r2 (ref 0) (ref 1));
+  assert_equal ~printer (0) (compare_r2 (ref 0) (ref 0));
+  assert_equal ~printer (1) (compare_r2 (ref 1) (ref 0))
+
 type es =
   | ESBool of bool
   | ESString of string
@@ -153,6 +171,9 @@ let suite = "Test deriving(ord)" >::: [
     "test_placeholder"   >:: test_placeholder;
     "test_mrec"          >:: test_mrec;
     "test_mrec2"         >:: test_mrec2;
+    "test_ref1"          >:: test_ref1;
+    "test_ref2"          >:: test_ref2;
     "test_std_shadowing" >:: test_std_shadowing;
     "test_poly_app"      >:: test_poly_app;
+    "test_ord_result"    >:: test_ord_result
   ]
diff --git a/src_test/test_deriving_show.cppo.ml b/src_test/test_deriving_show.cppo.ml
index ca638ea..da2fd10 100644
--- a/src_test/test_deriving_show.cppo.ml
+++ b/src_test/test_deriving_show.cppo.ml
@@ -12,6 +12,8 @@ type a7 = char       [@@deriving show]
 type a8 = string     [@@deriving show]
 type a9 = bytes      [@@deriving show]
 type r  = int ref    [@@deriving show]
+type r2 = int Pervasives.ref [@@deriving show]
+type r3 = int Pervasives.ref ref [@@deriving show]
 type l  = int list   [@@deriving show]
 type a  = int array  [@@deriving show]
 type o  = int option [@@deriving show]
@@ -28,6 +30,8 @@ let test_alias ctxt =
   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 "ref (1)" (show_r2 (ref 1));
+  assert_equal ~printer "ref (ref (1))" (show_r3 (ref (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));
@@ -149,6 +153,16 @@ 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 i_has_result = I_has of (bool, string) Result.result [@@deriving show]
+
+let test_result ctxt =
+  assert_equal ~printer "(Ok 100)"
+    ([%show: (int, bool) Result.result] (Result.Ok 100));
+  assert_equal ~printer "(Test_deriving_show.I_has (Ok true))"
+    (show_i_has_result (I_has (Result.Ok true)));
+  assert_equal ~printer "(Test_deriving_show.I_has (Error \"err\"))"
+    (show_i_has_result (I_has (Result.Error "err")))
+
 type es =
   | ESBool of (bool [@nobuiltin])
   | ESString of (string [@nobuiltin])
@@ -186,6 +200,8 @@ 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
+  | Fourth of int * int
+                [@printer fun fmt (a,b) -> fprintf fmt "fourth: %d %d" a b]
 [@@deriving show]
 
 let test_variant_printer ctxt =
@@ -194,7 +210,9 @@ let test_variant_printer ctxt =
   assert_equal ~printer
     "second: 42" (show_variant_printer (Second 42));
   assert_equal ~printer
-    "Test_deriving_show.Third" (show_variant_printer Third)
+    "Test_deriving_show.Third" (show_variant_printer Third);
+  assert_equal ~printer
+    "fourth: 8 4" (show_variant_printer (Fourth(8,4)))
 
 let suite = "Test deriving(show)" >::: [
     "test_alias"           >:: test_alias;
@@ -214,5 +232,5 @@ let suite = "Test deriving(show)" >::: [
     "test_std_shadowing"   >:: test_std_shadowing;
     "test_poly_app"        >:: test_poly_app;
     "test_variant_printer" >:: test_variant_printer;
+    "test_result"          >:: test_result
   ]
-