Exercise generated programs with update sequences

test/test_codegen.ml

@@ -546,3 +546,145 @@ let cli_cases =
         check "the full traversal counter appears" (String.length output > 0);
         Native.remove_dir dir );
   ]
+
+let rec wire_of_value value =
+  match value with
+  | Value.VUnit -> Wire.WUnit
+  | Value.VInt number -> Wire.WInt number
+  | Value.VBool truth -> Wire.WBool truth
+  | Value.VString text -> Wire.WString text
+  | Value.VTuple items -> Wire.WTuple (List.map wire_of_value items)
+  | Value.VRecord (_, fields) -> Wire.WRecord (List.map (fun (label, item) -> (label, wire_of_value item)) fields)
+  | Value.VCollection entries ->
+      Wire.WCollection (List.map (fun (key, item) -> (key, wire_of_value item)) (Delta_runtime.Pure_map.bindings entries))
+
+let rec value_of_wire value =
+  match value with
+  | Wire.WUnit -> Value.VUnit
+  | Wire.WInt number -> Value.VInt number
+  | Wire.WBool truth -> Value.VBool truth
+  | Wire.WString text -> Value.VString text
+  | Wire.WTuple items -> Value.VTuple (List.map value_of_wire items)
+  | Wire.WRecord fields -> Value.VRecord ("", List.map (fun (label, item) -> (label, value_of_wire item)) fields)
+  | Wire.WCollection entries ->
+      Value.VCollection
+        (Value.collection_of_list (List.map (fun (key, item) -> (key, value_of_wire item)) entries))
+
+let write_entries path entries =
+  write_file path
+    (String.concat ""
+       (List.map (fun (key, value) -> Printf.sprintf "(%d %s)\n" key (Wire.to_string (wire_of_value value))) entries))
+
+let write_batches path batches =
+  write_file path
+    (String.concat ""
+       (List.map
+          (fun ops ->
+            "(batch"
+            ^ String.concat ""
+                (List.map
+                   (fun op ->
+                     match op with
+                     | Change.OpInsert (key, value) ->
+                         Printf.sprintf " (insert %d %s)" key (Wire.to_string (wire_of_value value))
+                     | Change.OpRemove key -> Printf.sprintf " (remove %d)" key
+                     | Change.OpReplace (key, value) ->
+                         Printf.sprintf " (replace %d %s)" key (Wire.to_string (wire_of_value value)))
+                   ops)
+            ^ ")\n")
+          batches))
+
+let compile_query name text =
+  let typed = infer text in
+  let plan = Simplify.simplify (Graph.build (Anf.program (Specialize.program typed))) in
+  let dir = Filename.temp_file "delta_prog" "" in
+  Sys.remove dir;
+  Unix.mkdir dir 0o700;
+  let source_path = Filename.concat dir (unique name ^ ".ml") in
+  let exe_path = Filename.concat dir (unique name ^ ".exe") in
+  write_file source_path (Emit.program_to_string plan);
+  match compile source_path exe_path with
+  | Some message -> Error ("compilation failed:\n" ^ message)
+  | None -> Ok (typed, exe_path, dir)
+
+let reference_outputs typed entries batches =
+  let state = ref (Value.collection_of_list entries) in
+  let results = ref [ Interpret.program typed (Delta_runtime.Pure_map.bindings !state) ] in
+  List.iter
+    (fun ops ->
+      match Change.validate_batch ~existing:!state ops with
+      | Change.Failure message ->
+          fail "reference"
+            (Printf.sprintf "%s with state %s" message
+               (Value.to_string (Value.VCollection !state)))
+      | Change.Success (temp, _) ->
+          state := temp;
+          results := !results @ [ Interpret.program typed (Delta_runtime.Pure_map.bindings temp) ])
+    batches;
+  !results
+
+let generated_differential_case seed_count batch_count =
+  List.iter
+    (fun (name, text) ->
+      match compile_query name text with
+      | Error message -> fail name message
+      | Ok (typed, executable, dir) ->
+          let element = typed.Typed.tp_input_element in
+          List.iter
+            (fun seed ->
+              let rng = rng (seed + (77 * String.length name)) in
+              let entries =
+                Util.list_init (range rng 5 + 1) (fun index ->
+                    (index + 1, Test_change.value_for rng typed.Typed.tp_records element))
+              in
+              let rec generate count current acc =
+                if count <= 0 then List.rev acc
+                else
+                  let ops = Test_incremental.random_batch rng typed.Typed.tp_records element current in
+                  let next =
+                    match Change.validate_batch ~existing:current ops with
+                    | Change.Failure message ->
+                        fail name (Printf.sprintf "seed %d: generated an invalid batch: %s" seed message);
+                        current
+                    | Change.Success (temp, _) -> temp
+                  in
+                  generate (count - 1) next (ops :: acc)
+              in
+              let batches = generate batch_count (Value.collection_of_list entries) [] in
+              let reference = reference_outputs typed entries batches in
+              let expected =
+                List.tl reference @ [ List.nth reference (List.length reference - 1) ]
+              in
+              let input_path = Filename.concat dir (Printf.sprintf "input_%d.sexp" seed) in
+              let updates_path = Filename.concat dir (Printf.sprintf "updates_%d.sexp" seed) in
+              write_entries input_path entries;
+              write_batches updates_path batches;
+              (match run [ executable; "--input"; input_path; "--updates"; updates_path; "--trace"; "--print-result" ] with
+              | Unix.WEXITED 0, output ->
+                  let lines = List.filter (fun line -> line <> "") (String.split_on_char '\n' output) in
+                  if List.length lines <> List.length expected then
+                    fail name
+                      (Printf.sprintf "seed %d: expected %d results but the program printed %d" seed
+                         (List.length expected) (List.length lines))
+                  else
+                    List.iteri
+                      (fun index line ->
+                        let want = Wire.to_string (wire_of_value (List.nth expected index)) in
+                        if line <> want then
+                          fail name
+                            (Printf.sprintf "seed %d step %d: expected %s but got %s" seed index want line))
+                      lines
+              | _, output ->
+                  fail name (Printf.sprintf "seed %d: the program failed:\n%s" seed output));
+              Sys.remove input_path;
+              Sys.remove updates_path)
+            (Util.list_init seed_count (fun index -> index + 1));
+          Native.remove_dir dir)
+    (List.filter (fun (name, _) -> name <> "strings") Test_incremental.differential_queries)
+
+let generated_differential_cases =
+  [
+    ("generated programs match full evaluation", fun () -> generated_differential_case 12 25);
+    ("generated programs match full evaluation on a short run",
+     fun () -> generated_differential_case 2 3);
+  ]