Source file `antithesis.ml`

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
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
(** Antithesis integration for Hegel.

    See the [.mli] for the full description. *)

open! Core

type test_location =
  { function_name : string
  ; file : string
  ; begin_line : int
  }

(** Environment variable Antithesis injects when a workload runs inside it. *)
let antithesis_output_dir_env = "ANTITHESIS_OUTPUT_DIR"

let is_running_in_antithesis () =
  match Sys.getenv antithesis_output_dir_env with
  | None -> false
  | Some dir ->
    if Stdlib.Sys.file_exists dir && Stdlib.Sys.is_directory dir
    then true
    else
      failwithf
        "Expected %s=%s to exist as a directory when running inside Antithesis"
        antithesis_output_dir_env
        dir
        ()
;;

let extract_file_base path =
  let base = Filename.basename path in
  try Filename.chop_extension base with
  | Invalid_argument _ -> base
;;

let assertion_json loc ~hit ~condition =
  let id =
    Printf.sprintf
      "%s in %s passes properties"
      loc.function_name
      (extract_file_base loc.file)
  in
  let location_obj : Yojson.Safe.t =
    `Assoc
      [ "function", `String loc.function_name
      ; "file", `String loc.file
      ; "begin_line", `Int loc.begin_line
      ; "begin_column", `Int 0
      ]
  in
  `Assoc
    [ ( "antithesis_assert"
      , `Assoc
          [ "hit", `Bool hit
          ; "must_hit", `Bool true
          ; "assert_type", `String "always"
          ; "display_type", `String "Always"
          ; "condition", `Bool condition
          ; "id", `String id
          ; "message", `String id
          ; "location", location_obj
          ] )
    ]
;;

let write_jsonl_line path json =
  let line = Yojson.Safe.to_string json ^ "\n" in
  let oc =
    Stdlib.open_out_gen [ Open_wronly; Open_creat; Open_append; Open_binary ] 0o644 path
  in
  Exn.protect
    ~finally:(fun () -> Stdlib.close_out oc)
    ~f:(fun () -> Stdlib.output_string oc line)
;;

let emit_assertion loc ~passed =
  if is_running_in_antithesis ()
  then (
    let dir = Sys.getenv_exn antithesis_output_dir_env in
    let path = Filename.concat dir "sdk.jsonl" in
    write_jsonl_line path (assertion_json loc ~hit:false ~condition:false);
    write_jsonl_line path (assertion_json loc ~hit:true ~condition:passed))
;;