diff options
author | Eduardo Julian | 2019-04-27 01:03:52 -0400 |
---|---|---|
committer | Eduardo Julian | 2019-04-27 01:03:52 -0400 |
commit | ce71205758372cad17e09ac1b4b31dc4cea63528 (patch) | |
tree | ad382efd1ce4c9b93c237dc915d16aada4a1080e /stdlib/source/spec/compositor/analysis/type.lux | |
parent | 5b655f558a0cc78b44736eec8eabeed6216f883f (diff) |
Ported tests for type analysis.
Diffstat (limited to 'stdlib/source/spec/compositor/analysis/type.lux')
-rw-r--r-- | stdlib/source/spec/compositor/analysis/type.lux | 67 |
1 files changed, 67 insertions, 0 deletions
diff --git a/stdlib/source/spec/compositor/analysis/type.lux b/stdlib/source/spec/compositor/analysis/type.lux new file mode 100644 index 000000000..a6105bbde --- /dev/null +++ b/stdlib/source/spec/compositor/analysis/type.lux @@ -0,0 +1,67 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + ["." type ("#@." equivalence)] + [abstract + [monad (#+ do)]] + [control + [pipe (#+ case>)] + ["." io]] + [data + ["." error] + ["." bit ("#@." equivalence)] + ["." text ("#@." equivalence)]] + [math + ["r" random (#+ Random)]] + [macro + ["." code]] + [tool + [compiler + [analysis (#+ State+)] + ["." phase + [macro (#+ Expander)] + ["." analysis + ["#/." scope] + ["#/." type]]]]]]) + +(def: (check-success+ expander state extension params output-type) + (-> Expander State+ Text (List Code) Type Bit) + (|> (analysis/scope.with-scope "" + (analysis/type.with-type output-type + (analysis.phase expander (` ((~ (code.text extension)) (~+ params)))))) + (phase.run state) + (case> (#error.Success _) + true + + (#error.Failure error) + false))) + +(def: check + (Random [Code Type Code]) + (`` ($_ r.either + (~~ (template [<random> <type> <code>] + [(do r.monad + [value <random>] + (wrap [(` <type>) + <type> + (<code> value)]))] + + [r.bit (0 "#Bit" (0)) code.bit] + [r.nat (0 "#I64" (1 (0 "#Nat" (0)) (0))) code.nat] + [r.int (0 "#I64" (1 (0 "#Int" (0)) (0))) code.int] + [r.rev (0 "#I64" (1 (0 "#Rev" (0)) (0))) code.rev] + [r.safe-frac (0 "#Frac" (0)) code.frac] + [(r.ascii/upper-alpha 5) (0 "#Text" (0)) code.text] + ))))) + +(def: #export (spec expander state) + (-> Expander State+ Test) + (do r.monad + [[typeC exprT exprC] ..check + [other-typeC other-exprT other-exprC] ..check] + ($_ _.and + (_.test "lux check" + (check-success+ expander state "lux check" (list typeC exprC) exprT)) + (_.test "lux coerce" + (check-success+ expander state "lux coerce" (list typeC other-exprC) exprT)) + ))) |