Source

meta_conv / xml / tests / test.ml

Full commit
open Meta_conv.Open
module Xml = struct
  type t = { x : t Std_xml.t }
  let element t attrs xs = { x = Std_xml.Element (t, attrs, xs) }
  let pcdata s = { x = Std_xml.PCData s }
  let deconstr {x=t} = t
  let rec format ppf {x=t} = Std_xml.format format ppf t
end
module Xml_conv = Xml_conv.Make(Xml)
open Xml_conv

module Test1 = struct
  type t = Foo | Bar of int * string with conv(xml)

  let () =
    let x = Bar (0, "hello") in
    assert (t_of_xml (xml_of_t x) = `Ok x)
end

module Test2 = struct
  type t = { foo : int; bar : float option } with conv(xml)

  let () =
    let x = { foo = 3; bar = Some 1.2 } in
    assert (t_of_xml (xml_of_t x) = `Ok x)
end

module Test3 = struct
  open Test2
  type t = Test2.t with conv(xml)

  let () =
    let x = { foo = 3; bar = Some 1.2 } in
    assert (t_of_xml (xml_of_t x) = `Ok x)
end

module Test4 = struct
  type t = Foo (:"foo":) | Bar (:"bar":) of int * string with conv(xml)

  let () =
    let x = Bar (0, "hello") in
    assert (t_of_xml (xml_of_t x) = `Ok x)
end

module Test5 = struct
  type t (: Ignore_unknown_fields :) = { x : int; y : float } with conv (xml)
  type t' = { x' as "x" : int; y' as "y" : float; z' as "z" : unit  } with conv (xml)

  let () =
    let r' = { x' = 1; y' = 1.0; z' = () }  in
    assert (t_of_xml (xml_of_t' r') = `Ok { x = 1; y = 1.0 })
end

let xml_format_with f = fun ppf v -> Xml.format ppf (f v)
  
module Test6 = struct
  type t = { x : int; y : float; rest : Xml.t mc_leftovers; } with conv (xml)
  type t' = { x' as "x" : int; y' as "y" : float; z' as "z" : unit  } with conv (xml)

  let format_t' = xml_format_with xml_of_t'

  let () =
    let r' = { x' = 1; y' = 1.0; z' = () }  in
    assert (t_of_xml (xml_of_t' r') = `Ok { x = 1; y = 1.0; rest = [ "z", Xml.element "unit" [] [] ] });
    assert (xml_of_t (match t_of_xml (xml_of_t' r') with `Ok v -> v | _ -> assert false) = xml_of_t' r');
    Format.eprintf "r' = %a@." format_t' r'
end

(*
module Test7 = struct
  type t = { x : int; y : float; rest : Xml.t mc_leftovers; } with conv (xml)
  type t' = { x' as "x" : int; y' as "y" : float; z' as "z" : unit  } with conv (xml)

  let format_t = xml_format_with xml_of_t

  let () =
    let r' = { x' = 1; y' = 1.0; z' = () }  in
    let format_sprintf fmt = Format.(
      let buf = Buffer.create 100 in
      let ppf = formatter_of_buffer buf in
      kfprintf (fun ppf -> pp_print_flush ppf (); Buffer.contents buf) ppf fmt
    ) in
    let s = format_sprintf "%a" (fun x -> Xml.format x) (xml_of_t' r') in
    prerr_endline s;
    let o = match Xml.Parser.from_string s with [x] -> x | _ -> assert false in
    Format.eprintf "parse done: %a@." (fun x -> Xml.format x) o;
    try
      let r = t_of_xml_exn o in
      Format.eprintf "r = %a@." format_t r
    with
    | Xml_conv.Error e ->
        Xml_conv.format_full_error Format.err_formatter e
end
*)

module Test8 = struct
  type t = < x : int; y : string > with conv(xml)
end

module Test9 = struct
  type t = { ping : string mc_option } with conv(xml)
end