From f6a2fe158979230dcf2d271981ff34be39c7bffc Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 20 Apr 2020 23:56:15 -0400 Subject: Added some testing machinery to measure the code coverage of tests. --- stdlib/source/test/lux/abstract/apply.lux | 65 +++++++++-------- stdlib/source/test/lux/control/state.lux | 111 +++++++++++++++--------------- stdlib/source/test/lux/control/thread.lux | 75 ++++++++++++++------ 3 files changed, 142 insertions(+), 109 deletions(-) (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/lux/abstract/apply.lux b/stdlib/source/test/lux/abstract/apply.lux index 87c706f55..c53283233 100644 --- a/stdlib/source/test/lux/abstract/apply.lux +++ b/stdlib/source/test/lux/abstract/apply.lux @@ -3,72 +3,71 @@ [abstract/monad (#+ do)] [data [number - ["n" nat]] - [text - ["%" format (#+ format)]]] + ["n" nat]]] [control ["." function]] [math - ["r" random]] + ["." random]] ["_" test (#+ Test)]] {1 ["." / (#+ Apply)]} [// [functor (#+ Injection Comparison)]]) -(def: (identity injection comparison (^open "_;.")) +(def: (identity injection comparison (^open "_@.")) (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) - (do r.monad - [sample (:: @ map injection r.nat)] + (do random.monad + [sample (:: @ map injection random.nat)] (_.test "Identity." ((comparison n.=) - (_;apply (injection function.identity) sample) + (_@apply (injection function.identity) sample) sample)))) -(def: (homomorphism injection comparison (^open "_;.")) +(def: (homomorphism injection comparison (^open "_@.")) (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) - (do r.monad - [sample r.nat - increase (:: @ map n.+ r.nat)] + (do random.monad + [sample random.nat + increase (:: @ map n.+ random.nat)] (_.test "Homomorphism." ((comparison n.=) - (_;apply (injection increase) (injection sample)) + (_@apply (injection increase) (injection sample)) (injection (increase sample)))))) -(def: (interchange injection comparison (^open "_;.")) +(def: (interchange injection comparison (^open "_@.")) (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) - (do r.monad - [sample r.nat - increase (:: @ map n.+ r.nat)] + (do random.monad + [sample random.nat + increase (:: @ map n.+ random.nat)] (_.test "Interchange." ((comparison n.=) - (_;apply (injection increase) (injection sample)) - (_;apply (injection (function (_ f) (f sample))) (injection increase)))))) + (_@apply (injection increase) (injection sample)) + (_@apply (injection (function (_ f) (f sample))) (injection increase)))))) -(def: (composition injection comparison (^open "_;.")) +(def: (composition injection comparison (^open "_@.")) (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) - (do r.monad - [sample r.nat - increase (:: @ map n.+ r.nat) - decrease (:: @ map n.- r.nat)] + (do random.monad + [sample random.nat + increase (:: @ map n.+ random.nat) + decrease (:: @ map n.- random.nat)] (_.test "Composition." ((comparison n.=) - (_$ _;apply + (_$ _@apply (injection function.compose) (injection increase) (injection decrease) (injection sample)) - ($_ _;apply + ($_ _@apply (injection increase) (injection decrease) (injection sample)))))) (def: #export (spec injection comparison apply) (All [f] (-> (Injection f) (Comparison f) (Apply f) Test)) - (_.context (%.name (name-of /.Apply)) - ($_ _.and - (..identity injection comparison apply) - (..homomorphism injection comparison apply) - (..interchange injection comparison apply) - (..composition injection comparison apply) - ))) + (<| (_.covering /._) + (_.with-cover [/.Apply] + ($_ _.and + (..identity injection comparison apply) + (..homomorphism injection comparison apply) + (..interchange injection comparison apply) + (..composition injection comparison apply) + )))) diff --git a/stdlib/source/test/lux/control/state.lux b/stdlib/source/test/lux/control/state.lux index 1d9899539..cb7c94b83 100644 --- a/stdlib/source/test/lux/control/state.lux +++ b/stdlib/source/test/lux/control/state.lux @@ -34,26 +34,26 @@ [state r.nat value r.nat] ($_ _.and - (_.test "Can get the state as a value." - (with-conditions [state state] - /.get)) - (_.test "Can replace the state." - (with-conditions [state value] - (do /.monad - [_ (/.put value)] - /.get))) - (_.test "Can update the state." - (with-conditions [state (n.* value state)] - (do /.monad - [_ (/.update (n.* value))] - /.get))) - (_.test "Can use the state." - (with-conditions [state (inc state)] - (/.use inc))) - (_.test "Can use a temporary (local) state." - (with-conditions [state (n.* value state)] - (/.local (n.* value) - /.get))) + (_.cover [/.State /.get] + (with-conditions [state state] + /.get)) + (_.cover [/.put] + (with-conditions [state value] + (do /.monad + [_ (/.put value)] + /.get))) + (_.cover [/.update] + (with-conditions [state (n.* value state)] + (do /.monad + [_ (/.update (n.* value))] + /.get))) + (_.cover [/.use] + (with-conditions [state (inc state)] + (/.use inc))) + (_.cover [/.local] + (with-conditions [state (n.* value state)] + (/.local (n.* value) + /.get))) ))) (def: (injection value) @@ -72,9 +72,12 @@ [state r.nat value r.nat] ($_ _.and - ($functor.spec ..injection (..comparison state) /.functor) - ($apply.spec ..injection (..comparison state) /.apply) - ($monad.spec ..injection (..comparison state) /.monad) + (_.with-cover [/.functor] + ($functor.spec ..injection (..comparison state) /.functor)) + (_.with-cover [/.apply] + ($apply.spec ..injection (..comparison state) /.apply)) + (_.with-cover [/.monad] + ($monad.spec ..injection (..comparison state) /.monad)) ))) (def: loops @@ -85,18 +88,18 @@ [state /.get] (wrap (n.< limit state)))]] ($_ _.and - (_.test "'while' will only execute if the condition is #1." - (|> (/.while condition (/.update inc)) - (/.run 0) - (let> [state' output'] - (n.= limit state')))) - (_.test "'do-while' will execute at least once." - (|> (/.do-while condition (/.update inc)) - (/.run 0) - (let> [state' output'] - (or (n.= limit state') - (and (n.= 0 limit) - (n.= 1 state')))))) + (_.cover [/.while /.run] + (|> (/.while condition (/.update inc)) + (/.run 0) + (let> [state' output'] + (n.= limit state')))) + (_.cover [/.do-while] + (|> (/.do-while condition (/.update inc)) + (/.run 0) + (let> [state' output'] + (or (n.= limit state') + (and (n.= 0 limit) + (n.= 1 state')))))) ))) (def: monad-transformer @@ -105,29 +108,25 @@ [state r.nat left r.nat right r.nat] - (let [(^open "io;.") io.monad] - (_.test "Can add state functionality to any monad." - (|> (: (/.State' io.IO Nat Nat) - (do (/.with io.monad) - [a (/.lift io.monad (io;wrap left)) - b (wrap right)] - (wrap (n.+ a b)))) - (/.run' state) - io.run - (let> [state' output'] - (and (n.= state state') - (n.= (n.+ left right) output'))))) + (let [(^open "io@.") io.monad] + (_.cover [/.State' /.with /.lift /.run'] + (|> (: (/.State' io.IO Nat Nat) + (do (/.with io.monad) + [a (/.lift io.monad (io@wrap left)) + b (wrap right)] + (wrap (n.+ a b)))) + (/.run' state) + io.run + (let> [state' output'] + (and (n.= state state') + (n.= (n.+ left right) output'))))) ))) (def: #export test Test - (<| (_.context (%.name (name-of /.State))) + (<| (_.covering /._) ($_ _.and - (<| (_.context "Basics.") - ..basics) - (<| (_.context "Structures.") - ..structures) - (<| (_.context "Loops.") - ..loops) - (<| (_.context "Monad transformer.") - ..monad-transformer)))) + ..basics + ..structures + ..loops + ..monad-transformer))) diff --git a/stdlib/source/test/lux/control/thread.lux b/stdlib/source/test/lux/control/thread.lux index 7d6ed0ceb..49e397d21 100644 --- a/stdlib/source/test/lux/control/thread.lux +++ b/stdlib/source/test/lux/control/thread.lux @@ -10,13 +10,13 @@ ["$." monad]]}] [data [number - ["n" nat]] - [text - ["%" format (#+ format)]]] + ["n" nat]]] [math - ["r" random]]] + ["." random]]] {1 - ["." / (#+ Thread)]}) + ["." / (#+ Thread) + [// + ["." io]]]}) (def: (injection value) (Injection (All [a !] (Thread ! a))) @@ -29,20 +29,55 @@ (def: #export test Test - (do r.monad - [original r.nat - factor r.nat] - (<| (_.context (%.name (name-of /.Thread))) + (do random.monad + [sample random.nat + factor random.nat] + (<| (_.covering /._) ($_ _.and - ($functor.spec ..injection ..comparison /.functor) - ($apply.spec ..injection ..comparison /.apply) - ($monad.spec ..injection ..comparison /.monad) - - (_.test "Can safely do mutation." - (n.= (n.* factor original) - (/.run (: (All [!] (Thread ! Nat)) - (do /.monad - [box (/.box original) - old (/.update (n.* factor) box)] - (/.read box)))))) + (_.with-cover [/.Thread] + ($_ _.and + (_.cover [/.run] + (n.= sample + (|> sample + (:: /.monad wrap) + /.run))) + (_.cover [/.io] + (n.= sample + (|> sample + (:: /.monad wrap) + /.io + io.run))) + + (_.with-cover [/.functor] + ($functor.spec ..injection ..comparison /.functor)) + (_.with-cover [/.apply] + ($apply.spec ..injection ..comparison /.apply)) + (_.with-cover [/.monad] + ($monad.spec ..injection ..comparison /.monad)) + )) + + (_.with-cover [/.Box /.box] + ($_ _.and + (_.cover [/.read] + (n.= sample + (/.run (: (All [!] (Thread ! Nat)) + (do /.monad + [box (/.box sample)] + (/.read box)))))) + + (_.cover [/.write] + (n.= factor + (/.run (: (All [!] (Thread ! Nat)) + (do /.monad + [box (/.box sample) + _ (/.write factor box)] + (/.read box)))))) + + (_.cover [/.update] + (n.= (n.* factor sample) + (/.run (: (All [!] (Thread ! Nat)) + (do /.monad + [box (/.box sample) + old (/.update (n.* factor) box)] + (/.read box)))))))) )))) -- cgit v1.2.3