test07.ml 1.22 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49
(* 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"] }]