diff options
author | Eduardo Julian | 2022-08-31 04:38:04 -0400 |
---|---|---|
committer | Eduardo Julian | 2022-08-31 04:38:04 -0400 |
commit | 3b571c140a3bee7ec715df9f9cf37645883b9397 (patch) | |
tree | 7efe87e6b9abca610bdd1a80defea250adc632d1 /stdlib/source/test | |
parent | d0e4ba8124345ce990de7fdf7497dd903de6c342 (diff) |
Added support for row polymorphism.
Diffstat (limited to 'stdlib/source/test')
-rw-r--r-- | stdlib/source/test/lux/meta/type.lux | 4 | ||||
-rw-r--r-- | stdlib/source/test/lux/meta/type/row.lux | 146 | ||||
-rw-r--r-- | stdlib/source/test/lux/test.lux | 2 | ||||
-rw-r--r-- | stdlib/source/test/lux/test/property.lux | 2 | ||||
-rw-r--r-- | stdlib/source/test/lux/test/tally.lux | 72 |
5 files changed, 224 insertions, 2 deletions
diff --git a/stdlib/source/test/lux/meta/type.lux b/stdlib/source/test/lux/meta/type.lux index 67119dd60..e4c8ad2ea 100644 --- a/stdlib/source/test/lux/meta/type.lux +++ b/stdlib/source/test/lux/meta/type.lux @@ -42,7 +42,8 @@ ["[1][0]" resource] ["[1][0]" unit] ["[1][0]" variance] - ["[1][0]" poly]]) + ["[1][0]" poly] + ["[1][0]" row]]) (def !expect (template (_ <pattern> <value>) @@ -572,4 +573,5 @@ /unit.test /variance.test /poly.test + /row.test ))) diff --git a/stdlib/source/test/lux/meta/type/row.lux b/stdlib/source/test/lux/meta/type/row.lux new file mode 100644 index 000000000..49988cc33 --- /dev/null +++ b/stdlib/source/test/lux/meta/type/row.lux @@ -0,0 +1,146 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)]] + [control + ["[0]" try] + ["[0]" exception]] + [data + ["[0]" text]] + [math + ["[0]" random (.only Random)] + [number + ["n" nat]]] + [meta + ["[0]" code (.only) + ["<[1]>" \\parser]] + [macro + [syntax (.only syntax)] + ["[0]" expansion] + ["[0]" template]]] + [test + ["_" property (.only Test)]] + [world + [time + ["[0]" instant (.only Instant)] + ["[0]" duration (.only Duration)]]]]] + [\\library + ["[0]" /]]) + +(/.type .public Mortal + [@birth Instant + @life_span (Maybe Duration)]) + +(/.type Human + Mortal + [@name Text]) + +(/.type (TransHuman id) + Human + [@id id]) + +(def macro_error + (syntax (_ [macro <code>.any]) + (function (_ compiler) + (when ((expansion.complete macro) compiler) + {try.#Failure error} + {try.#Success [compiler (list (code.text error))]} + + {try.#Success _} + {try.#Failure "OOPS!"})))) + +(template.with_locals [<slot>] + (def repeat_slot_error + (macro_error + (/.type Bad_Row + [<slot> Bit + <slot> Nat])))) + +(def .public test + Test + (<| (_.covering /._) + (_.for [/.Row]) + (do [! random.monad] + [dummy_birth random.instant + expected_birth (random.only (|>> (same? dummy_birth) not) + random.instant) + expected_life_span (random.maybe random.duration) + + dummy_name (random.upper_case 1) + expected_name (random.upper_case 2) + + dummy_id random.nat + expected_id (random.only (|>> (n.= dummy_id) not) random.nat)]) + (all _.and + (_.coverage [/.type /.row] + (exec + (is Mortal + (/.row [@birth expected_birth + @life_span expected_life_span])) + (is Human + (/.row [@name expected_name + @birth expected_birth + @life_span expected_life_span])) + (is (TransHuman Nat) + (/.row [@id expected_id + @name expected_name + @birth expected_birth + @life_span expected_life_span])) + true)) + (_.coverage [/.cannot_repeat_slot_names] + (text.contains? (the exception.#label /.cannot_repeat_slot_names) + repeat_slot_error)) + (_.coverage [/.missing_level] + (and (|> (/.row [@name expected_name]) + macro_error + (text.contains? (the exception.#label /.missing_level))) + (|> (/.row [@id expected_id]) + macro_error + (text.contains? (the exception.#label /.missing_level))) + (|> (/.row [@id expected_id + @name expected_name]) + macro_error + (text.contains? (the exception.#label /.missing_level))) + (|> (/.row [@id expected_id + @birth expected_birth + @life_span expected_life_span]) + macro_error + (text.contains? (the exception.#label /.missing_level))))) + (_.for [/.Slot /.slot] + (all _.and + (_.coverage [/.the] + (and (|> (/.row [@birth expected_birth + @life_span expected_life_span]) + (is Mortal) + (/.the @birth) + (same? expected_birth)) + (|> (/.row [@name expected_name + @birth expected_birth + @life_span expected_life_span]) + (is Human) + (/.the @name) + (same? expected_name)) + (|> (/.row [@id expected_id + @name expected_name + @birth expected_birth + @life_span expected_life_span]) + (is (TransHuman Nat)) + (/.the @id) + (same? expected_id)))) + (_.coverage [/.has] + (|> (/.row [@birth dummy_birth + @life_span expected_life_span]) + (is Mortal) + (/.has @birth expected_birth) + (/.the @birth) + (same? expected_birth))) + (_.coverage [/.revised] + (|> (/.row [@birth dummy_birth + @life_span expected_life_span]) + (is Mortal) + (/.revised @birth (function (_ _) expected_birth)) + (/.the @birth) + (same? expected_birth))) + )) + ))) diff --git a/stdlib/source/test/lux/test.lux b/stdlib/source/test/lux/test.lux index 2ba71ac51..6400db17f 100644 --- a/stdlib/source/test/lux/test.lux +++ b/stdlib/source/test/lux/test.lux @@ -5,11 +5,13 @@ ["_" property (.only Test)]]]] ["[0]" / ["[1][0]" coverage] + ["[1][0]" tally] ["[1][0]" property]]) (def .public test Test (all _.and /coverage.test + /tally.test /property.test )) diff --git a/stdlib/source/test/lux/test/property.lux b/stdlib/source/test/lux/test/property.lux index 67dd9c7e1..8a1fa2f0d 100644 --- a/stdlib/source/test/lux/test/property.lux +++ b/stdlib/source/test/lux/test/property.lux @@ -42,7 +42,7 @@ (in (do async.monad [[success_tally success_message] (unit.test expected_message/0 true) [failure_tally failure_message] (unit.test expected_message/0 false)] - (unit.coverage [unit.test tally.Tally] + (unit.coverage [unit.test] (and (text.ends_with? (%.text expected_message/0) success_message) (text.ends_with? (%.text expected_message/0) failure_message) (and (n.= 1 (the tally.#successes success_tally)) diff --git a/stdlib/source/test/lux/test/tally.lux b/stdlib/source/test/lux/test/tally.lux new file mode 100644 index 000000000..c1d43ad79 --- /dev/null +++ b/stdlib/source/test/lux/test/tally.lux @@ -0,0 +1,72 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)]] + [data + [collection + ["[0]" set (.use "[1]#[0]" equivalence)]]] + [math + ["[0]" random] + [number + ["n" nat]]] + [meta + ["[0]" symbol]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" /]] + [/// + [meta + ["[0]T" symbol]]]) + +(def .public test + Test + (<| (_.covering /._) + (_.for [/.Tally]) + (do [! random.monad] + [left (symbolT.random 1 1) + right (symbolT.random 2 2) + expected_successes random.nat + expected_failures random.nat]) + (all _.and + (_.coverage [/.empty] + (and (n.= 0 (the /.#successes /.empty)) + (n.= 0 (the /.#failures /.empty)) + (n.= 0 (set.size (the /.#expected /.empty))) + (n.= 0 (set.size (the /.#actual /.empty))))) + (_.coverage [/.success] + (and (n.= 1 (the /.#successes /.success)) + (n.= 0 (the /.#failures /.success)) + (n.= 0 (set.size (the /.#expected /.success))) + (n.= 0 (set.size (the /.#actual /.success))))) + (_.coverage [/.failure] + (and (n.= 0 (the /.#successes /.failure)) + (n.= 1 (the /.#failures /.failure)) + (n.= 0 (set.size (the /.#expected /.failure))) + (n.= 0 (set.size (the /.#actual /.failure))))) + (_.coverage [/.and] + (and (let [it (/.and /.success /.success)] + (and (n.= 2 (the /.#successes it)) + (n.= 0 (the /.#failures it)))) + (let [it (/.and /.failure /.failure)] + (and (n.= 0 (the /.#successes it)) + (n.= 2 (the /.#failures it)))) + (let [it (/.and /.success /.failure)] + (and (n.= 1 (the /.#successes it)) + (n.= 1 (the /.#failures it)))) + (let [custom [/.#successes expected_successes + /.#failures expected_failures + /.#expected (set.of_list symbol.hash (list left)) + /.#actual (set.of_list symbol.hash (list right))]] + (and (let [it (/.and /.success custom)] + (and (n.= (++ expected_successes) (the /.#successes it)) + (n.= expected_failures (the /.#failures it)) + (set#= (the /.#expected custom) (the /.#expected it)) + (set#= (the /.#actual custom) (the /.#actual it)))) + (let [it (/.and custom /.failure)] + (and (n.= expected_successes (the /.#successes it)) + (n.= (++ expected_failures) (the /.#failures it)) + (set#= (the /.#expected custom) (the /.#expected it)) + (set#= (the /.#actual custom) (the /.#actual it)))))))) + ))) |