diff options
Diffstat (limited to 'stdlib/source/test')
4 files changed, 657 insertions, 1 deletions
diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux index 7fc1c428d..29c34b430 100644 --- a/stdlib/source/test/lux/control.lux +++ b/stdlib/source/test/lux/control.lux @@ -21,6 +21,7 @@ ["#." io] ["#." parser ["#/." analysis] + ["#/." binary] ["#/." text] ["#/." cli]] ["#." pipe] @@ -59,6 +60,7 @@ ($_ _.and /parser.test /parser/analysis.test + /parser/binary.test /parser/text.test /parser/cli.test )) diff --git a/stdlib/source/test/lux/control/parser/binary.lux b/stdlib/source/test/lux/control/parser/binary.lux new file mode 100644 index 000000000..d646852f3 --- /dev/null +++ b/stdlib/source/test/lux/control/parser/binary.lux @@ -0,0 +1,359 @@ +(.module: + [lux (#- primitive) + ["_" test (#+ Test)] + [abstract + [equivalence (#+ Equivalence)] + [monad (#+ do)]] + [control + ["." try] + ["." exception] + ["<>" parser]] + [data + ["." binary] + ["." sum] + ["." maybe] + ["." bit] + ["." name] + ["." text ("#@." equivalence) + ["." encoding]] + ["." format #_ + ["#" binary]] + [number + ["." i64] + ["n" nat] + ["." int] + ["." rev] + ["." frac]] + [collection + ["." list] + ["." row] + ["." set]]] + [macro + ["." code]] + ["." type] + [math + ["." random (#+ Random)]]] + {1 + ["." /]}) + +(template: (!expect <expectation> <computation>) + (case <computation> + <expectation> + true + + _ + false)) + +(def: segment-size 10) + +(def: random-name + (Random Name) + (random.and (random.unicode ..segment-size) + (random.unicode ..segment-size))) + +(structure: cursor-equivalence + (Equivalence Cursor) + + (def: (= [expected-module expected-line expected-column] + [sample-module sample-line sample-column]) + (and (text@= expected-module sample-module) + (n.= expected-line sample-line) + (n.= expected-column sample-column)))) + +(def: random-cursor + (Random Cursor) + ($_ random.and + (random.unicode ..segment-size) + random.nat + random.nat)) + +(def: random-code + (Random Code) + (random.rec + (function (_ recur) + (let [random-sequence (do {@ random.monad} + [size (:: @ map (n.% 2) random.nat)] + (random.list size recur))] + ($_ random.and + ..random-cursor + (: (Random (Code' (Ann Cursor))) + ($_ random.or + random.bit + random.nat + random.int + random.rev + random.frac + (random.unicode ..segment-size) + ..random-name + ..random-name + random-sequence + random-sequence + (do {@ random.monad} + [size (:: @ map (n.% 2) random.nat)] + (random.list size (random.and recur recur))) + ))))))) + +(def: random-type + (Random Type) + (let [(^open ".") random.monad] + ($_ random.either + (wrap .Nat) + (wrap .List) + (wrap .Code) + (wrap .Type)))) + +(def: size + Test + (<| (_.with-cover [/.Size]) + (`` ($_ _.and + (~~ (template [<size> <parser> <format>] + [(do {@ random.monad} + [expected (:: @ map (i64.and (i64.mask <size>)) + random.nat)] + (_.cover [<size> <parser>] + (|> (format.run <format> expected) + (/.run <parser>) + (!expect (^multi (#try.Success actual) + (n.= (.nat expected) + (.nat actual)))))))] + + [/.size/8 /.bits/8 format.bits/8] + [/.size/16 /.bits/16 format.bits/16] + [/.size/32 /.bits/32 format.bits/32] + [/.size/64 /.bits/64 format.bits/64] + )))))) + +(def: binary + Test + (`` ($_ _.and + (~~ (template [<parser> <format>] + [(do {@ random.monad} + [expected (:: @ map encoding.to-utf8 (random.ascii ..segment-size))] + (_.cover [<parser>] + (|> (format.run <format> expected) + (/.run <parser>) + (!expect (^multi (#try.Success actual) + (:: binary.equivalence = expected actual))))))] + + [/.binary/8 format.binary/8] + [/.binary/16 format.binary/16] + [/.binary/32 format.binary/32] + [/.binary/64 format.binary/64] + ))))) + +(def: utf8 + Test + (`` ($_ _.and + (~~ (template [<parser> <format>] + [(do {@ random.monad} + [expected (random.ascii ..segment-size)] + (_.cover [<parser>] + (|> (format.run <format> expected) + (/.run <parser>) + (!expect (^multi (#try.Success actual) + (:: text.equivalence = expected actual))))))] + + [/.utf8/8 format.utf8/8] + [/.utf8/16 format.utf8/16] + [/.utf8/32 format.utf8/32] + [/.utf8/64 format.utf8/64] + [/.text format.utf8/64] + ))))) + +(def: row + Test + (`` ($_ _.and + (~~ (template [<parser> <format>] + [(do {@ random.monad} + [expected (random.row ..segment-size random.nat)] + (_.cover [<parser>] + (|> expected + (format.run (<format> format.nat)) + (/.run (<parser> /.nat)) + (!expect (^multi (#try.Success actual) + (:: (row.equivalence n.equivalence) = expected actual))))))] + + [/.row/8 format.row/8] + [/.row/16 format.row/16] + [/.row/32 format.row/32] + [/.row/64 format.row/64] + ))))) + +(def: simple + Test + (`` ($_ _.and + (~~ (template [<parser> <format> <random> <equivalence>] + [(do {@ random.monad} + [expected <random>] + (_.cover [<parser>] + (|> (format.run <format> expected) + (/.run <parser>) + (!expect (^multi (#try.Success actual) + (:: <equivalence> = expected actual))))))] + + [/.bit format.bit random.bit bit.equivalence] + [/.nat format.nat random.nat n.equivalence] + [/.int format.int random.int int.equivalence] + [/.rev format.rev random.rev rev.equivalence] + [/.frac format.frac random.frac frac.equivalence] + )) + (do {@ random.monad} + [expected (:: @ map (|>> (i64.and (i64.mask /.size/8)) + (n.max 2)) + random.nat)] + (_.cover [/.not-a-bit] + (|> expected + (format.run format.bits/8) + (/.run /.bit) + (!expect (^multi (#try.Failure error) + (exception.match? /.not-a-bit error)))))) + ))) + +(def: complex + Test + (`` ($_ _.and + (~~ (template [<parser> <format> <random> <equivalence>] + [(do {@ random.monad} + [expected <random>] + (_.cover [<parser>] + (|> (format.run <format> expected) + (/.run <parser>) + (!expect (^multi (#try.Success actual) + (:: <equivalence> = expected actual))))))] + + [/.cursor format.cursor random-cursor cursor-equivalence] + [/.code format.code random-code code.equivalence] + [/.type format.type random-type type.equivalence] + )) + (~~ (template [<cover> <parser> <format> <random> <equivalence>] + [(do {@ random.monad} + [expected <random>] + (_.cover [<cover>] + (|> (format.run <format> expected) + (/.run <parser>) + (!expect (^multi (#try.Success actual) + (:: <equivalence> = expected actual))))))] + + [/.maybe (/.maybe /.nat) (format.maybe format.nat) (random.maybe random.nat) (maybe.equivalence n.equivalence)] + [/.list (/.list /.nat) (format.list format.nat) (random.list ..segment-size random.nat) (list.equivalence n.equivalence)] + [/.set (/.set n.hash /.nat) (format.set format.nat) (random.set n.hash ..segment-size random.nat) set.equivalence] + [/.name /.name format.name ..random-name name.equivalence] + )) + (do {@ random.monad} + [expected (:: @ map (list.repeat ..segment-size) random.nat)] + (_.cover [/.set-elements-are-not-unique] + (|> expected + (format.run (format.list format.nat)) + (/.run (/.set n.hash /.nat)) + (!expect (^multi (#try.Failure error) + (exception.match? /.set-elements-are-not-unique error)))))) + (do {@ random.monad} + [expected (random.or random.bit random.nat)] + (_.cover [/.or] + (|> expected + (format.run (format.or format.bit format.nat)) + (/.run (: (/.Parser (Either Bit Nat)) + (/.or /.bit /.nat))) + (!expect (^multi (#try.Success actual) + (:: (sum.equivalence bit.equivalence n.equivalence) = + expected + actual)))))) + (do {@ random.monad} + [tag (:: @ map (|>> (i64.and (i64.mask /.size/8)) + (n.max 2)) + random.nat) + value random.bit] + (_.cover [/.invalid-tag] + (|> [tag value] + (format.run (format.and format.bits/8 format.bit)) + (/.run (: (/.Parser (Either Bit Nat)) + (/.or /.bit /.nat))) + (!expect (^multi (#try.Failure error) + (exception.match? /.invalid-tag error)))))) + (do {@ random.monad} + [expected (random.list ..segment-size random.nat)] + (_.cover [/.rec] + (|> expected + (format.run (format.list format.nat)) + (/.run (: (/.Parser (List Nat)) + (/.rec + (function (_ recur) + (/.or /.any + (<>.and /.nat + recur)))))) + (!expect (^multi (#try.Success actual) + (:: (list.equivalence n.equivalence) = + expected + actual)))))) + ))) + +(def: #export test + Test + (<| (_.covering /._) + (_.with-cover [/.Parser]) + (`` ($_ _.and + (_.cover [/.run /.any] + (|> (binary.create 0) + (/.run /.any) + (!expect (#try.Success _)))) + (do {@ random.monad} + [data (:: @ map encoding.to-utf8 (random.ascii ..segment-size))] + (_.cover [/.binary-was-not-fully-read] + (|> data + (/.run /.any) + (!expect (^multi (#try.Failure error) + (exception.match? /.binary-was-not-fully-read error)))))) + (do {@ random.monad} + [expected (:: @ map encoding.to-utf8 (random.ascii ..segment-size))] + (_.cover [/.segment] + (|> expected + (/.run (/.segment ..segment-size)) + (!expect (^multi (#try.Success actual) + (:: binary.equivalence = expected actual)))))) + (do {@ random.monad} + [data (:: @ map encoding.to-utf8 (random.ascii ..segment-size))] + (_.cover [/.end?] + (|> data + (/.run (do <>.monad + [pre /.end? + _ (/.segment ..segment-size) + post /.end?] + (wrap (and (not pre) + post)))) + (!expect (#try.Success #1))))) + (do {@ random.monad} + [to-read (:: @ map (n.% (inc ..segment-size)) random.nat) + data (:: @ map encoding.to-utf8 (random.ascii ..segment-size))] + (_.cover [/.Offset /.offset] + (|> data + (/.run (do <>.monad + [start /.offset + _ (/.segment to-read) + offset /.offset + _ (/.segment (n.- to-read ..segment-size)) + nothing-left /.offset] + (wrap (and (n.= 0 start) + (n.= to-read offset) + (n.= ..segment-size nothing-left))))) + (!expect (#try.Success #1))))) + (do {@ random.monad} + [to-read (:: @ map (n.% (inc ..segment-size)) random.nat) + data (:: @ map encoding.to-utf8 (random.ascii ..segment-size))] + (_.cover [/.remaining] + (|> data + (/.run (do <>.monad + [_ (/.segment to-read) + remaining /.remaining + _ (/.segment (n.- to-read ..segment-size)) + nothing-left /.remaining] + (wrap (and (n.= ..segment-size + (n.+ to-read remaining)) + (n.= 0 nothing-left))))) + (!expect (#try.Success #1))))) + ..size + ..binary + ..utf8 + ..row + ..simple + ..complex + )))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis.lux index da9937862..46291b311 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis.lux @@ -5,7 +5,8 @@ ["#." primitive] ["#." structure] ["#." case] - ["#." function]]) + ["#." function] + ["#." loop]]) (def: #export test Test @@ -14,4 +15,5 @@ /structure.test /case.test /function.test + /loop.test )) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/loop.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/loop.lux new file mode 100644 index 000000000..adb98ba3a --- /dev/null +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/synthesis/loop.lux @@ -0,0 +1,293 @@ +(.module: + [lux (#- primitive structure loop function) + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [control + ["." try] + ["." exception]] + [data + [number + ["n" nat]] + [collection + ["." list ("#@." functor)]]] + [math + ["." random (#+ Random) ("#@." monad)]]] + {1 + ["." / + [//// + ["." analysis (#+ Environment)] + ["/#" synthesis (#+ Member Path Synthesis)] + [/// + [arity (#+ Arity)] + ["." reference (#+ Constant) + ["." variable (#+ Register Variable)]]]]]}) + +(type: (Scenario a) + (-> Register Arity Register (Random [Register [a a]]))) + +(def: (primitive offset arity next) + (Scenario Synthesis) + (`` ($_ random.either + (~~ (template [<synthesis> <random>] + [(do {@ random.monad} + [example (:: @ map (|>> <synthesis>) <random>)] + (wrap [next + [example + example]]))] + + [//.bit random.bit] + [//.i64 (:: @ map .i64 random.nat)] + [//.f64 random.frac] + [//.text (random.unicode 1)] + )) + ))) + +(def: (constant offset arity next) + (Scenario Constant) + (do random.monad + [name (random.and (random.unicode 1) + (random.unicode 1))] + (wrap [next + [name + name]]))) + +(def: (variable offset arity next) + (Scenario Variable) + (let [local (do {@ random.monad} + [register (:: @ map (|>> (n.% arity) inc) random.nat)] + (wrap [next + [(#variable.Local (/.register-optimization offset register)) + (#variable.Local register)]]))] + (case offset + 0 local + _ ($_ random.either + local + (do {@ random.monad} + [foreign (:: @ map (n.% offset) random.nat)] + (wrap [next + [(#variable.Local foreign) + (#variable.Foreign foreign)]])))))) + +(def: (reference offset arity next) + (Scenario Synthesis) + (`` ($_ random.either + (~~ (template [<tag> <random>] + [(do {@ random.monad} + [[next [exampleE exampleA]] (<random> offset arity next)] + (wrap [next + [(<tag> exampleE) + (<tag> exampleA)]]))] + + [//.constant ..constant] + [//.variable ..variable] + ))))) + +(def: (structure offset arity next) + (Scenario Synthesis) + ($_ random.either + (do {@ random.monad} + [lefts random.nat + right? random.bit + [next [valueE valueA]] (..reference offset arity next)] + (wrap [next + [(//.variant + {#analysis.lefts lefts + #analysis.right? right? + #analysis.value valueE}) + (//.variant + {#analysis.lefts lefts + #analysis.right? right? + #analysis.value valueA})]])) + (do {@ random.monad} + [[next [leftE leftA]] (..reference offset arity next) + [next [rightE rightA]] (..reference offset arity next)] + (wrap [next + [(//.tuple (list leftE rightE)) + (//.tuple (list leftA rightA))]])) + )) + +(def: path + (Scenario Path) + (let [pattern (: (Scenario Path) + (.function (recur offset arity next) + (`` ($_ random.either + (random@wrap [next + [//.path/pop + //.path/pop]]) + (~~ (template [<path> <random>] + [(do {@ random.monad} + [example (:: @ map (|>> <path>) <random>)] + (wrap [next + [example + example]]))] + + [//.path/bit random.bit] + [//.path/i64 (:: @ map .i64 random.nat)] + [//.path/f64 random.frac] + [//.path/text (random.unicode 1)] + )) + (~~ (template [<path>] + [(do {@ random.monad} + [example (:: @ map (|>> <path>) + (random.or random.nat + random.nat))] + (wrap [next + [example + example]]))] + + [//.path/side] + [//.path/member] + )) + (random@wrap [(inc next) + [(//.path/bind (/.register-optimization offset next)) + (//.path/bind next)]]) + )))) + sequential (: (Scenario Path) + (.function (recur offset arity next) + (do random.monad + [[next [patternE patternA]] (pattern offset arity next) + [next [bodyE bodyA]] (..reference offset arity next)] + (wrap [next + [(//.path/seq patternE (//.path/then bodyE)) + (//.path/seq patternA (//.path/then bodyA))]]))))] + (.function (recur offset arity next) + (do random.monad + [[next [leftE leftA]] (sequential offset arity next) + [next [rightE rightA]] (sequential offset arity next)] + (wrap [next + [(//.path/alt leftE rightE) + (//.path/alt leftA rightA)]]))))) + +(def: (branch offset arity next) + (Scenario Synthesis) + (let [random-member (: (Random Member) + (random.or random.nat + random.nat))] + ($_ random.either + ($_ random.either + (do {@ random.monad} + [[next [inputE inputA]] (..reference offset arity next) + [next [bodyE bodyA]] (..reference offset arity next)] + (wrap [next + [(//.branch/let [inputE (/.register-optimization offset next) bodyE]) + (//.branch/let [inputA next bodyA])]])) + (do {@ random.monad} + [[next [testE testA]] (..reference offset arity next) + [next [thenE thenA]] (..reference offset arity next) + [next [elseE elseA]] (..reference offset arity next)] + (wrap [next + [(//.branch/if [testE thenE elseE]) + (//.branch/if [testA thenA elseA])]]))) + ($_ random.either + (do {@ random.monad} + [[next [recordE recordA]] (..reference offset arity next) + path-length (:: @ map (|>> (n.% 5) inc) random.nat) + path (random.list path-length random-member)] + (wrap [next + [(//.branch/get [path recordE]) + (//.branch/get [path recordA])]])) + (do {@ random.monad} + [[next [inputE inputA]] (..reference offset arity next) + [next [pathE pathA]] (..path offset arity next)] + (wrap [next + [(//.branch/case [inputE pathE]) + (//.branch/case [inputA pathA])]]))) + ))) + +(def: (loop offset arity next) + (Scenario Synthesis) + ($_ random.either + (do random.monad + [[next [firstE firstA]] (..reference offset arity next) + [next [secondE secondA]] (..reference offset arity next) + [next [iterationE iterationA]] (..reference offset arity next)] + (wrap [next + [(//.loop/scope + {#//.start (/.register-optimization offset next) + #//.inits (list firstE secondE) + #//.iteration iterationE}) + (//.loop/scope + {#//.start next + #//.inits (list firstA secondA) + #//.iteration iterationA})]])) + )) + +(def: (function offset arity next) + (Scenario Synthesis) + ($_ random.either + (do {@ random.monad} + [[next [firstE firstA]] (..variable offset arity next) + [next [secondE secondA]] (..variable offset arity next) + arity (:: @ map (n.max 1) random.nat) + [next [bodyE bodyA]] (..primitive 0 arity next)] + (wrap [next + [(//.function/abstraction + {#//.environment (list firstE secondE) + #//.arity arity + #//.body bodyE}) + (//.function/abstraction + {#//.environment (list firstA secondA) + #//.arity arity + #//.body bodyA})]])) + )) + +(def: (control offset arity next) + (Scenario Synthesis) + ($_ random.either + (..branch offset arity next) + (..loop offset arity next) + (..function offset arity next) + )) + +(def: (extension offset arity next) + (Scenario Synthesis) + (do random.monad + [name (random.unicode 10) + [next [firstE firstA]] (..reference offset arity next) + [next [secondE secondA]] (..reference offset arity next) + [next [thirdE thirdA]] (..reference offset arity next)] + (wrap [next + [(#//.Extension name (list firstE secondE thirdE)) + (#//.Extension name (list firstA secondA thirdA))]]))) + +(def: (scenario offset arity next) + (Scenario Synthesis) + ($_ random.either + (..primitive offset arity next) + (..structure offset arity next) + (..reference offset arity next) + (..control offset arity next) + (..extension offset arity next) + )) + +(def: #export test + Test + (<| (_.covering /._) + ($_ _.and + (do {@ random.monad} + [expected-offset (:: @ map (|>> (n.% 5) (n.+ 2)) random.nat) + arity (:: @ map (|>> (n.% 5) inc) random.nat) + expected-inits (|> random.nat + (:: @ map (|>> .i64 //.i64)) + (random.list arity)) + [_ [expected iteration]] (..scenario expected-offset arity 0)] + (_.cover [/.Transform /.optimization /.register-optimization] + (case (/.optimization expected-offset expected-inits + {#//.environment (|> expected-offset + list.indices + (list@map (|>> #variable.Local))) + #//.arity arity + #//.body iteration}) + (^ (#.Some (//.loop/scope [actual-offset actual-inits + actual]))) + (and (n.= expected-offset + actual-offset) + (:: (list.equivalence //.equivalence) = + expected-inits + actual-inits) + (:: //.equivalence = expected actual)) + + _ + false))) + ))) |