Files
delta/test/test_codegen.ml
T

315 lines
13 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.program_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)) );
]