Commit b27d284e authored by POTTIER Francois's avatar POTTIER Francois

New tests of [@name] and [@@name].

parent 8b55208a
......@@ -13,4 +13,5 @@ test03
test04
test05
test06
test07
testallprims
(* Testing @name attributes. *)
(* Testing @name attributes on data constructors. *)
type foo =
| A [@name "transform_A"]
| B of int [@name "transform_B"]
| C of int * int [@name "transform_C"]
[@@deriving visitors { variety = "map"; concrete = true }]
| A [@name "TA"]
| B of int [@name "TB"]
| C of int * int [@name "TC"]
[@@deriving visitors { variety = "map"; concrete = true },
visitors { variety = "fold"; ancestors = ["VisitorsRuntime.map"] }]
let f (x : foo) =
let o = object
inherit [_] map
method! transform_A _env = B 0
method! transform_B _env x = B (x + 1)
method! transform_C _env x y = C (x, x + y)
method! visit_TA _env = B 0
method! visit_TB _env x = B (x + 1)
method! visit_TC _env x y = C (x, x + y)
end in
o # visit_foo () x
......@@ -20,3 +21,18 @@ let () =
assert (f (B 0) = B 1);
assert (f (C (1, 1)) = C (1, 2));
()
let g (x : foo) : int =
let o = object
inherit [_] fold
method build_TA _env = 42
method build_TB _env x = x
method build_TC _env x y = x + y
end in
o # visit_foo () x
let () =
assert (g A = 42);
assert (g (B 12) = 12);
assert (g (C (1, 1)) = 2);
()
(* Testing @name attributes on data types. *)
(* Testing local types decorated with [@@name]. *)
module Point = struct
type point = { x : coordinate; y : coordinate } [@@name "foo"]
and coordinate = float [@@name "coord"]
[@@deriving visitors { variety = "map"; concrete = true },
visitors { variety = "fold"; ancestors = ["VisitorsRuntime.map"]}]
let f (p : point) =
let o = new map in
o # visit_foo () p
let () =
assert (f { x = 0.; y = 0. } = { x = 0.; y = 0. });
()
let g (p : point) : float =
let o = object
inherit [_] fold
method build_coord _env x = x
method build_foo _env x y = x +. y
end in
o # visit_foo () p
let () =
assert (g { x = 1.; y = 2. } = 3.);
()
end
type boolean = Vrai | Faux [@@name "condition"]
[@@deriving visitors { variety = "iter2"; concrete = true }]
let () =
try
new iter2 # fail_condition () Vrai Faux;
assert false
with VisitorsRuntime.StructuralMismatch ->
()
(* Testing nonlocal types decorated with [@name]. *)
type segment = { source: Point.point[@name "foo"]; destination: Point.point[@name "foo"] }
[@@deriving visitors { variety = "map"; concrete = true; nude = true; ancestors = ["Point.map"] }]
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment