Source file wire_diff.ml

(** Generic differential testing: OCaml codec vs EverParse C code.

    Each harness bundles a codec with C read/write functions (generated by
    {!Wire_stubs.to_c_stubs} and {!Wire_stubs.to_ml_stubs}). All diff logic is
    generic over any record codec. *)

type 'r harness =
  | Harness : {
      name : string;
      codec : 'r Wire.Codec.t;
      ocaml_read : string -> 'a option;
      read : string -> 'a option;
      write : 'a -> string option;
      project : 'r -> 'a;
      equal : 'a -> 'a -> bool;
    }
      -> 'r harness

type result =
  | Match
  | Both_failed
  | Value_mismatch of string
  | Only_c_ok of string
  | Only_ocaml_ok of string

let wire_size (Harness h) = Wire.Codec.wire_size h.codec

let encode_to_string codec v =
  let buf = Bytes.create (Wire.Codec.wire_size codec) in
  Wire.Codec.encode codec v buf 0;
  Bytes.unsafe_to_string buf

let decode_from_string codec s = Wire.Codec.decode codec (Bytes.of_string s) 0

let default_ocaml_read codec project buf =
  let buf_too_short = String.length buf < Wire.Codec.wire_size codec in
  if String.length buf = 0 || buf_too_short then None
  else
    match decode_from_string codec buf with
    | Ok v -> Some (project v)
    | Error _ -> None

let v ~name ~codec ~read ~write ~project ~equal ?ocaml_read () =
  let ocaml_read =
    match ocaml_read with
    | Some read -> read
    | None -> default_ocaml_read codec project
  in
  Harness { name; codec; ocaml_read; read; write; project; equal }

let read_test (Harness h) buf =
  let c_result = h.read buf in
  let ocaml_result = h.ocaml_read buf in
  match (c_result, ocaml_result) with
  | Some c_value, Some ocaml_value ->
      if h.equal c_value ocaml_value then Match
      else Value_mismatch "values differ"
  | None, None -> Both_failed
  | Some _, None -> Only_c_ok "OCaml decode returned empty"
  | None, Some _ -> Only_ocaml_ok "External read failed"

let write_test (Harness h) value =
  let projected = h.project value in
  match h.write projected with
  | Some c_bytes -> (
      match h.ocaml_read c_bytes with
      | Some ocaml_value ->
          if h.equal projected ocaml_value then Match
          else Value_mismatch "values differ after external write"
      | None -> Only_c_ok "OCaml rejected external bytes")
  | None -> Only_ocaml_ok "External write failed"

let roundtrip_test (Harness h) value =
  let ocaml_bytes = encode_to_string h.codec value in
  match (h.read ocaml_bytes, h.ocaml_read ocaml_bytes) with
  | None, Some _ -> Only_ocaml_ok "External read failed on OCaml-encoded bytes"
  | Some _, None -> Only_c_ok "OCaml rejected OCaml-encoded bytes"
  | None, None -> Both_failed
  | Some c_value, Some ocaml_value -> (
      if not (h.equal c_value ocaml_value) then
        Value_mismatch "values differ during external read"
      else
        match h.write c_value with
        | None -> Only_ocaml_ok "External write failed"
        | Some c_bytes -> (
            match h.ocaml_read c_bytes with
            | Some final ->
                if h.equal c_value final then Match
                else Value_mismatch "values differ after full roundtrip"
            | None -> Only_c_ok "OCaml rejected external bytes"))

type t = {
  name : string;
  wire_size : int;
  test_read : string -> result;
  test_write : string -> result;
  test_roundtrip : string -> result;
}

let harness ~name ~codec ~read ~write ~project ~equal ?ocaml_read () =
  let h = v ~name ~codec ~read ~write ~project ~equal ?ocaml_read () in
  let ws = wire_size h in
  let codec_inner = match h with Harness h -> h.codec in
  let decode_value buf =
    let padded =
      if String.length buf >= ws then String.sub buf 0 ws
      else
        let b = Bytes.make ws '\000' in
        Bytes.blit_string buf 0 b 0 (String.length buf);
        Bytes.to_string b
    in
    if String.length padded = 0 then None
    else Some (decode_from_string codec_inner padded)
  in
  {
    name = (match h with Harness h -> h.name);
    wire_size = ws;
    test_read = (fun buf -> read_test h buf);
    test_write =
      (fun buf ->
        match decode_value buf with
        | Some (Ok v) -> write_test h v
        | Some (Error _) -> Both_failed
        | None -> Both_failed);
    test_roundtrip =
      (fun buf ->
        match decode_value buf with
        | Some (Ok v) -> roundtrip_test h v
        | Some (Error _) -> Both_failed
        | None -> Both_failed);
  }