flan/test/test_dev.ml

(* [flan dev]: the daemon an editor talks to (NEXT.md, the dev loop).

   What it adds over [flan reload] is that the session persists between
   evaluations and that the daemon owns the build, so its idea of the running
   process is not a guess. Both are tested here by sending a sequence: a name
   the program was never built with, then a second evaluation that uses it. If
   the session were rebuilt per request the second one would not even check. *)

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-devtest-" ^ n)

let rec await ?(ms = 5000) 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 = 5000) 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 status r =
  match Wire.string_field r "status" with Some s -> s | None -> "<none>"

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" in
    let out = tmp "prog.out" in
    (try Sys.remove sock with Sys_error _ -> ());
    let fd = Unix.openfile out [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
    (* The daemon is run as a subprocess rather than in-process because that is
       how an editor meets it, and because it launches and owns a program of
       its own. Its child's stdout is what we read the result off. *)
    let flan = "../bin/main.exe" in
    let pid =
      Unix.create_process flan
        [| flan; "dev"; "programs/dev-loop.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
      (* The daemon owns the program's lifetime and kills it on [close], so
         every step waits for the program to have got there. "ok" from an eval
         means the module was queued, not that it has been installed. *)
      let lines () =
        List.length
          (String.split_on_char '\n'
             (In_channel.with_open_bin out In_channel.input_all))
        - 1
      in
      let c = connect sock in

      (* describe: what the daemon believes about the program it launched. *)
      let r = request c "(:op \"describe\")" in
      if status r <> "ok" then fail "describe: %s" (status r);

      (* A form that does not check comes back as an error with a location,
         and must not disturb the session. *)
      let r = request c "(:op \"eval\" :code \"(defn step [] i64 nonsense)\" :file \"/tmp/buf.flan\")" in
      if status r <> "error" then fail "a bad form was accepted";
      (match Wire.string_field r "loc" with
       | Some l when String.length l > 0 -> ()
       | _ -> fail "an error carried no location");

      (* A name the program was never built with, then a second evaluation
         that uses it. The second one only checks at all because the session
         kept the first. *)
      let r =
        request c
          "(:op \"eval\" :code \"(defvar extra i64) (defn step [] i64 (set extra (+ extra 5)) extra)\" :file \"/tmp/buf.flan\")"
      in
      if status r <> "ok" then
        fail "adding a var: %s"
          (Option.value ~default:"" (Wire.string_field r "message"));
      (* Wait for the program to have installed it before sending the next.
         Both queued at once is a legitimate thing for the agent to do — one
         poll installs everything pending — but then only the last is observed
         and the sequencing is not what was tested. *)
      if not (await (fun () -> lines () >= 2)) then
        fail "the first reload was never installed";
      let r =
        request c
          "(:op \"eval\" :code \"(defn step [] i64 (set extra (+ extra 100)) extra)\" :file \"/tmp/buf.flan\")"
      in
      if status r <> "ok" then
        fail "reusing a var added earlier: %s"
          (Option.value ~default:"" (Wire.string_field r "message"));

      (* A change the running process cannot be told, refused with the reason
         rather than delivered. *)
      let r = request c "(:op \"eval\" :code \"(defvar ticks i32)\" :file \"/tmp/buf.flan\")" in
      if status r <> "error"
         || not
              (match Wire.string_field r "message" with
               | Some m -> String.length m > 0
               | None -> false)
      then fail "retyping a global was not refused";

      if not (await (fun () -> lines () >= 3)) then
        fail "the second reload was never installed";
      ignore (request c "(:op \"close\")");
      Unix.close c;
      (* Closing the connection ends the program, and its transcript is the
         proof: 1 before any reload, 5 from a body over a var that did not
         exist when it started, 105 from a second body reading the same one. *)
      ignore (Unix.waitpid [] pid);
      let text = In_channel.with_open_bin out In_channel.input_all in
      if text <> "1\n5\n105\n" then
        fail "program transcript\n        got: %S\n     wanted: %S" text "1\n5\n105\n"
    end;

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