From b491dfff00219d5206075ea65468e00ab657075d Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 1 Dec 2022 20:03:21 -0400 Subject: Added simple benchmarking machinery. --- stdlib/source/test/lux/data/color/hsb.lux | 88 ++++++++++++++++++++++++++ stdlib/source/test/lux/data/color/hsl.lux | 55 ++++++++-------- stdlib/source/test/lux/math/number/complex.lux | 3 +- stdlib/source/test/lux/test.lux | 4 +- stdlib/source/test/lux/test/benchmark.lux | 68 ++++++++++++++++++++ 5 files changed, 188 insertions(+), 30 deletions(-) create mode 100644 stdlib/source/test/lux/data/color/hsb.lux create mode 100644 stdlib/source/test/lux/test/benchmark.lux (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/lux/data/color/hsb.lux b/stdlib/source/test/lux/data/color/hsb.lux new file mode 100644 index 000000000..16f6d9dfb --- /dev/null +++ b/stdlib/source/test/lux/data/color/hsb.lux @@ -0,0 +1,88 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)] + [\\specification + ["[0]S" equivalence]]] + [math + ["[0]" random (.only Random) (.use "[1]#[0]" monad)] + [number + ["f" frac]]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" / (.only) + [// + ["[0]" rgb]]]] + [// + ["[0]T" rgb]]) + +(def .public value + (Random /.Value) + (random#each /.value random.safe_frac)) + +(def .public random + (Random /.HSB) + (do random.monad + [hue ..value + saturation ..value + brightness ..value] + (in (/.hsb hue saturation brightness)))) + +(def .public test + Test + (<| (_.covering /._) + (do [! random.monad] + [expected_value ..value + expected_rgb rgbT.random + expected_hsb ..random + + possible_value random.frac]) + (all _.and + (_.for [/.Value] + (all _.and + (_.coverage [/.value?] + (and (/.value? expected_value) + (not (/.value? (f.+ f.smallest /.most))) + (not (/.value? (f.- f.smallest /.least))))) + (_.coverage [/.value] + (if (/.value? possible_value) + (|> possible_value + /.value + (f.= possible_value)) + (or (f.= /.least (/.value possible_value)) + (f.= /.most (/.value possible_value))))) + (_.coverage [/.least] + (and (f.< /.most + /.least) + (/.value? /.least) + (/.value? (f.+ f.smallest /.least)) + (not (/.value? (f.- f.smallest /.least))))) + (_.coverage [/.most] + (and (f.> /.least + /.most) + (/.value? /.most) + (/.value? (f.- f.smallest /.most)) + (not (/.value? (f.+ f.smallest /.most))))) + )) + (_.for [/.HSB] + (all _.and + (_.for [/.equivalence] + (equivalenceS.spec /.equivalence ..random)) + + (_.coverage [/.hsb + /.hue /.saturation /.brightness] + (|> (/.hsb (/.hue expected_hsb) (/.saturation expected_hsb) (/.brightness expected_hsb)) + (at /.equivalence = expected_hsb))) + (_.coverage [/.of_rgb /.rgb] + (and (|> expected_rgb + /.of_rgb + /.rgb + (at rgb.equivalence = expected_rgb)) + (|> expected_hsb + /.rgb + /.of_rgb + (at /.equivalence = expected_hsb)))) + )) + ))) diff --git a/stdlib/source/test/lux/data/color/hsl.lux b/stdlib/source/test/lux/data/color/hsl.lux index b3221e03b..a0524d2b1 100644 --- a/stdlib/source/test/lux/data/color/hsl.lux +++ b/stdlib/source/test/lux/data/color/hsl.lux @@ -5,11 +5,8 @@ [monad (.only do)] [\\specification ["[0]S" equivalence]]] - [control - ["[0]" try (.use "[1]#[0]" functor)] - ["[0]" exception]] [math - ["[0]" random (.only Random)] + ["[0]" random (.only Random) (.use "[1]#[0]" monad)] [number ["f" frac]]] [test @@ -23,8 +20,7 @@ (def .public value (Random /.Value) - (random.one (|>> /.value try.maybe) - random.safe_frac)) + (random#each /.value random.safe_frac)) (def .public random (Random /.HSL) @@ -32,8 +28,7 @@ [hue ..value saturation ..value luminance ..value] - (random.one (|>> try.maybe) - (in (/.hsl hue saturation luminance))))) + (in (/.hsl hue saturation luminance)))) (def .public test Test @@ -41,30 +36,35 @@ (do [! random.monad] [expected_value ..value expected_rgb rgbT.random - expected_hsl ..random]) + expected_hsl ..random + + possible_value random.frac]) (all _.and (_.for [/.Value] (all _.and + (_.coverage [/.value?] + (and (/.value? expected_value) + (not (/.value? (f.+ f.smallest /.most))) + (not (/.value? (f.- f.smallest /.least))))) (_.coverage [/.value] - (|> expected_value - /.value - (try#each (f.= expected_value)) - (try.else false))) + (if (/.value? possible_value) + (|> possible_value + /.value + (f.= possible_value)) + (or (f.= /.least (/.value possible_value)) + (f.= /.most (/.value possible_value))))) (_.coverage [/.least] - (when (/.value (f.+ +0.001 /.least)) - {try.#Failure _} false - {try.#Success _} true)) + (and (f.< /.most + /.least) + (/.value? /.least) + (/.value? (f.+ f.smallest /.least)) + (not (/.value? (f.- f.smallest /.least))))) (_.coverage [/.most] - (when (/.value (f.- +0.001 /.most)) - {try.#Failure _} false - {try.#Success _} true)) - (_.coverage [/.invalid] - (and (when (/.value (f.- +0.001 /.least)) - {try.#Failure it} (exception.match? /.invalid it) - {try.#Success _} false) - (when (/.value (f.+ +0.001 /.most)) - {try.#Failure it} (exception.match? /.invalid it) - {try.#Success _} false))) + (and (f.> /.least + /.most) + (/.value? /.most) + (/.value? (f.- f.smallest /.most)) + (not (/.value? (f.+ f.smallest /.most))))) )) (_.for [/.HSL] (all _.and @@ -74,8 +74,7 @@ (_.coverage [/.hsl /.hue /.saturation /.luminance] (|> (/.hsl (/.hue expected_hsl) (/.saturation expected_hsl) (/.luminance expected_hsl)) - (try#each (at /.equivalence = expected_hsl)) - (try.else false))) + (at /.equivalence = expected_hsl))) (_.coverage [/.of_rgb /.rgb] (and (|> expected_rgb /.of_rgb diff --git a/stdlib/source/test/lux/math/number/complex.lux b/stdlib/source/test/lux/math/number/complex.lux index 18fbdd28e..501d01cd0 100644 --- a/stdlib/source/test/lux/math/number/complex.lux +++ b/stdlib/source/test/lux/math/number/complex.lux @@ -270,7 +270,8 @@ (def .public test Test (<| (_.covering /._) - (_.for [/.Complex]) + (_.for [/.Complex + /.#imaginary /.#real]) (all _.and (_.for [/.= /.equivalence] ($equivalence.spec /.equivalence ..random)) diff --git a/stdlib/source/test/lux/test.lux b/stdlib/source/test/lux/test.lux index 34891bf65..fd206f642 100644 --- a/stdlib/source/test/lux/test.lux +++ b/stdlib/source/test/lux/test.lux @@ -8,7 +8,8 @@ ["[1][0]" tally] ["[1][0]" unit] ["[1][0]" property] - ["[1][0]" inline]]) + ["[1][0]" inline] + ["[1][0]" benchmark]]) (def .public test Test @@ -18,4 +19,5 @@ /unit.test /property.test /inline.test + /benchmark.test )) diff --git a/stdlib/source/test/lux/test/benchmark.lux b/stdlib/source/test/lux/test/benchmark.lux new file mode 100644 index 000000000..740d444cf --- /dev/null +++ b/stdlib/source/test/lux/test/benchmark.lux @@ -0,0 +1,68 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)] + ["[0]" order]] + [control + ["[0]" io (.only IO)]] + [math + ["[0]" random (.only Random)] + [number + ["n" nat] + ["f" frac]]] + [world + [time + ["[0]" duration]]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" /]]) + +(def .public test + Test + (<| (_.covering /._) + (do [! random.monad] + [angle random.safe_frac + + times (at ! each (n.% 10) random.nat) + + .let [computation (is (IO Frac) + (io.io (|> angle + f.cos f.acos + f.sin f.asin + f.tan f.atan + f.exp f.log)))]]) + (all _.and + (_.coverage [/.time] + (io.run! + (do io.monad + [duration (/.time computation)] + (in (duration.positive? duration))))) + (<| (_.for [/.Benchmark + /.#times /.#minimum /.#maximum /.#average]) + (all _.and + (_.coverage [/.test] + (io.run! + (do io.monad + [it (/.test times computation)] + (in (and (n.= times (the /.#times it)) + (when times + 0 (and (duration.neutral? (the /.#minimum it)) + (duration.neutral? (the /.#maximum it)) + (duration.neutral? (the /.#average it))) + _ (and (duration.positive? (the /.#minimum it)) + (duration.positive? (the /.#maximum it)) + (duration.positive? (the /.#average it)) + + (order.<= duration.order + (the /.#maximum it) + (the /.#minimum it)) + (order.<= duration.order + (the /.#maximum it) + (the /.#average it)) + (order.>= duration.order + (the /.#minimum it) + (the /.#average it))))))))) + )) + ))) -- cgit v1.2.3