flan/test/test_repl.ml

(* C-x C-e: evaluating an expression inside a program that is running.

   A different primitive from redefining a name, and the difference is the
   whole test: there is no name to install a body into, so the expression is
   compiled into a thunk with nowhere to be called from, the module says "run
   this once", and the agent does — at a frame boundary, on the game thread.

   Nothing is marshalled back. A Flan value carries no header, so nothing at
   run time could say what it is; the compiler knows the type and renders it
   there. That is the layout decision's bill, and it is why only the scalars
   work so far.

   The case that matters most is the same expression evaluated twice with
   different answers: that is what says it read the live process's state rather
   than a copy of it. *)

open Flan

let failures = ref 0
let fail fmt = Printf.ksprintf (fun s -> incr failures; print_endline ("FAIL  " ^ s)) fmt

let scratch = Filename.get_temp_dir_name ()
let tmp n = Filename.concat scratch ("flan-repl-" ^ n)

let rec await ?(ms = 8000) f =
  if f () then true
  else if ms <= 0 then false
  else begin ignore (Unix.select [] [] [] 0.005); await ~ms:(ms - 5) f end

let rec connect ?(ms = 8000) path =
  let s = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in
  match Unix.connect s (Unix.ADDR_UNIX path) with
  | () -> s
  | exception Unix.Unix_error _ when ms > 0 ->
    Unix.close s;
    ignore (Unix.select [] [] [] 0.005);
    connect ~ms:(ms - 5) path

let request fd sexp = Wire.send fd sexp; Wire.parse (Wire.recv fd)
let field r k = Wire.string_field r k
let status r = match field r "status" with Some s -> s | None -> "<none>"

let quote s =
  let b = Buffer.create (String.length s + 8) in
  Buffer.add_char b '"';
  String.iter
    (fun c ->
       if c = '"' || c = '\\' then Buffer.add_char b '\\';
       Buffer.add_char b c)
    s;
  Buffer.add_char b '"';
  Buffer.contents b

let () =
  match Sys.command "command -v clang > /dev/null 2>&1 && command -v llc > /dev/null 2>&1" with
  | 0 ->
    let sock = tmp "dev.sock" and out = tmp "prog.out" in
    List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ sock; out ];
    let fd = Unix.openfile out [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
    let flan = "../bin/main.exe" in
    let pid =
      Unix.create_process flan
        [| flan; "dev"; "programs/dev-repl.flan"; "-s"; sock |]
        Unix.stdin fd Unix.stderr
    in
    Unix.close fd;
    if not (await (fun () -> Sys.file_exists sock)) then fail "the daemon never listened"
    else begin
      let c = connect sock in
      let evals code =
        request c
          (Printf.sprintf "(:op \"eval-expr\" :code %s :file \"/tmp/buf.flan\")"
             (quote code))
      in
      let value name code expected =
        let r = evals code in
        match field r "value" with
        | Some v when v = expected -> ()
        | Some v -> fail "%s\n        got: %S\n     wanted: %S" name v expected
        | None ->
          fail "%s: %s" name (Option.value ~default:(status r) (field r "message"))
      in
      value "arithmetic" "(+ 1 2)" "3";
      value "a comparison" "(< 1 2)" "true";
      value "a string" "\"hi\"" "hi";
      (* A defconst: its value is in the program's rodata and this reads it. *)
      value "a constant" "step-by" "3";

      (* The one that proves it ran inside the process: the program increments
         [ticks] every frame, so two evaluations of it must disagree. A copy
         of the program's state, or a value computed here, would not. *)
      let read () =
        match field (evals "ticks") "value" with
        | Some v -> int_of_string_opt v
        | None -> None
      in
      (match (read (), read ()) with
       | Some a, Some b when b > a -> ()
       | Some a, Some b ->
         fail "ticks read %d then %d — the expression did not see the live \
               program advancing" a b
       | _ -> fail "ticks did not evaluate");

      (* Types with no printer derived yet refuse by name rather than render
         something plausible and wrong. u64 is its own case: i64->bytes is
         signed, so anything past 2^63 would come back negative. *)
      let refuses name code reason =
        let r = evals code in
        match field r "message" with
        | Some m when
            (let n = String.length reason and h = String.length m in
             let rec go i = i + n <= h && (String.sub m i n = reason || go (i + 1)) in
             go 0) -> ()
        | Some m -> fail "%s said %S, wanted it to mention %S" name m reason
        | None -> fail "%s was accepted" name
      in
      refuses "u64" "rand-state" "no printer for u64";
      refuses "a declaration" "(defvar nope i64)" "";
      refuses "an unknown name" "no-such-name" "unknown name";

      (* And the session is untouched by all of it: an evaluation is not a
         declaration, so nothing named eval/N accumulates in the program. *)
      let r = request c "(:op \"describe\")" in
      if status r <> "ok" then fail "describe after evaluating: %s" (status r);

      ignore (request c "(:op \"close\")");
      Unix.close c
    end;
    (try Unix.kill pid Sys.sigterm with Unix.Unix_error _ -> ());
    (try ignore (Unix.waitpid [] pid) with Unix.Unix_error _ -> ());
    List.iter (fun f -> try Sys.remove f with Sys_error _ -> ()) [ sock; out ];
    if !failures = 0 then print_endline "repl: all tests passed"
    else begin
      Printf.printf "\n%d failure(s)\n" !failures;
      exit 1
    end
  | _ -> print_endline "repl: skipped (no clang or llc on PATH)"