open Test_harness let infer_program text = infer text let cases = [ ( "the example query infers a collection of tuples of string and int", fun () -> let program = infer_program (read_fixture "expensive_order.delta") in check_equal_string "query type" "collection (string, int)" (Types.pp program.Typed.tp_query_body.Typed.ty); check_equal_string "input element" "order" (Types.pp program.Typed.tp_input_element) ); ( "the example helper infers an integer arrow", fun () -> let program = infer_program (read_fixture "expensive_order.delta") in check_equal_string "helper type" "(int -> int)" (Types.pp (List.hd program.Typed.tp_helpers).Typed.th_scheme.Types.body) ); ( "revenue infers an integer query", fun () -> let program = infer_program (read_fixture "revenue.delta") in check_equal_string "query type" "int" (Types.pp program.Typed.tp_query_body.Typed.ty) ); ( "count_large infers an integer query", fun () -> let program = infer_program (read_fixture "count_large.delta") in check_equal_string "query type" "int" (Types.pp program.Typed.tp_query_body.Typed.ty) ); ( "a helper generalizes at its let binding", fun () -> let program = infer_program "type order = { customer : string; total : int }\ninput orders : collection order\nlet pair a b = (a, b)\nquery q = orders |> map (fun o -> pair o.total o.customer)\n" in let scheme = (List.hd program.Typed.tp_helpers).Typed.th_scheme in check_equal_int "two generalized variables" 2 (List.length scheme.Types.vars); check "the helper is a two argument function" (match Types.repr scheme.Types.body with | Types.TArrow (_, Types.TArrow _) -> true | _ -> false); check_equal_string "query type" "collection (int, string)" (Types.pp program.Typed.tp_query_body.Typed.ty) ); ( "a polymorphic helper is instantiated independently at each use", fun () -> let program = infer_program "type order = { customer : string; total : int }\ninput orders : collection order\nlet identity x = x\nlet tax n = identity n * 20 / 100\nquery q = orders |> map (fun o -> (identity o.customer, tax o.total))\n" in check_equal_string "query type" "collection (string, int)" (Types.pp program.Typed.tp_query_body.Typed.ty) ); ( "the occurs check rejects self application", fun () -> match infer_error "input rows : collection int\nlet f x = x x\nquery q = rows\n" with | None -> fail "occurs" "expected a diagnostic" | Some diagnostic -> check "message mentions an infinite type" (Util.starts_with "cannot construct the infinite type" diagnostic.Diagnostic.message) ); ( "an unannotated arithmetic helper that is applied to a string is rejected", fun () -> check_message "arithmetic" "type mismatch: expected int but got string" (fun () -> infer_program "input rows : collection int\nlet f n = n + 1\nquery q = rows |> map (fun r -> f \"a\")\n") ); ( "projection on a non record is rejected", fun () -> check_message "projection" "type mismatch: expected order but got int" (fun () -> infer_program "type order = { total : int }\ninput rows : collection int\nquery q = rows |> map (fun r -> r.total)\n") ); ( "unknown record fields are rejected", fun () -> check_message "unknown field" "no record type declares a field named `tota`" (fun () -> infer_program "type order = { total : int }\ninput rows : collection order\nquery q = rows |> map (fun r -> r.tota)\n") ); ( "record literals must provide every field", fun () -> check_message "missing field" "record literal of type `order` is missing field `customer`" (fun () -> infer_program "type order = { customer : string; total : int }\ninput rows : collection order\nquery q = rows |> map (fun r -> { total = r.total })\n") ); ( "record literals reject fields of another record", fun () -> check_message "mixed fields" "record `order` has no field named `other`" (fun () -> infer_program "type order = { total : int }\ninput rows : collection order\nquery q = rows |> map (fun r -> { total = r.total; other = 1 })\n") ); ( "a record field with a collection type is rejected", fun () -> check_message "collection field" "record field `items` has a collection type; collections may not be stored in records" (fun () -> infer_program "type box = { items : collection int }\ninput rows : collection box\nquery q = rows\n") ); ( "nested collection types are rejected", fun () -> check_message "collection type position" "collection types are only allowed as the input type and as query results" (fun () -> infer_program "input rows : collection (collection int)\nquery q = rows\n") ); ( "the input must be declared with a collection type", fun () -> check_message "input type" "the input collection must be declared with a collection type: input NAME : collection T" (fun () -> infer_program "input rows : int\nquery q = 1\n") ); ( "sum rejects a non integer collection", fun () -> check_message "sum" "sum expects a collection of integers but got collection string" (fun () -> infer_program "type order = { customer : string }\ninput rows : collection order\nquery q = rows |> map (fun r -> r.customer) |> sum\n") ); ( "sum rejects a scalar operand", fun () -> check_message "sum scalar" "sum expects a collection of integers but got int" (fun () -> infer_program "input rows : collection int\nquery q = sum 1\n") ); ( "filter must be applied to a collection", fun () -> check_message "filter arity" "`filter` and `map` must be applied to a collection" (fun () -> infer_program "input rows : collection int\nquery q = filter (fun x -> true)\n") ); ( "map cannot produce a collection", fun () -> check_message "nested collection" "nested collections are not supported: mapped element" (fun () -> infer_program "input rows : collection int\nquery q = rows |> map (fun r -> rows)\n") ); ( "count rejects a scalar operand", fun () -> check_message "count scalar" "count expects a collection but got int" (fun () -> infer_program "input rows : collection int\nquery q = count 1\n") ); ( "a query must produce a collection or an integer", fun () -> check_message "query result" "a query must produce a collection or an integer, but this query produces string" (fun () -> infer_program "input rows : collection int\nquery q = \"hello\"\n") ); ( "equality is rejected on functions", fun () -> check_message "function equality" "`=` is only supported on integers, booleans, strings, unit, tuples and records of these, but the operands have type (int -> int)" (fun () -> infer_program "input rows : collection int\nlet bad = (fun x -> x + 1) = (fun x -> x + 1)\nquery q = rows\n" ) ); ( "conditional branches must have the same type", fun () -> check_message "branch mismatch" "type mismatch: expected int but got string" (fun () -> infer_program "input rows : collection int\nquery q = if true then 1 else \"x\"\n") ); ( "unknown type names are rejected", fun () -> check_message "unknown type" "unknown type `order`" (fun () -> infer_program "input rows : collection order\nquery q = rows\n") ); ( "negation is integer only", fun () -> check_message "negation" "type mismatch: expected bool but got int" (fun () -> infer_program "input rows : collection int\nquery q = -true\n") ); ( "a constant integer query is accepted", fun () -> let program = infer_program "input rows : collection int\nquery q = 40 + 2\n" in check_equal_string "query type" "int" (Types.pp program.Typed.tp_query_body.Typed.ty) ); ( "the typed dump is deterministic", fun () -> Types.reset (); Ident.reset (); let first = Typed.program_to_string (infer_program (read_fixture "expensive_order.delta")) in Types.reset (); Ident.reset (); let second = Typed.program_to_string (infer_program (read_fixture "expensive_order.delta")) in check_equal_string "identical dumps" first second ); ]