691 lines
32 KiB
OCaml
691 lines
32 KiB
OCaml
open Test_harness
|
|
|
|
let build_dir () = try Sys.getenv "DELTA_BUILD_DIR" with Not_found -> "_build"
|
|
|
|
let ocamlopt () = try Sys.getenv "DELTA_OCAMLOPT" with Not_found -> "ocamlopt"
|
|
|
|
let unique name =
|
|
Printf.sprintf "%s_%d_%d" name (Unix.getpid ()) (Random.self_init (); Random.int 1000000)
|
|
|
|
let write_file path text =
|
|
let channel = open_out path in
|
|
output_string channel text;
|
|
close_out channel
|
|
|
|
let run command =
|
|
let log = Filename.temp_file "delta_test" ".log" in
|
|
let fd = Unix.openfile log [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in
|
|
let argv = Array.of_list command in
|
|
let pid = Unix.create_process argv.(0) argv Unix.stdin fd fd in
|
|
let status = snd (Unix.waitpid [] pid) in
|
|
Unix.close fd;
|
|
let text = Native.read_file log in
|
|
(try Sys.remove log with _ -> ());
|
|
(status, text)
|
|
|
|
let compile source_path output_path =
|
|
let command =
|
|
[ ocamlopt (); "-I"; build_dir (); "-I"; "+unix"; "-o"; output_path;
|
|
Filename.concat (build_dir ()) "delta_runtime.cmxa"; "unix.cmxa"; source_path ]
|
|
in
|
|
match run command with
|
|
| Unix.WEXITED 0, _ -> None
|
|
| _, text -> Some text
|
|
|
|
let example_driver =
|
|
{|
|
|
let () =
|
|
let rows =
|
|
[ (1, { customer = "Ada"; total = 1500 });
|
|
(2, { customer = "Bo"; total = 900 });
|
|
(3, { customer = "Lin"; total = 2200 }) ]
|
|
in
|
|
let state = Query.init rows in
|
|
print_endline (Query.output_to_string (Query.result state));
|
|
print_endline (Delta_runtime.counters_to_string (Query.counters ()))
|
|
|}
|
|
|
|
let run_generated name plan driver =
|
|
let dir = Filename.temp_file "delta_gen" "" 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.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)
|
|
| None -> (
|
|
match run [ exe_path ] with
|
|
| Unix.WEXITED 0, text -> Ok text
|
|
| _, text -> Error ("the generated program failed:\n" ^ text))
|
|
in
|
|
Native.remove_dir dir;
|
|
result
|
|
|
|
let sample_plan fixture =
|
|
let typed = infer (read_fixture fixture) in
|
|
Simplify.simplify (Graph.build (Anf.program (Specialize.program typed)))
|
|
|
|
let codegen_cases =
|
|
[
|
|
( "the emitted module initializes the example query",
|
|
fun () ->
|
|
let plan = sample_plan "expensive_order.delta" in
|
|
match run_generated "expensive_orders" plan example_driver with
|
|
| Error message -> fail "emitted program" message
|
|
| Ok output ->
|
|
let lines = String.split_on_char '\n' output in
|
|
check_equal_string "output"
|
|
"[ (1, (\"Ada\", 300)); (3, (\"Lin\", 440)) ]"
|
|
(List.nth lines 0);
|
|
check "counters are reported" (String.length (List.nth lines 1) > 0) );
|
|
( "the emitted module handles an integer query",
|
|
fun () ->
|
|
let plan = sample_plan "revenue.delta" in
|
|
let driver =
|
|
{|
|
|
let () =
|
|
let rows = [ (1, { customer = "Ada"; total = 1000 }); (2, { customer = "Bo"; total = 250 }) ] in
|
|
let state = Query.init rows in
|
|
print_endline (Query.output_to_string (Query.result state))
|
|
|}
|
|
in
|
|
(match run_generated "revenue" plan driver with
|
|
| Error message -> fail "emitted program" message
|
|
| Ok output -> check_equal_string "revenue" "250" (String.trim output)) );
|
|
( "the emitted module handles a count query",
|
|
fun () ->
|
|
let plan = sample_plan "count_large.delta" in
|
|
let driver =
|
|
{|
|
|
let () =
|
|
let rows =
|
|
[ (1, { customer = "Ada"; total = 1000 });
|
|
(2, { customer = "Bo"; total = 250 });
|
|
(3, { customer = "Lin"; total = 501 }) ]
|
|
in
|
|
let state = Query.init rows in
|
|
print_endline (Query.output_to_string (Query.result state))
|
|
|}
|
|
in
|
|
(match run_generated "count_large" plan driver with
|
|
| Error message -> fail "emitted program" message
|
|
| Ok output -> check_equal_string "count" "2" (String.trim output)) );
|
|
( "the emitted module compiles for a tuple valued query",
|
|
fun () ->
|
|
let typed =
|
|
infer
|
|
"type line = { price : int; quantity : int }\ninput lines : collection line\nquery q = lines |> filter (fun l -> l.quantity > 0) |> map (fun l -> (l.price, l.price * l.quantity))\n"
|
|
in
|
|
let plan = Simplify.simplify (Graph.build (Anf.program (Specialize.program typed))) in
|
|
let driver = "let _ = Query.init []\n" in
|
|
(match run_generated "tuple_query" plan driver with
|
|
| Error message -> fail "emitted program" message
|
|
| Ok _ -> check "compiles and runs" true) );
|
|
( "the emitted module compiles for a boolean valued query",
|
|
fun () ->
|
|
let typed =
|
|
infer
|
|
"type line = { price : int; quantity : int }\ninput lines : collection line\nquery q = lines |> map (fun l -> (l.price > 0, l.quantity))\n"
|
|
in
|
|
let plan = Simplify.simplify (Graph.build (Anf.program (Specialize.program typed))) in
|
|
(match run_generated "bool_query" plan "let _ = Query.init []\n" with
|
|
| Error message -> fail "emitted program" message
|
|
| Ok _ -> check "compiles and runs" true) );
|
|
( "the generated module keeps generated identifiers distinct",
|
|
fun () ->
|
|
let typed =
|
|
infer
|
|
"input rows : collection int\nlet scale n = n * 2\nlet quad n = scale (scale n)\nquery q = rows |> map (fun r -> quad r + quad r)\n"
|
|
in
|
|
let plan = Simplify.simplify (Graph.build (Anf.program (Specialize.program typed))) in
|
|
let text = Emit.program_to_string plan in
|
|
check "no duplicated let binding in the emitted mapping function"
|
|
(not (Util.starts_with "internal error" text));
|
|
(match run_generated "identifiers" plan "let _ = Query.init []\n" with
|
|
| Error message -> fail "emitted program" message
|
|
| Ok _ -> check "compiles and runs" true) );
|
|
]
|
|
|
|
let update_driver =
|
|
{|
|
|
let rows =
|
|
[ (1, { customer = "Ada"; total = 1500 });
|
|
(2, { customer = "Bo"; total = 900 });
|
|
(3, { customer = "Lin"; total = 2200 }) ]
|
|
|
|
let batches =
|
|
[ [ Query.Insert (4, { customer = "Cy"; total = 4000 }) ];
|
|
[ Query.Replace (1, { customer = "Ada"; total = 100 }) ];
|
|
[ Query.Remove 3 ];
|
|
[ Query.Replace (4, { customer = "Cy"; total = 2000 }); Query.Replace (2, { customer = "Bo"; total = 5000 }) ];
|
|
[ Query.Remove 99 ] ]
|
|
|
|
let () =
|
|
let state = ref (Query.init rows) in
|
|
print_endline (Query.output_to_string (Query.result !state));
|
|
List.iter
|
|
(fun ops ->
|
|
match Query.apply_batch !state ops with
|
|
| Delta_runtime.Failure message -> print_endline ("failure: " ^ message)
|
|
| Delta_runtime.Success (next, _) ->
|
|
state := next;
|
|
print_endline (Query.output_to_string (Query.result !state)))
|
|
batches
|
|
|}
|
|
|
|
let rec show_value value =
|
|
match value with
|
|
| Value.VInt number -> string_of_int number
|
|
| Value.VBool truth -> string_of_bool truth
|
|
| Value.VString text -> Printf.sprintf "%S" text
|
|
| Value.VUnit -> "()"
|
|
| Value.VTuple items -> "(" ^ String.concat ", " (List.map show_value items) ^ ")"
|
|
| Value.VRecord (_, fields) ->
|
|
"{ " ^ String.concat "; " (List.map (fun (label, item) -> label ^ " = " ^ show_value item) fields) ^ " }"
|
|
| Value.VCollection _ -> "collection"
|
|
|
|
let show_output value =
|
|
match value with
|
|
| Value.VCollection map ->
|
|
"[ "
|
|
^ String.concat "; "
|
|
(List.map
|
|
(fun (key, item) -> Printf.sprintf "(%d, %s)" key (show_value item))
|
|
(Delta_runtime.Pure_map.bindings map))
|
|
^ " ]"
|
|
| other -> show_value other
|
|
|
|
let row customer total =
|
|
Value.VRecord ("order", [ ("customer", Value.VString customer); ("total", Value.VInt total) ])
|
|
|
|
let expected_from_reference fixture batches =
|
|
let typed = infer (read_fixture fixture) in
|
|
let entries = [ (1, row "Ada" 1500); (2, row "Bo" 900); (3, row "Lin" 2200) ] in
|
|
let lines = ref [ show_output (Interpret.program typed entries) ] in
|
|
let state = ref (Value.collection_of_list entries) in
|
|
let advance batch =
|
|
match Change.validate_batch ~existing:!state batch with
|
|
| Change.Failure message ->
|
|
lines := !lines @ [ "failure: " ^ message ]
|
|
| Change.Success (temp, _) ->
|
|
state := temp;
|
|
lines := !lines @ [ show_output (Interpret.program typed (Delta_runtime.Pure_map.bindings temp)) ]
|
|
in
|
|
List.iter advance batches;
|
|
!lines
|
|
|
|
let update_cases =
|
|
[
|
|
( "the emitted update functions follow the reference interpreter",
|
|
fun () ->
|
|
let plan = sample_plan "expensive_order.delta" in
|
|
let batches =
|
|
[
|
|
[ Change.OpInsert (4, row "Cy" 4000) ];
|
|
[ Change.OpReplace (1, row "Ada" 100) ];
|
|
[ Change.OpRemove 3 ];
|
|
[ Change.OpReplace (4, row "Cy" 2000); Change.OpReplace (2, row "Bo" 5000) ];
|
|
[ Change.OpRemove 99 ];
|
|
]
|
|
in
|
|
(match run_generated "updates" plan update_driver with
|
|
| Error message -> fail "emitted program" message
|
|
| Ok output ->
|
|
let lines = List.filter (fun line -> line <> "") (String.split_on_char '\n' output) in
|
|
let expected = expected_from_reference "expensive_order.delta" batches in
|
|
check_equal_int "one line per step" (List.length expected) (List.length lines);
|
|
List.iter2
|
|
(fun want got -> if want <> got then fail "step output" (Printf.sprintf "expected %s, got %s" want got))
|
|
expected lines) );
|
|
( "an invalid batch is rejected and the state stays usable",
|
|
fun () ->
|
|
let plan = sample_plan "expensive_order.delta" in
|
|
let driver =
|
|
{|
|
|
let () =
|
|
let rows = [ (1, { customer = "Ada"; total = 1500 }) ] in
|
|
let state = Query.init rows in
|
|
(match Query.apply_batch state [ Query.Insert (1, { customer = "Bo"; total = 10 }) ] with
|
|
| Delta_runtime.Failure message -> print_endline ("failure: " ^ message)
|
|
| Delta_runtime.Success _ -> print_endline "unexpected success");
|
|
(match Query.apply_batch state [ Query.Insert (2, { customer = "Bo"; total = 2000 }) ] with
|
|
| Delta_runtime.Failure message -> print_endline ("failure: " ^ message)
|
|
| Delta_runtime.Success (next, _) -> print_endline (Query.output_to_string (Query.result next)))
|
|
|}
|
|
in
|
|
(match run_generated "invalid_batch" plan driver with
|
|
| Error message -> fail "emitted program" message
|
|
| Ok output ->
|
|
let lines = List.filter (fun line -> line <> "") (String.split_on_char '\n' output) in
|
|
check_equal_string "duplicate insert"
|
|
"failure: cannot insert key 1: it is already present" (List.nth lines 0);
|
|
check_equal_string "state still usable"
|
|
"[ (1, (\"Ada\", 300)); (2, (\"Bo\", 400)) ]" (List.nth lines 1)) );
|
|
( "a runtime error during a batch is reported and leaves the state usable",
|
|
fun () ->
|
|
let typed =
|
|
infer
|
|
"type line = { price : int; quantity : int }\ninput lines : collection line\nquery q = lines |> map (fun l -> l.price / l.quantity) |> sum\n"
|
|
in
|
|
let plan = Simplify.simplify (Graph.build (Anf.program (Specialize.program typed))) in
|
|
let driver =
|
|
{|
|
|
let () =
|
|
let rows = [ (1, { price = 100; quantity = 2 }) ] in
|
|
let state = Query.init rows in
|
|
(match Query.apply_batch state [ Query.Replace (1, { price = 100; quantity = 0 }) ] with
|
|
| Delta_runtime.Failure message -> print_endline ("failure: " ^ message)
|
|
| Delta_runtime.Success _ -> print_endline "unexpected success");
|
|
(match Query.apply_batch state [ Query.Insert (2, { price = 50; quantity = 5 }) ] with
|
|
| Delta_runtime.Failure message -> print_endline ("failure: " ^ message)
|
|
| Delta_runtime.Success (next, _) -> print_endline (Query.output_to_string (Query.result next)))
|
|
|}
|
|
in
|
|
(match run_generated "runtime_error" plan driver with
|
|
| Error message -> fail "emitted program" message
|
|
| Ok output ->
|
|
let lines = List.filter (fun line -> line <> "") (String.split_on_char '\n' output) in
|
|
check_equal_string "division by zero"
|
|
"failure: division by zero while applying the batch" (List.nth lines 0);
|
|
check_equal_string "state still usable" "60" (List.nth lines 1)) );
|
|
( "an integer query reports additive changes",
|
|
fun () ->
|
|
let plan = sample_plan "revenue.delta" in
|
|
let driver =
|
|
{|
|
|
let () =
|
|
let rows = [ (1, { customer = "Ada"; total = 1000 }) ] in
|
|
let state = Query.init rows in
|
|
(match Query.apply_batch state [ Query.Insert (2, { customer = "Bo"; total = 250 }) ] with
|
|
| Delta_runtime.Failure message -> print_endline ("failure: " ^ message)
|
|
| Delta_runtime.Success (next, change) ->
|
|
print_endline (Query.output_to_string (Query.result next));
|
|
print_endline (Query.output_change_to_string change))
|
|
|}
|
|
in
|
|
(match run_generated "int_updates" plan driver with
|
|
| Error message -> fail "emitted program" message
|
|
| Ok output ->
|
|
let lines = List.filter (fun line -> line <> "") (String.split_on_char '\n' output) in
|
|
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 );
|
|
]
|
|
|
|
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);
|
|
]
|