path: root/test/test_mininix.ml

open Core

let with_dir path ~f =
  let fd = Core_unix.opendir path in
  f fd;
  Core_unix.closedir fd

let walk_dir path ~f =
  with_dir path ~f:(fun fd ->
      let rec go () =
        match Core_unix.readdir_opt fd with
        | Some entry ->
            f (Filename.concat path entry);
            go ()
        | None -> ()
      in
      go ())

type testcase = {
  name : string;
  dir : string;
  input : string;
  expected_output : [ `Okay of string | `Fail ];
}

let testdata_dir = "./testdata"
and testcases = ref []
and testcases_ignored = ref 0

let add_testcase c = testcases := c :: !testcases

let print_testcase_stats () =
  let okay, fail =
    List.fold !testcases ~init:(0, 0)
      ~f:(fun (okay, fail) { expected_output; _ } ->
        match expected_output with
        | `Okay _ -> (okay + 1, fail)
        | `Fail -> (okay, fail + 1))
  in
  printf
    "Loaded %d test cases (ignored %d), expected results: okay %d, fail %d\n%!"
    (okay + fail) !testcases_ignored okay fail

let imports () =
  Mininix.Import.materialize
    [ { filename = "./testdata/lib.nix"; deps = [] } ]
    ~relative_to:(Core_unix.getcwd ())

type eval_err = [ `Timeout | `ParseError | `ProgramError | `ElaborateError ]
[@@deriving sexp]

type eval_result = (string, eval_err) Result.t [@@deriving sexp]

let eval input ~name ~dir ~imports =
  let dir = Filename.to_absolute_exn dir ~relative_to:(Core_unix.getcwd ()) in
  try
    input
    |> Nix.parse ~filename:(name ^ ".nix")
    |> Nix.elaborate ~dir:(Some dir)
    |> Mininix.Nix2mininix.from_nix |> Mininix.apply_prelude
    |> Mininix.interp_tl ~fuel:`Limited ~mode:`Deep ~imports
    |> function
    | Res (Some v) ->
        Ok (v |> Mininix.Mininix2nix.from_val |> Nix.Printer.to_string)
    | Res None -> Error `ProgramError
    | NoFuel -> Error `Timeout
  with
  | Nix.ParseError _ -> Error `ParseError
  | Nix.ElaborateError _ -> Error `ElaborateError
  | Mininix.Nix2mininix.FromNixError _ -> Error `ElaborateError

let eval_subproc input ~name ~dir ~imports =
  let rxfd, txfd = Core_unix.pipe () in
  match Core_unix.fork () with
  | `In_the_child ->
      let txc = Core_unix.out_channel_of_descr txfd in
      eval input ~name ~dir ~imports
      |> [%sexp_of: eval_result] |> Sexp.output txc;
      exit 0
  | `In_the_parent child_pid ->
      let select_res =
        Core_unix.select ~restart:true ~read:[ rxfd ] ~write:[] ~except:[]
          ~timeout:(`After (Time_ns.Span.of_min 1.))
          ()
      in
      if List.is_empty select_res.read then (
        ignore (Signal_unix.send Signal.kill (`Pid child_pid));
        ignore (Core_unix.waitpid child_pid);
        Error `Timeout)
      else
        let rxc = Core_unix.in_channel_of_descr rxfd in
        let res = Sexp.input_sexp rxc |> [%of_sexp: eval_result] in
        ignore (Core_unix.waitpid child_pid);
        Core_unix.close ~restart:true rxfd;
        Core_unix.close ~restart:true txfd;
        res

type test_result =
  [ `Timeout
  | `ParseError
  | `ProgramError
  | `ElaborateError
  | `WrongOutput
  | `UnexpectedSuccess
  | `Okay ]

let run_testcase ~imports = function
  | { name; dir; input; expected_output = `Okay expected_output } -> (
      match eval_subproc input ~name ~dir ~imports with
      | Ok got_output ->
          if String.(strip got_output = strip expected_output) then `Okay
          else `WrongOutput
      | Error err -> (err :> test_result))
  | { name; dir; input; expected_output = `Fail } -> (
      match eval_subproc input ~name ~dir ~imports with
      | Ok _ -> `UnexpectedSuccess
      | Error _ -> `Okay)

type test_stats = {
  okay : int;
  unexpected_success : int;
  wrong_output : int;
  parse_error : int;
  elaborate_error : int;
  program_error : int;
  timeout : int;
}

let test_stats_empty =
  {
    okay = 0;
    unexpected_success = 0;
    wrong_output = 0;
    parse_error = 0;
    elaborate_error = 0;
    program_error = 0;
    timeout = 0;
  }

let run_testcases () =
  Nix.Printer.set_width 1000000;
  let mat_imports = imports () in
  let stats =
    List.foldi !testcases ~init:test_stats_empty ~f:(fun i stats c ->
        printf "[%d/%d] %s  %!" (i + 1) (List.length !testcases) c.name;
        match run_testcase c ~imports:mat_imports with
        | `Okay ->
            printf "okay\n%!";
            { stats with okay = stats.okay + 1 }
        | `UnexpectedSuccess ->
            printf "unexpectedly succeeded\n%!";
            { stats with unexpected_success = stats.unexpected_success + 1 }
        | `WrongOutput ->
            printf "gave wrong output\n%!";
            { stats with wrong_output = stats.wrong_output + 1 }
        | `ParseError ->
            printf "could not be parsed\n%!";
            { stats with parse_error = stats.parse_error + 1 }
        | `ElaborateError ->
            printf "could not be elaborated\n%!";
            { stats with elaborate_error = stats.elaborate_error + 1 }
        | `ProgramError ->
            printf "failed to execute\n%!";
            { stats with program_error = stats.program_error + 1 }
        | `Timeout ->
            printf "timed out\n%!";
            { stats with timeout = stats.timeout + 1 })
  in
  printf
    "Results:\n\
    \  %d gave the expected output\n\
    \  %d unexpectedly succeeded\n\
    \  %d gave wrong output\n\
    \  %d could not be parsed\n\
    \  %d could not be elaborated\n\
    \  %d failed to execute\n\
    \  %d timed out\n\
     %!"
    stats.okay stats.unexpected_success stats.wrong_output stats.parse_error
    stats.elaborate_error stats.program_error stats.timeout

let try_add_testcase without_ext =
  try
    let dir = Filename.dirname without_ext in
    let input = In_channel.read_all (without_ext ^ ".nix") in
    let name = Filename.basename without_ext in
    if String.is_prefix ~prefix:"eval-fail" name then
      add_testcase { name; dir; input; expected_output = `Fail }
    else if String.is_prefix ~prefix:"eval-okay" name then
      let expected_output = In_channel.read_all (without_ext ^ ".exp") in
      add_testcase { name; dir; input; expected_output = `Okay expected_output }
  with
  (* There are certain test cases where the '.nix' file is available, but
     there is no '.exp' file. (Instead, for example, there may be a
     '.exp-disabled' file, which we don't check for.) So [add_testcase] fails
     when trying to read the '.exp' file, which does not exist. We catch the
     exception that is then raised in [add_testcase] here. *)
  | Sys_error _ ->
    ()

let ignore_tests =
  [
    (* We do not implement '«repeated»' *)
    "eval-okay-repeated-empty-attrs";
    "eval-okay-repeated-empty-list";
    (* # Very specific / hard-to-implement builtins: *)
    (* We do not implement conversion from/to JSON/XML *)
    "eval-okay-toxml";
    "eval-okay-toxml2";
    "eval-okay-tojson";
    "eval-okay-fromTOML";
    "eval-okay-fromTOML-timestamps";
    "eval-okay-fromjson";
    "eval-okay-fromjson-escapes";
    "eval-fail-fromJSON-overflowing";
    "eval-fail-fromTOML-timestamps";
    "eval-fail-toJSON";
    (* We do not implement hasing *)
    "eval-okay-convertHash";
    "eval-okay-hashstring";
    "eval-okay-hashfile";
    "eval-okay-groupBy";
    "eval-okay-zipAttrsWith";
    "eval-fail-hashfile-missing";
    (* We do not support filesystem operations *)
    "eval-okay-readDir";
    "eval-okay-readfile";
    "eval-okay-readFileType";
    "eval-okay-symlink-resolution";
    (* We do not support version operations *)
    "eval-okay-splitversion";
    "eval-okay-versions";
    (* We do not support flake references *)
    "eval-okay-parse-flake-ref";
    "eval-okay-flake-ref-to-string";
    "eval-fail-flake-ref-to-string-negative-integer";
    (* We do not support regexes *)
    "eval-okay-regex-match";
    "eval-okay-regex-split";
    (* # Features that the core interpreter lacks *)
    (* We do not implement derivations and contexts *)
    "eval-okay-derivation-legacy";
    "eval-okay-eq-derivations";
    "eval-fail-addDrvOutputDependencies-empty-context";
    "eval-fail-addDrvOutputDependencies-multi-elem-context";
    "eval-fail-addDrvOutputDependencies-wrong-element-kind";
    "eval-fail-assert-equal-derivations";
    "eval-fail-assert-equal-derivations-extra";
    "eval-fail-derivation-name";
    "eval-okay-context";
    "eval-okay-context-introspection";
    "eval-okay-substring-context";
    "eval-fail-addErrorContext-example";
    (* We do not support scopedImport *)
    "eval-okay-import";
    (* We do not support tryEval *)
    "eval-okay-redefine-builtin";
    "eval-okay-tryeval";
    (* We do not support unsafeGetAttrPos nor __curPos *)
    "eval-okay-curpos";
    "eval-okay-getattrpos";
    "eval-okay-getattrpos-functionargs";
    "eval-okay-getattrpos-undefined";
    "eval-okay-inherit-attr-pos";
    (* We do not support environment variable lookup *)
    "eval-okay-getenv";
    (* We do not support '__override's. Rationale: this construct has expressly
       been avoided in Nixpkgs since the 13.10 release, see
       https://github.com/NixOS/nixpkgs/issues/2112 *)
    "eval-okay-attrs6";
    "eval-okay-overrides";
    "eval-fail-set-override";
    (* We do not implement the 'trace' builtin *)
    "eval-okay-print";
    "eval-okay-inherit-from";
    (* ^ also uses __overrides, for which we lack support *)
    (* We do not implement flags to set arguments / retrieve attributes
       for the evaluator *)
    (* We do not support setting variables outside of the program *)
    "eval-okay-autoargs";
    (* We do not support paths *)
    "eval-okay-baseNameOf";
    "eval-okay-path";
    "eval-okay-path-string-interpolation";
    "eval-okay-pathexists";
    "eval-okay-search-path";
    "eval-okay-string";
    "eval-okay-types";
    "eval-fail-assert-equal-paths";
    "eval-fail-bad-string-interpolation-2";
    "eval-fail-nonexist-path";
    "eval-fail-path-slash";
    "eval-fail-to-path";
    (* We do not implement the 'currentSystem' and 'dirOf' builtins *)
    "eval-okay-builtins";
    (* We do not support fetch operations *)
    "eval-fail-fetchTree-negative";
    "eval-fail-fetchurl-baseName";
    "eval-fail-fetchurl-baseName-attrs";
    "eval-fail-fetchurl-baseName-attrs-name";
    (* We do not support the pipe operator *)
    "eval-fail-pipe-operators";
  ]

let () =
  Printf.printf "Running in %s\n%!" (Core_unix.getcwd ());
  walk_dir testdata_dir ~f:(fun entry ->
      match Filename.split_extension entry with
      | without_ext, Some "nix" ->
          if
            List.exists ignore_tests ~f:(fun name ->
                String.(name = Filename.basename without_ext))
          then testcases_ignored := !testcases_ignored + 1
          else try_add_testcase without_ext
      | _ -> ());
  testcases :=
    List.sort !testcases ~compare:(fun c1 c2 -> String.compare c1.name c2.name);
  print_testcase_stats ();
  run_testcases ()