From ce1a7a131f7c4df8eae5c019eba2893b56f04d46 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 24 Jun 2021 03:42:57 -0400 Subject: Added a macro for type-casting JVM objects. --- stdlib/source/test/aedifex/command.lux | 9 +- stdlib/source/test/aedifex/command/auto.lux | 29 +- stdlib/source/test/aedifex/command/build.lux | 12 +- stdlib/source/test/aedifex/command/test.lux | 10 +- .../source/test/aedifex/dependency/resolution.lux | 457 +++++++++++---------- stdlib/source/test/aedifex/input.lux | 17 +- stdlib/source/test/lux/math.lux | 182 +++++--- 7 files changed, 413 insertions(+), 303 deletions(-) (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/aedifex/command.lux b/stdlib/source/test/aedifex/command.lux index e0cb2da79..42d1c1278 100644 --- a/stdlib/source/test/aedifex/command.lux +++ b/stdlib/source/test/aedifex/command.lux @@ -12,11 +12,10 @@ ["#." deploy] ["#." build] - ["#." test]] + ["#." test] + ["#." auto]] {#program - ["." / - ## ["#." auto] - ]}) + ["." /]}) (def: #export test Test @@ -34,5 +33,5 @@ /build.test /test.test - ## /auto.test + /auto.test ))) diff --git a/stdlib/source/test/aedifex/command/auto.lux b/stdlib/source/test/aedifex/command/auto.lux index 7bac6eb5d..c23519bcc 100644 --- a/stdlib/source/test/aedifex/command/auto.lux +++ b/stdlib/source/test/aedifex/command/auto.lux @@ -20,7 +20,7 @@ ["." set] ["." list ("#\." functor)]]] [math - ["." random] + ["." random (#+ Random)] [number ["n" nat]]] [world @@ -56,10 +56,10 @@ [@runs (function (_ console program fs shell resolution profile) (do {! promise.monad} - [[runs remaining_files] (promise.future - (atom.update (function (_ [runs remaining_files]) - [(inc runs) remaining_files]) - @runs))] + [[_ [runs remaining_files]] (promise.future + (atom.update (function (_ [runs remaining_files]) + [(inc runs) remaining_files]) + @runs))] (case remaining_files #.Nil (wrap (#try.Failure end_signal)) @@ -78,15 +78,10 @@ [#let [/ (\ file.default separator) [fs watcher] (watch.mock /)] end_signal (random.ascii/alpha 5) + program (random.ascii/alpha 5) target (random.ascii/alpha 5) - home (random.ascii/alpha 5) - working_directory (random.ascii/alpha 5) - expected_runs (\ ! map (|>> (n.% 10) (n.max 2)) random.nat) source (random.ascii/alpha 5) - dummy_files (|> (random.ascii/alpha 5) - (random.set text.hash (dec expected_runs)) - (\ ! map (|>> set.to_list (list\map (|>> (format source /)))))) #let [empty_profile (: Profile (\ ///.monoid identity)) with_target (: (-> Profile Profile) @@ -98,6 +93,14 @@ with_program with_target (set@ #///.sources (set.from_list text.hash (list source))))] + + home (random.ascii/alpha 5) + working_directory (random.ascii/alpha 5) + + expected_runs (\ ! map (|>> (n.% 10) (n.max 2)) random.nat) + dummy_files (|> (random.ascii/alpha 5) + (random.set text.hash (dec expected_runs)) + (\ ! map (|>> set.to_list (list\map (|>> (format source /)))))) resolution @build.resolution] ($_ _.and (wrap (do promise.monad @@ -106,11 +109,11 @@ _ (!.use (\ fs create_directory) [source]) _ (\ watcher poll [])] (do promise.monad - [outcome ((/.do! watcher command) + [outcome ((/.do! 1 watcher command) (@version.echo "") (program.async (program.mock environment.empty home working_directory)) fs - (@build.good_shell []) + (shell.async (@build.good_shell [])) resolution profile) [actual_runs _] (promise.future (atom.read @runs))] diff --git a/stdlib/source/test/aedifex/command/build.lux b/stdlib/source/test/aedifex/command/build.lux index 85231ae33..234343fea 100644 --- a/stdlib/source/test/aedifex/command/build.lux +++ b/stdlib/source/test/aedifex/command/build.lux @@ -45,9 +45,9 @@ (: (shell.Simulation []) (structure (def: (on_read state) - (#try.Failure "on_read")) + (exception.throw shell.no_more_output [])) (def: (on_error state) - (#try.Failure "on_error")) + (exception.throw shell.no_more_output [])) (def: (on_write input state) (#try.Failure "on_write")) (def: (on_destroy state) @@ -63,9 +63,9 @@ (: (shell.Simulation []) (structure (def: (on_read state) - (#try.Failure "on_read")) + (exception.throw shell.no_more_output [])) (def: (on_error state) - (#try.Failure "on_error")) + (exception.throw shell.no_more_output [])) (def: (on_write input state) (#try.Failure "on_write")) (def: (on_destroy state) @@ -98,7 +98,9 @@ Test (<| (_.covering /._) (do {! random.monad} - [#let [fs (file.mock (\ file.default separator)) + [last_read (random.ascii/alpha 5) + last_error (random.ascii/alpha 5) + #let [fs (file.mock (\ file.default separator)) shell (shell.async (..good_shell []))] program (random.ascii/alpha 5) target (random.ascii/alpha 5) diff --git a/stdlib/source/test/aedifex/command/test.lux b/stdlib/source/test/aedifex/command/test.lux index 9dd76ca08..36c21b520 100644 --- a/stdlib/source/test/aedifex/command/test.lux +++ b/stdlib/source/test/aedifex/command/test.lux @@ -5,6 +5,7 @@ [monad (#+ do)]] [control ["." try] + ["." exception] [concurrency ["." promise]] [parser @@ -14,7 +15,8 @@ [data ["." text ("#\." equivalence)] [collection - ["." dictionary]]] + ["." dictionary] + ["." list]]] [math ["." random]] [world @@ -84,15 +86,15 @@ (: (shell.Simulation []) (structure (def: (on_read state) - (#try.Failure "on_read")) + (exception.throw shell.no_more_output [])) (def: (on_error state) - (#try.Failure "on_error")) + (exception.throw shell.no_more_output [])) (def: (on_write input state) (#try.Failure "on_write")) (def: (on_destroy state) (#try.Failure "on_destroy")) (def: (on_await state) - (#try.Success [state (if (text.ends_with? " build" actual_command) + (#try.Success [state (if (list.any? (text\= "build") actual_arguments) shell.normal shell.error)])))))) [])] diff --git a/stdlib/source/test/aedifex/dependency/resolution.lux b/stdlib/source/test/aedifex/dependency/resolution.lux index e9cd26a82..ae8c7699b 100644 --- a/stdlib/source/test/aedifex/dependency/resolution.lux +++ b/stdlib/source/test/aedifex/dependency/resolution.lux @@ -13,33 +13,31 @@ [concurrency ["." promise]]] [data + [binary (#+ Binary)] ["." product] - ["." binary] ["." text + ["%" format (#+ format)] [encoding ["." utf8]]] [format ["." xml]] [collection ["." dictionary] - ["." set]]] + ["." set] + ["." list]]] [math ["." random (#+ Random)]]] ["$." /// #_ ["#." package] ["#." repository] - ["#." artifact] - [// - [lux - [data - ["$." binary]]]]] + ["#." artifact]] {#program ["." / ["//#" /// #_ ["#" profile] ["#." package (#+ Package)] ["#." hash] - ["#." dependency + ["#." dependency (#+ Dependency) ("#\." equivalence) ["#/." status]] ["#." pom] ["#." artifact (#+ Artifact) @@ -94,6 +92,136 @@ (def: (on_upload uri binary state) (#try.Failure "NOPE"))))) +(def: lux_sha1 + Text + (format ///artifact/extension.lux_library ///artifact/extension.sha-1)) + +(def: lux_md5 + Text + (format ///artifact/extension.lux_library ///artifact/extension.md5)) + +(def: pom_sha1 + Text + (format ///artifact/extension.pom ///artifact/extension.sha-1)) + +(def: pom_md5 + Text + (format ///artifact/extension.pom ///artifact/extension.md5)) + +(def: sha1 + (-> Binary Binary) + (|>> ///hash.sha-1 + (\ ///hash.sha-1_codec encode) + (\ utf8.codec encode))) + +(def: md5 + (-> Binary Binary) + (|>> ///hash.md5 + (\ ///hash.md5_codec encode) + (\ utf8.codec encode))) + +(def: (bad_sha-1 expected_artifact expected_package dummy_package) + (-> Artifact Package Package (Simulation Any)) + (structure + (def: (on_download uri state) + (if (text.contains? (///artifact.uri (get@ #///artifact.version expected_artifact) expected_artifact) uri) + (cond (text.ends_with? ///artifact/extension.lux_library uri) + (#try.Success [state (|> expected_package + (get@ #///package.library) + product.left)]) + + (text.ends_with? lux_sha1 uri) + (#try.Success [state (|> expected_package + (get@ #///package.library) + product.left + sha1)]) + + (text.ends_with? lux_md5 uri) + (#try.Success [state (|> expected_package + (get@ #///package.library) + product.left + md5)]) + + (text.ends_with? ///artifact/extension.pom uri) + (#try.Success [state (|> expected_package + (get@ #///package.pom) + product.left + (\ xml.codec encode) + (\ utf8.codec encode))]) + + (text.ends_with? pom_sha1 uri) + (#try.Success [state (|> dummy_package + (get@ #///package.pom) + product.left + (\ xml.codec encode) + (\ utf8.codec encode) + sha1)]) + + (text.ends_with? pom_md5 uri) + (#try.Success [state (|> expected_package + (get@ #///package.pom) + product.left + (\ xml.codec encode) + (\ utf8.codec encode) + md5)]) + + ## else + (#try.Failure "NOPE")) + (#try.Failure "NOPE"))) + (def: (on_upload uri binary state) + (#try.Failure "NOPE")))) + +(def: (bad_md5 expected_artifact expected_package dummy_package) + (-> Artifact Package Package (Simulation Any)) + (structure + (def: (on_download uri state) + (if (text.contains? (///artifact.uri (get@ #///artifact.version expected_artifact) expected_artifact) uri) + (cond (text.ends_with? ///artifact/extension.lux_library uri) + (#try.Success [state (|> expected_package + (get@ #///package.library) + product.left)]) + + (text.ends_with? lux_sha1 uri) + (#try.Success [state (|> expected_package + (get@ #///package.library) + product.left + sha1)]) + + (text.ends_with? lux_md5 uri) + (#try.Success [state (|> dummy_package + (get@ #///package.library) + product.left + md5)]) + + (text.ends_with? ///artifact/extension.pom uri) + (#try.Success [state (|> expected_package + (get@ #///package.pom) + product.left + (\ xml.codec encode) + (\ utf8.codec encode))]) + + (text.ends_with? pom_sha1 uri) + (#try.Success [state (|> expected_package + (get@ #///package.pom) + product.left + (\ xml.codec encode) + (\ utf8.codec encode) + sha1)]) + + (text.ends_with? pom_md5 uri) + (#try.Success [state (|> dummy_package + (get@ #///package.pom) + product.left + (\ xml.codec encode) + (\ utf8.codec encode) + md5)]) + + ## else + (#try.Failure "NOPE")) + (#try.Failure "NOPE"))) + (def: (on_upload uri binary state) + (#try.Failure "NOPE")))) + (def: one Test (do {! random.monad} @@ -105,72 +233,8 @@ not) $///package.random) #let [good (..single expected_artifact expected_package) - bad_sha-1 (: (Simulation Any) - (structure - (def: (on_download uri state) - (if (text.contains? (///artifact.uri (get@ #///artifact.version expected_artifact) expected_artifact) uri) - (cond (text.ends_with? ///artifact/extension.lux_library uri) - (#try.Success [state (|> expected_package - (get@ #///package.library) - product.left)]) - - (text.ends_with? ///artifact/extension.pom uri) - (#try.Success [state (|> expected_package - (get@ #///package.pom) - product.left - (\ xml.codec encode) - (\ utf8.codec encode))]) - - ## (text\= extension ///artifact/extension.sha-1) - ## (#try.Success [state (|> dummy_package - ## (get@ #///package.sha-1) - ## (\ ///hash.sha-1_codec encode) - ## (\ utf8.codec encode))]) - - ## (text\= extension ///artifact/extension.md5) - ## (#try.Success [state (|> expected_package - ## (get@ #///package.md5) - ## (\ ///hash.md5_codec encode) - ## (\ utf8.codec encode))]) - - ## else - (#try.Failure "NOPE")) - (#try.Failure "NOPE"))) - (def: (on_upload uri binary state) - (#try.Failure "NOPE")))) - bad_md5 (: (Simulation Any) - (structure - (def: (on_download uri state) - (if (text.contains? (///artifact.uri (get@ #///artifact.version expected_artifact) expected_artifact) uri) - (cond (text.ends_with? ///artifact/extension.lux_library uri) - (#try.Success [state (|> expected_package - (get@ #///package.library) - product.left)]) - - (text.ends_with? ///artifact/extension.pom uri) - (#try.Success [state (|> expected_package - (get@ #///package.pom) - product.left - (\ xml.codec encode) - (\ utf8.codec encode))]) - - ## (text\= extension ///artifact/extension.sha-1) - ## (#try.Success [state (|> expected_package - ## (get@ #///package.sha-1) - ## (\ ///hash.sha-1_codec encode) - ## (\ utf8.codec encode))]) - - ## (text\= extension ///artifact/extension.md5) - ## (#try.Success [state (|> dummy_package - ## (get@ #///package.md5) - ## (\ ///hash.md5_codec encode) - ## (\ utf8.codec encode))]) - - ## else - (#try.Failure "NOPE")) - (#try.Failure "NOPE"))) - (def: (on_upload uri binary state) - (#try.Failure "NOPE"))))]] + bad_sha-1 (..bad_sha-1 expected_artifact expected_package dummy_package) + bad_md5 (..bad_md5 expected_artifact expected_package dummy_package)]] (`` ($_ _.and (wrap (do promise.monad @@ -216,72 +280,8 @@ not) $///package.random) #let [good (..single expected_artifact expected_package) - bad_sha-1 (: (Simulation Any) - (structure - (def: (on_download uri state) - (if (text.contains? (///artifact.uri (get@ #///artifact.version expected_artifact) expected_artifact) uri) - (cond (text.ends_with? ///artifact/extension.lux_library uri) - (#try.Success [state (|> expected_package - (get@ #///package.library) - product.left)]) - - (text.ends_with? ///artifact/extension.pom uri) - (#try.Success [state (|> expected_package - (get@ #///package.pom) - product.left - (\ xml.codec encode) - (\ utf8.codec encode))]) - - ## (text\= extension ///artifact/extension.sha-1) - ## (#try.Success [state (|> dummy_package - ## (get@ #///package.sha-1) - ## (\ ///hash.sha-1_codec encode) - ## (\ utf8.codec encode))]) - - ## (text\= extension ///artifact/extension.md5) - ## (#try.Success [state (|> expected_package - ## (get@ #///package.md5) - ## (\ ///hash.md5_codec encode) - ## (\ utf8.codec encode))]) - - ## else - (#try.Failure "NOPE")) - (#try.Failure "NOPE"))) - (def: (on_upload uri binary state) - (#try.Failure "NOPE")))) - bad_md5 (: (Simulation Any) - (structure - (def: (on_download uri state) - (if (text.contains? (///artifact.uri (get@ #///artifact.version expected_artifact) expected_artifact) uri) - (cond (text.ends_with? ///artifact/extension.lux_library uri) - (#try.Success [state (|> expected_package - (get@ #///package.library) - product.left)]) - - (text.ends_with? ///artifact/extension.pom uri) - (#try.Success [state (|> expected_package - (get@ #///package.pom) - product.left - (\ xml.codec encode) - (\ utf8.codec encode))]) - - ## (text\= extension ///artifact/extension.sha-1) - ## (#try.Success [state (|> expected_package - ## (get@ #///package.sha-1) - ## (\ ///hash.sha-1_codec encode) - ## (\ utf8.codec encode))]) - - ## (text\= extension ///artifact/extension.md5) - ## (#try.Success [state (|> dummy_package - ## (get@ #///package.md5) - ## (\ ///hash.md5_codec encode) - ## (\ utf8.codec encode))]) - - ## else - (#try.Failure "NOPE")) - (#try.Failure "NOPE"))) - (def: (on_upload uri binary state) - (#try.Failure "NOPE"))))]] + bad_sha-1 (..bad_sha-1 expected_artifact expected_package dummy_package) + bad_md5 (..bad_md5 expected_artifact expected_package dummy_package)]] ($_ _.and (wrap (do promise.monad @@ -314,77 +314,106 @@ false)))) ))) -## (def: all -## Test -## (do {! random.monad} -## [dependee_artifact $///artifact.random -## depender_artifact (random.filter (predicate.complement -## (\ ///artifact.equivalence = dependee_artifact)) -## $///artifact.random) -## ignored_artifact (random.filter (predicate.complement -## (predicate.unite (\ ///artifact.equivalence = dependee_artifact) -## (\ ///artifact.equivalence = depender_artifact))) -## $///artifact.random) - -## [_ dependee_package] $///package.random -## [_ depender_package] $///package.random -## [_ ignored_package] $///package.random - -## #let [dependee {#///dependency.artifact dependee_artifact -## #///dependency.type ///artifact/type.lux_library} -## depender {#///dependency.artifact depender_artifact -## #///dependency.type ///artifact/type.lux_library} -## ignored {#///dependency.artifact ignored_artifact -## #///dependency.type ///artifact/type.lux_library} - -## dependee_pom (|> (\ ///.monoid identity) -## (set@ #///.identity (#.Some dependee_artifact)) -## ///pom.write -## try.assume) -## depender_pom (|> (\ ///.monoid identity) -## (set@ #///.identity (#.Some depender_artifact)) -## (set@ #///.dependencies (set.from_list ///dependency.hash (list dependee))) -## ///pom.write -## try.assume) -## ignored_pom (|> (\ ///.monoid identity) -## (set@ #///.identity (#.Some ignored_artifact)) -## ///pom.write -## try.assume) - -## dependee_package (set@ #///package.pom [dependee_pom #///dependency/status.Unverified] dependee_package) -## depender_package (set@ #///package.pom [depender_pom #///dependency/status.Unverified] depender_package) -## ignored_package (set@ #///package.pom [ignored_pom #///dependency/status.Unverified] ignored_package)]] -## ($_ _.and -## (wrap -## (do promise.monad -## [resolution (/.all (list (///repository.mock (..single dependee_artifact dependee_package) []) -## (///repository.mock (..single depender_artifact depender_package) []) -## (///repository.mock (..single ignored_artifact ignored_package) [])) -## (list depender) -## /.empty)] -## (_.cover' [/.all] -## (case resolution -## (#try.Success resolution) -## (and (dictionary.key? resolution depender) -## (dictionary.key? resolution dependee) -## (not (dictionary.key? resolution ignored))) - -## (#try.Failure error) -## false)))) -## ))) - -## (def: #export test -## Test -## (<| (_.covering /._) -## (_.for [/.Resolution]) -## ($_ _.and -## (_.for [/.equivalence] -## ($equivalence.spec /.equivalence ..random)) - -## (_.cover [/.empty] -## (dictionary.empty? /.empty)) - -## ..one -## ..any -## ..all -## ))) +(def: artifacts + (Random [Artifact Artifact Artifact]) + (do random.monad + [dependee_artifact $///artifact.random + depender_artifact (random.filter (predicate.complement + (\ ///artifact.equivalence = dependee_artifact)) + $///artifact.random) + ignored_artifact (random.filter (predicate.complement + (predicate.unite (\ ///artifact.equivalence = dependee_artifact) + (\ ///artifact.equivalence = depender_artifact))) + $///artifact.random)] + (wrap [dependee_artifact depender_artifact ignored_artifact]))) + +(def: (packages [dependee_artifact depender_artifact ignored_artifact]) + (-> [Artifact Artifact Artifact] + (Random [[Dependency Dependency Dependency] + [Package Package Package]])) + (do random.monad + [[_ dependee_package] $///package.random + [_ depender_package] $///package.random + [_ ignored_package] $///package.random + + #let [dependee {#///dependency.artifact dependee_artifact + #///dependency.type ///artifact/type.lux_library} + depender {#///dependency.artifact depender_artifact + #///dependency.type ///artifact/type.lux_library} + ignored {#///dependency.artifact ignored_artifact + #///dependency.type ///artifact/type.lux_library} + + dependee_pom (|> (\ ///.monoid identity) + (set@ #///.identity (#.Some dependee_artifact)) + ///pom.write + try.assume) + depender_pom (|> (\ ///.monoid identity) + (set@ #///.identity (#.Some depender_artifact)) + (set@ #///.dependencies (set.from_list ///dependency.hash (list dependee))) + ///pom.write + try.assume) + ignored_pom (|> (\ ///.monoid identity) + (set@ #///.identity (#.Some ignored_artifact)) + ///pom.write + try.assume) + + dependee_package (set@ #///package.pom + [dependee_pom + (|> dependee_pom (\ xml.codec encode) (\ utf8.codec encode)) + #///dependency/status.Unverified] + dependee_package) + depender_package (set@ #///package.pom + [depender_pom + (|> depender_pom (\ xml.codec encode) (\ utf8.codec encode)) + #///dependency/status.Unverified] + depender_package) + ignored_package (set@ #///package.pom + [ignored_pom + (|> ignored_pom (\ xml.codec encode) (\ utf8.codec encode)) + #///dependency/status.Unverified] + ignored_package)]] + (wrap [[dependee depender ignored] + [dependee_package depender_package ignored_package]]))) + +(def: all + Test + (do {! random.monad} + [[dependee_artifact depender_artifact ignored_artifact] ..artifacts + + [[dependee depender ignored] + [dependee_package depender_package ignored_package]] + (..packages [dependee_artifact depender_artifact ignored_artifact])] + ($_ _.and + (wrap + (do promise.monad + [[successes failures resolution] (/.all (list (///repository.mock (..single dependee_artifact dependee_package) []) + (///repository.mock (..single depender_artifact depender_package) []) + (///repository.mock (..single ignored_artifact ignored_package) [])) + (list depender) + /.empty)] + (_.cover' [/.all] + (and (dictionary.key? resolution depender) + (list.any? (///dependency\= depender) successes) + + (dictionary.key? resolution dependee) + (list.any? (///dependency\= dependee) successes) + + (list.empty? failures) + (not (dictionary.key? resolution ignored)))))) + ))) + +(def: #export test + Test + (<| (_.covering /._) + (_.for [/.Resolution]) + ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + + (_.cover [/.empty] + (dictionary.empty? /.empty)) + + ..one + ..any + ..all + ))) diff --git a/stdlib/source/test/aedifex/input.lux b/stdlib/source/test/aedifex/input.lux index e2751381a..86771cf1f 100644 --- a/stdlib/source/test/aedifex/input.lux +++ b/stdlib/source/test/aedifex/input.lux @@ -13,7 +13,8 @@ ["." binary] ["." text ["%" format (#+ format)] - ["." encoding]] + [encoding + ["." utf8]]] [collection ["." set (#+ Set)]]] [math @@ -28,7 +29,9 @@ ["#" profile (#+ Profile)] ["#." project] ["#." action] - ["#." format]]]}) + ["#." format] + [repository + [remote (#+ Address)]]]]}) (def: (with_default_source sources) (-> (Set //.Source) (Set //.Source)) @@ -36,6 +39,10 @@ (set.add //.default_source sources) sources)) +(def: with_default_repository + (-> (Set Address) (Set Address)) + (set.add //.default_repository)) + (def: #export test Test (<| (_.covering /._) @@ -50,12 +57,14 @@ _ (|> expected //format.profile %.code - (\ encoding.utf8 encode) + (\ utf8.codec encode) (!.use (\ file over_write))) actual (: (Promise (Try Profile)) (/.read promise.monad fs //.default))] (wrap (\ //.equivalence = - (update@ #//.sources ..with_default_source expected) + (|> expected + (update@ #//.sources ..with_default_source) + (update@ #//.repositories ..with_default_repository)) actual)))] (_.cover' [/.read] (try.default false verdict))))))) diff --git a/stdlib/source/test/lux/math.lux b/stdlib/source/test/lux/math.lux index 403205dad..3645ef1bf 100644 --- a/stdlib/source/test/lux/math.lux +++ b/stdlib/source/test/lux/math.lux @@ -1,15 +1,16 @@ (.module: [lux #* - ["%" data/text/format (#+ format)] ["_" test (#+ Test)] [abstract [monad (#+ do)]] + [macro + ["." template]] [math ["." random (#+ Random)] [number ["n" nat] - ["f" frac] - ["." int]]]] + ["i" int] + ["f" frac]]]] {1 ["." /]} ["." / #_ @@ -21,71 +22,136 @@ ["#/." continuous] ["#/." fuzzy]]]) -(def: margin +(def: margin_of_error +0.0000001) (def: (trigonometric_symmetry forward backward angle) (-> (-> Frac Frac) (-> Frac Frac) Frac Bit) (let [normal (|> angle forward backward)] - (|> normal forward backward (f.approximately? margin normal)))) + (|> normal forward backward (f.approximately? ..margin_of_error normal)))) (def: #export test Test - (<| (_.context (%.name (name_of /._))) + (<| (_.covering /._) ($_ _.and - (<| (_.context "Trigonometry") - (do {! random.monad} - [angle (|> random.safe_frac (\ ! map (f.* /.tau)))] - ($_ _.and - (_.test "Sine and arc-sine are inverse functions." - (trigonometric_symmetry /.sin /.asin angle)) - (_.test "Cosine and arc-cosine are inverse functions." - (trigonometric_symmetry /.cos /.acos angle)) - (_.test "Tangent and arc-tangent are inverse functions." - (trigonometric_symmetry /.tan /.atan angle)) - ))) - (<| (_.context "Rounding") - (do {! random.monad} - [sample (|> random.safe_frac (\ ! map (f.* +1000.0)))] - ($_ _.and - (_.test "The ceiling will be an integer value, and will be >= the original." - (let [ceil'd (/.ceil sample)] - (and (|> ceil'd f.int int.frac (f.= ceil'd)) - (f.>= sample ceil'd) - (f.<= +1.0 (f.- sample ceil'd))))) - (_.test "The floor will be an integer value, and will be <= the original." - (let [floor'd (/.floor sample)] - (and (|> floor'd f.int int.frac (f.= floor'd)) - (f.<= sample floor'd) - (f.<= +1.0 (f.- floor'd sample))))) - (_.test "The round will be an integer value, and will be < or > or = the original." - (let [round'd (/.round sample)] - (and (|> round'd f.int int.frac (f.= round'd)) - (f.<= +1.0 (f.abs (f.- sample round'd)))))) - ))) - (<| (_.context "Exponentials and logarithms") - (do {! random.monad} - [sample (|> random.safe_frac (\ ! map (f.* +10.0)))] - (_.test "Logarithm is the inverse of exponential." - (|> sample /.exp /.log (f.approximately? +0.000000000000001 sample))))) - (<| (_.context "Greatest-Common-Divisor and Least-Common-Multiple") - (do {! random.monad} - [#let [gen_nat (|> random.nat (\ ! map (|>> (n.% 1000) (n.max 1))))] - x gen_nat - y gen_nat] - ($_ _.and - (_.test "GCD" - (let [gcd (n.gcd x y)] - (and (n.= 0 (n.% gcd x)) - (n.= 0 (n.% gcd y)) - (n.>= 1 gcd)))) + (do {! random.monad} + [#let [~= (f.approximately? ..margin_of_error)] + angle (|> random.safe_frac (\ ! map (f.* /.tau)))] + ($_ _.and + (_.cover [/.sin /.asin] + (trigonometric_symmetry /.sin /.asin angle)) + (_.cover [/.cos /.acos] + (trigonometric_symmetry /.cos /.acos angle)) + (_.cover [/.tan /.atan] + (trigonometric_symmetry /.tan /.atan angle)) + (_.cover [/.tau] + (and (and (~= +0.0 (/.sin /.tau)) + (~= +1.0 (/.cos /.tau))) + (and (~= +0.0 (/.sin (f./ +2.0 /.tau))) + (~= -1.0 (/.cos (f./ +2.0 /.tau)))) + (and (~= +1.0 (/.sin (f./ +4.0 /.tau))) + (~= +0.0 (/.cos (f./ +4.0 /.tau)))) + (and (~= -1.0 (/.sin (f.* +3.0 (f./ +4.0 /.tau)))) + (~= +0.0 (/.cos (f.* +3.0 (f./ +4.0 /.tau))))) + (let [x2+y2 (f.+ (/.pow +2.0 (/.sin angle)) + (/.pow +2.0 (/.cos angle)))] + (~= +1.0 x2+y2)))) + (_.cover [/.pi] + (~= (f./ +2.0 /.tau) /.pi)) + )) + (do {! random.monad} + [sample (|> random.safe_frac (\ ! map (f.* +1000.0)))] + ($_ _.and + (_.cover [/.ceil] + (let [ceil'd (/.ceil sample)] + (and (|> ceil'd f.int i.frac (f.= ceil'd)) + (f.>= sample ceil'd) + (f.<= +1.0 (f.- sample ceil'd))))) + (_.cover [/.floor] + (let [floor'd (/.floor sample)] + (and (|> floor'd f.int i.frac (f.= floor'd)) + (f.<= sample floor'd) + (f.<= +1.0 (f.- floor'd sample))))) + (_.cover [/.round] + (let [round'd (/.round sample)] + (and (|> round'd f.int i.frac (f.= round'd)) + (f.<= +1.0 (f.abs (f.- sample round'd)))))) + )) + (do {! random.monad} + [#let [~= (f.approximately? ..margin_of_error)] + sample (\ ! map (f.* +10.0) random.safe_frac) + power (\ ! map (|>> (n.% 10) inc n.frac) random.nat)] + ($_ _.and + (_.cover [/.exp /.log] + (|> sample /.exp /.log (f.approximately? +0.000000000000001 sample))) + (_.cover [/.e] + (~= +1.0 (/.log /.e))) + (_.cover [/.pow /.log'] + (let [sample (f.abs sample)] + (|> sample + (/.pow power) + (/.log' sample) + (~= power)))) + )) + (do {! random.monad} + [#let [~= (f.approximately? ..margin_of_error)] + angle (\ ! map (f.* /.tau) random.safe_frac) + sample (\ ! map f.abs random.safe_frac) + big (\ ! map (f.* +1,000,000,000.00) random.safe_frac)] + (template.with [(odd! ) + [(_.cover [] + (~= (f.negate ( angle)) + ( (f.negate angle))))] - (_.test "LCM" - (let [lcm (n.lcm x y)] - (and (n.= 0 (n.% x lcm)) - (n.= 0 (n.% y lcm)) - (n.<= (n.* x y) lcm)))) - ))) + (even! ) + [(_.cover [] + (~= ( angle) + ( (f.negate angle))))] + + (inverse! ) + [(_.cover [ ] + (~= ( ) + ( (f./ +1.0))))]] + ($_ _.and + (odd! /.sinh) + (even! /.cosh) + (odd! /.tanh) + (odd! /.coth) + (even! /.sech) + (odd! /.csch) + + (inverse! /.acosh /.asech sample) + (inverse! /.asinh /.acsch sample) + (inverse! /.atanh /.acoth big) + ))) + (do {! random.monad} + [x (\ ! map (|>> (f.* +10.0) f.abs) random.safe_frac) + y (\ ! map (|>> (f.* +10.0) f.abs) random.safe_frac)] + (_.cover [/.hypotenuse] + (let [h (/.hypotenuse x y)] + (and (f.>= x h) + (f.>= y h))))) + (do {! random.monad} + [#let [~= (f.approximately? ..margin_of_error) + tau/4 (f./ +4.0 /.tau)] + x (\ ! map (f.* tau/4) random.safe_frac) + y (\ ! map (f.* tau/4) random.safe_frac)] + (_.cover [/.atan/2] + (let [expected (/.atan/2 x y) + actual (if (f.> +0.0 x) + (/.atan (f./ x y)) + (if (f.< +0.0 y) + (f.- /.pi (/.atan (f./ x y))) + (f.+ /.pi (/.atan (f./ x y)))))] + (and (~= expected actual) + (~= tau/4 (/.atan/2 +0.0 (f.abs y))) + (~= (f.negate tau/4) (/.atan/2 +0.0 (f.negate (f.abs y)))) + (f.not_a_number? (/.atan/2 +0.0 +0.0)))))) + (do {! random.monad} + [of (\ ! map (|>> (n.% 10) inc) random.nat)] + (_.cover [/.factorial] + (and (n.= 1 (/.factorial 0)) + (|> (/.factorial of) (n.% of) (n.= 0))))) /infix.test /modulus.test -- cgit v1.2.3