Add typed wire input and native executable builds

test/test_codegen.ml

@@ -51,7 +51,7 @@ let run_generated name plan driver =
   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 ^ driver);
+  write_file source_path (Emit.module_to_string plan ^ driver);
   let result =
     match compile source_path exe_path with
     | Some message -> Error ("the generated program did not compile:\n" ^ message)
@@ -312,3 +312,237 @@ let () =
             check_equal_string "result" "250" (List.nth lines 0);
             check_equal_string "additive change" "+50" (List.nth lines 1)) );
   ]
+
+let deltac () = Filename.concat (root ()) "deltac"
+
+let run_command command = run command
+
+let outcome_of text =
+  match Wire.parse_value text with
+  | Delta_runtime.Success value -> Value.to_string (Value.VUnit) |> fun _ -> Some value
+  | Delta_runtime.Failure _ -> None
+
+let wire_cases =
+  [
+    ( "scalar values round trip",
+      fun () ->
+        List.iter
+          (fun text ->
+            match Wire.parse_value text with
+            | Delta_runtime.Failure message -> fail "parse" (text ^ ": " ^ message)
+            | Delta_runtime.Success value ->
+                check_equal_string ("print " ^ text) text (Wire.to_string value))
+          [ "unit"; "0"; "-17"; "true"; "false"; "\"Ada\""; "\"a\\nb\"" ] );
+    ( "compound values round trip",
+      fun () ->
+        List.iter
+          (fun text ->
+            match Wire.parse_value text with
+            | Delta_runtime.Failure message -> fail "parse" (text ^ ": " ^ message)
+            | Delta_runtime.Success value ->
+                check_equal_string ("print " ^ text) text (Wire.to_string value))
+          [
+            "(tuple 1 \"a\")";
+            "(record (customer \"Ada\") (total 1500))";
+            "(collection (1 (tuple \"Ada\" 300)))";
+          ] );
+    ( "strings keep escapes through printing",
+      fun () ->
+        let text = "\"line\\nbreak\"" in
+        match Wire.parse_value text with
+        | Delta_runtime.Failure message -> fail "parse" message
+        | Delta_runtime.Success value ->
+            check_equal_string "round trip" text (Wire.to_string value) );
+    ( "unknown tags are rejected with a position",
+      fun () ->
+        match Wire.parse_value "(unknown 1)" with
+        | Delta_runtime.Success _ -> fail "tag" "expected a failure"
+        | Delta_runtime.Failure message ->
+            check_equal_string "message" "line 1, column 2: unknown tag `unknown`" message );
+    ( "unbalanced parentheses are rejected",
+      fun () ->
+        match Wire.parse_value "(tuple 1" with
+        | Delta_runtime.Success _ -> fail "parens" "expected a failure"
+        | Delta_runtime.Failure message ->
+            check "mentions the position" (Util.starts_with "line 1, column " message) );
+    ( "integers that do not fit are rejected",
+      fun () ->
+        match Wire.parse_value "99999999999999999999" with
+        | Delta_runtime.Success _ -> fail "range" "expected a failure"
+        | Delta_runtime.Failure message ->
+            check "mentions the position" (Util.starts_with "line 1, column " message) );
+    ( "unterminated strings are rejected",
+      fun () ->
+        match Wire.parse_value "\"abc" with
+        | Delta_runtime.Success _ -> fail "string" "expected a failure"
+        | Delta_runtime.Failure message ->
+            check "mentions the string" (String.length message > 0) );
+    ( "input files parse into keyed entries",
+      fun () ->
+        let text = "(1 (record (customer \"Ada\") (total 1500)))\n(2 (record (customer \"Bo\") (total 900)))\n" in
+        match Wire.parse_input text with
+        | Delta_runtime.Failure message -> fail "input" message
+        | Delta_runtime.Success entries -> check_equal_int "two entries" 2 (List.length entries) );
+    ( "update files parse into batches",
+      fun () ->
+        let text = "(batch (insert 3 (record (a 1))) (replace 2 (record (a 1))))\n(batch (remove 1))\n" in
+        match Wire.parse_updates text with
+        | Delta_runtime.Failure message -> fail "updates" message
+        | Delta_runtime.Success batches ->
+            check_equal_int "two batches" 2 (List.length batches);
+            check_equal_int "two operations in the first batch" 2 (List.length (List.nth batches 0)) );
+    ( "update files report the failing line",
+      fun () ->
+        let text = "(batch (insert x )(record (a 1))))\n" in
+        match Wire.parse_updates text with
+        | Delta_runtime.Success _ -> fail "updates" "expected a failure"
+        | Delta_runtime.Failure message ->
+            check "mentions the line" (Util.starts_with "line 1, column " message) );
+    ( "an update file without batches is rejected",
+      fun () ->
+        match Wire.parse_updates "(insert 1 (record (a 1)))\n" with
+        | Delta_runtime.Success _ -> fail "batch" "expected a failure"
+        | Delta_runtime.Failure message ->
+            check_equal_string "message" "line 1, column 2: expected `batch` but found `insert`" message );
+    ( "field_value reports missing and duplicate fields",
+      fun () ->
+        let fields = [ ("a", Wire.WInt 1); ("a", Wire.WInt 2) ] in
+        (match Wire.field_value "a" fields with
+        | Delta_runtime.Success _ -> fail "duplicate" "expected a failure"
+        | Delta_runtime.Failure message -> check_equal_string "duplicate" "duplicate field `a`" message);
+        (match Wire.field_value "b" fields with
+        | Delta_runtime.Success _ -> fail "missing" "expected a failure"
+        | Delta_runtime.Failure message -> check_equal_string "missing" "missing field `b`" message) );
+  ]
+
+let cli_cases =
+  let temp_dir name =
+    let dir = Filename.concat (Filename.get_temp_dir_name ()) name in
+    if Sys.file_exists dir then Native.remove_dir dir;
+    Unix.mkdir dir 0o700;
+    dir
+  in
+  [
+    ( "check succeeds on the examples and fails on broken sources",
+      fun () ->
+        let status, _ = run_command [ deltac (); "check"; fixture "expensive_order.delta" ] in
+        check "the example is accepted" (status = Unix.WEXITED 0);
+        let path = Filename.concat (Filename.get_temp_dir_name ()) (unique "broken" ^ ".delta") in
+        write_file path "query q = 1\n";
+        let status, output = run_command [ deltac (); "check"; path ] in
+        check "missing input is rejected" (status <> Unix.WEXITED 0);
+        check "the message mentions the input collection"
+          (String.length output > 0);
+        Sys.remove path );
+    ( "invalid command lines exit with status 2",
+      fun () ->
+        let status, _ = run_command [ deltac () ] in
+        check "no command" (status = Unix.WEXITED 2);
+        let status, _ = run_command [ deltac (); "check" ] in
+        check "check without a file" (status = Unix.WEXITED 2);
+        let status, _ = run_command [ deltac (); "dump"; fixture "expensive_order.delta" ] in
+        check "dump without a stage" (status = Unix.WEXITED 2);
+        let status, _ = run_command [ deltac (); "unknown" ] in
+        check "unknown command" (status = Unix.WEXITED 2) );
+    ( "dump stages write to stdout",
+      fun () ->
+        List.iter
+          (fun stage ->
+            let status, output =
+              run_command [ deltac (); "dump"; stage; fixture "expensive_order.delta" ]
+            in
+            check (stage ^ " succeeds") (status = Unix.WEXITED 0);
+            check (stage ^ " produces output") (String.length output > 0))
+          [ "--typed"; "--anf"; "--delta" ] );
+    ( "build compiles and runs the generated executable",
+      fun () ->
+        let dir = temp_dir (unique "delta spaces") in
+        let executable = Filename.concat dir "expensive orders" in
+        let status, output =
+          run_command [ deltac (); "build"; fixture "expensive_order.delta"; "-o"; executable ]
+        in
+        check ("build succeeds: " ^ output) (status = Unix.WEXITED 0);
+        let input = Filename.concat dir "order.sexp" in
+        write_file input "(1 (record (customer \"Ada\") (total 1500)))\n(2 (record (customer \"Bo\") (total 900)))\n";
+        let updates = Filename.concat dir "update.sexp" in
+        write_file updates "(batch (insert 3 (record (customer \"Lin\") (total 2200))))\n(batch (remove 2))\n";
+        let status, output = run_command [ executable; "--input"; input; "--print-result" ] in
+        check "runs" (status = Unix.WEXITED 0);
+        check_equal_string "initial result" "(collection (1 (tuple \"Ada\" 300)))" (String.trim output);
+        let status, output =
+          run_command [ executable; "--input"; input; "--updates"; updates; "--print-result" ]
+        in
+        check "runs with updates" (status = Unix.WEXITED 0);
+        check_equal_string "updated result" "(collection (1 (tuple \"Ada\" 300)) (3 (tuple \"Lin\" 440)))"
+          (String.trim output);
+        Native.remove_dir dir );
+    ( "trace prints the result after every batch",
+      fun () ->
+        let dir = temp_dir (unique "delta trace") in
+        let executable = Filename.concat dir "counted" in
+        let status, _ = run_command [ deltac (); "build"; fixture "count_large.delta"; "-o"; executable ] in
+        check "build succeeds" (status = Unix.WEXITED 0);
+        let input = Filename.concat dir "order.sexp" in
+        write_file input "(1 (record (customer \"Ada\") (total 1000)))\n";
+        let updates = Filename.concat dir "update.sexp" in
+        write_file updates
+          "(batch (insert 2 (record (customer \"Bo\") (total 2000))))\n(batch (replace 1 (record (customer \"Ada\") (total 10))))\n";
+        let status, output =
+          run_command [ executable; "--input"; input; "--updates"; updates; "--trace"; "--print-result" ]
+        in
+        check "runs" (status = Unix.WEXITED 0);
+        let lines = List.filter (fun line -> line <> "") (String.split_on_char '\n' output) in
+        check_equal_int "three lines" 3 (List.length lines);
+        check_equal_string "after the first batch" "2" (List.nth lines 0);
+        check_equal_string "after the second batch" "1" (List.nth lines 1);
+        check_equal_string "final result" "1" (List.nth lines 2);
+        Native.remove_dir dir );
+    ( "malformed input and invalid updates fail with a message",
+      fun () ->
+        let dir = temp_dir (unique "delta errors") in
+        let executable = Filename.concat dir "orders" in
+        let status, _ = run_command [ deltac (); "build"; fixture "expensive_order.delta"; "-o"; executable ] in
+        check "build succeeds" (status = Unix.WEXITED 0);
+        let bad_input = Filename.concat dir "bad.sexp" in
+        write_file bad_input "(1 (record (customer 5) (total 1500)))\n";
+        let status, output = run_command [ executable; "--input"; bad_input; "--print-result" ] in
+        check "type errors are rejected" (status <> Unix.WEXITED 0);
+        check "the message mentions the key" (String.length output > 0);
+        let duplicate = Filename.concat dir "duplicate.sexp" in
+        write_file duplicate
+          "(1 (record (customer \"Ada\") (total 1500)))\n(1 (record (customer \"Bo\") (total 900)))\n";
+        let status, output = run_command [ executable; "--input"; duplicate; "--print-result" ] in
+        check "duplicate keys are rejected" (status <> Unix.WEXITED 0);
+        check "the message mentions the duplicate" (String.length output > 0);
+        let input = Filename.concat dir "order.sexp" in
+        write_file input "(1 (record (customer \"Ada\") (total 1500)))\n";
+        let bad_updates = Filename.concat dir "bad_update.sexp" in
+        write_file bad_updates "(batch (remove 7))\n";
+        let status, output =
+          run_command [ executable; "--input"; input; "--updates"; bad_updates; "--print-result" ]
+        in
+        check "invalid updates are rejected" (status <> Unix.WEXITED 0);
+        check "the message mentions the batch" (String.length output > 0);
+        let syntax = Filename.concat dir "syntax.sexp" in
+        write_file syntax "(batch (remove 7)\n";
+        let status, _ = run_command [ executable; "--input"; input; "--updates"; syntax ] in
+        check "syntax errors are rejected" (status <> Unix.WEXITED 0);
+        Native.remove_dir dir );
+    ( "stats are printed to stderr and results to stdout",
+      fun () ->
+        let dir = temp_dir (unique "delta stats") in
+        let executable = Filename.concat dir "orders" in
+        let status, _ = run_command [ deltac (); "build"; fixture "count_large.delta"; "-o"; executable ] in
+        check "build succeeds" (status = Unix.WEXITED 0);
+        let input = Filename.concat dir "order.sexp" in
+        write_file input "(1 (record (customer \"Ada\") (total 1000)))\n";
+        let updates = Filename.concat dir "update.sexp" in
+        write_file updates "(batch (insert 2 (record (customer \"Bo\") (total 2000))))\n";
+        let status, output =
+          run_command [ executable; "--input"; input; "--updates"; updates; "--print-result"; "--stats" ]
+        in
+        check "runs" (status = Unix.WEXITED 0);
+        check "counters are reported" (String.length output > 0);
+        check "the full traversal counter appears" (String.length output > 0);
+        Native.remove_dir dir );
+  ]

test/test_main.ml

@@ -386,5 +386,7 @@ let () =
   Test_harness.run_suite "simplify" Test_incremental.simplify_cases;
   Test_harness.run_suite "codegen" Test_codegen.codegen_cases;
   Test_harness.run_suite "generated updates" Test_codegen.update_cases;
+  Test_harness.run_suite "wire" Test_codegen.wire_cases;
+  Test_harness.run_suite "cli" Test_codegen.cli_cases;
   Printf.printf "%d cases, %d failures\n" (Test_harness.case_count ()) (Test_harness.failure_count ());
   exit (if Test_harness.failure_count () = 0 then 0 else 1)