From f19f246aad0bce5449b89d5b0c7bb2596c9e1e41 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 22 Jan 2023 15:34:35 -0400 Subject: Simplified caching and JVM program JARs. --- stdlib/source/test/lux.lux | 8 +- .../lux/phase/translation/jvm/function/method.lux | 16 ++- .../jvm/function/method/implementation.lux | 110 +++++++++++++++++++++ .../lux/meta/compiler/meta/archive/signature.lux | 3 +- .../test/lux/meta/compiler/meta/archive/unit.lux | 12 ++- .../source/test/lux/meta/compiler/meta/cache.lux | 17 ++-- .../test/lux/meta/compiler/meta/cache/archive.lux | 14 ++- .../test/lux/meta/compiler/meta/cache/artifact.lux | 2 +- .../test/lux/meta/compiler/meta/cache/module.lux | 27 +++-- .../test/lux/meta/compiler/meta/cache/purge.lux | 11 +-- .../source/test/lux/world/time/series/average.lux | 8 +- 11 files changed, 174 insertions(+), 54 deletions(-) create mode 100644 stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/implementation.lux (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index a33a842f3..d0620d344 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -256,7 +256,7 @@ Test (do random.monad [example_nat random.nat] - (_.coverage [/.' /.literal_quote] + (_.coverage [/.' /.quote] (and (code#= (code.nat 0) (/.' 0)) (code#= (code.int -1) (/.' -1)) (code#= (code.rev .2) (/.' .2)) @@ -284,7 +284,7 @@ Test (do random.monad [example_nat random.nat] - (_.coverage [/.` /.syntax_quote] + (_.coverage [/.` /.complete_quote] (and (code#= (code.nat 0) (/.` 0)) (code#= (code.int -1) (/.` -1)) (code#= (code.rev .2) (/.` .2)) @@ -312,7 +312,7 @@ Test (do random.monad [example_nat random.nat] - (_.coverage [/.`' /.partial_quote] + (_.coverage [/.`' /.incomplete_quote] (and (code#= (code.nat 0) (/.`' 0)) (code#= (code.int -1) (/.`' -1)) (code#= (code.rev .2) (/.`' .2)) @@ -391,7 +391,7 @@ (/.` )) (code#= (/.`' ))))) - (_.coverage [/.,' /.literally] + (_.coverage [/.,' /.verbatim] (with_expansions [ (code.bit example_bit) (code.nat example_nat) (code.int example_int) diff --git a/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/function/method.lux b/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/function/method.lux index b8af5f99f..a1ab1b312 100644 --- a/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/function/method.lux +++ b/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/function/method.lux @@ -12,12 +12,20 @@ [compiler [target [jvm - ["[0]" modifier] - ["[0]" method]]]]] + ["[0]" modifier (.only Modifier)] + ["[0]" method (.only Method)]]]]] [test ["_" property (.only Test)]]]] [\\library - ["[0]" /]]) + ["[0]" /]] + ["[0]" / + ["[1][0]" implementation]]) + +(def (valid_modifier? it) + (-> (Modifier Method) + Bit) + (and (modifier.has? method.public it) + (modifier.has? method.strict it))) (def .public test Test @@ -28,4 +36,6 @@ (_.coverage [/.modifier] (and (modifier.has? method.public /.modifier) (modifier.has? method.strict /.modifier))) + + (/implementation.test valid_modifier?) ))) diff --git a/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/implementation.lux b/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/implementation.lux new file mode 100644 index 000000000..1c09977e9 --- /dev/null +++ b/stdlib/source/test/lux/meta/compiler/language/lux/phase/translation/jvm/function/method/implementation.lux @@ -0,0 +1,110 @@ +... This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +... If a copy of the MPL was not distributed with this file, You can obtain one at https://mozilla.org/MPL/2.0/. + +(.require + [library + [lux (.except) + ["[0]" ffi] + [abstract + [monad (.only do)]] + [control + ["[0]" io] + ["[0]" try (.use "[1]#[0]" functor)]] + [math + ["[0]" random (.only Random)] + [number + ["[0]" i64 (.use "[1]#[0]" equivalence)] + ["n" nat]]] + [meta + [compiler + [target + [jvm + ["[0]" modifier (.only Modifier)] + ["[0]" method (.only Method)] + ["[0]" type] + ["!" bytecode]]] + [meta + ["[0]" archive]]]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" / (.only) + [/// + [field + [constant + ["[0]" arity]]] + ["[0]" // (.only) + ["[0]" host] + ["[0]" runtime] + [/// + ["[0]" extension] + [// + ["[0]" phase] + ["[0]" synthesis] + ["[0]" translation]]]]]]] + [//// + ["[0]T" complex]]) + +(ffi.import (java/lang/Class of) + "[1]::[0]" + (getCanonicalName [] java/lang/String)) + +(ffi.import java/lang/Object + "[1]::[0]" + (getClass [] (java/lang/Class java/lang/Object))) + +(def .public (test valid_modifier?) + (-> (-> (Modifier Method) Bit) + Test) + (<| (_.covering /._) + (do [! random.monad] + [module (random.lower_cased 1) + + expected_i64 random.i64 + + .let [extender (is extension.Extender + (function (_ _) + (undefined))) + next (//.translate extender complexT.lux) + @ [module 0 0]] + + arity (of ! each (|>> (n.% (-- arity.maximum)) (n.+ 2)) random.nat) + inner_arity (of ! each (|>> (n.% arity) (n.+ 1)) random.nat)]) + (all _.and + (_.coverage [/.modifier] + (and (valid_modifier? /.modifier) + (modifier.has? method.static /.modifier))) + (_.coverage [/.name /.type /.method /.call] + (|> (do try.monad + [[_ archive] (archive.reserve "" archive.empty) + [_ archive] (archive.reserve module archive) + .let [[_ host] (io.run! host.host) + state (is runtime.State + (translation.state host module))]] + (<| (phase.result state) + (do phase.monad + [_ (translation.set_buffer translation.empty_buffer) + parameter (next archive (synthesis.i64 @ expected_i64)) + function (next archive (synthesis.function/abstraction @ [(list) 1 (synthesis.variable/local @ 1)])) + it (|> function + [{.#None}] + (of host evaluate) + phase.of_try) + .let [class (type.class (|> it + (as java/lang/Object) + java/lang/Object::getClass + java/lang/Class::getCanonicalName + ffi.of_string) + (list))]] + (in (|> (do !.monad + [_ function + _ parameter] + (/.call class 1)) + [{.#None}] + (of host evaluate) + (try#each (|>> (as I64) + (i64#= expected_i64))) + (try.else false) + ))))) + (try.else false))) + ))) diff --git a/stdlib/source/test/lux/meta/compiler/meta/archive/signature.lux b/stdlib/source/test/lux/meta/compiler/meta/archive/signature.lux index 3330970cd..ffba704ea 100644 --- a/stdlib/source/test/lux/meta/compiler/meta/archive/signature.lux +++ b/stdlib/source/test/lux/meta/compiler/meta/archive/signature.lux @@ -37,7 +37,8 @@ (def .public test Test (<| (_.covering /._) - (_.for [/.Signature]) + (_.for [/.Signature + /.#name /.#version]) (all _.and (_.for [/.equivalence] (equivalenceT.spec /.equivalence ..random)) diff --git a/stdlib/source/test/lux/meta/compiler/meta/archive/unit.lux b/stdlib/source/test/lux/meta/compiler/meta/archive/unit.lux index 0db6e238e..e77f7489b 100644 --- a/stdlib/source/test/lux/meta/compiler/meta/archive/unit.lux +++ b/stdlib/source/test/lux/meta/compiler/meta/archive/unit.lux @@ -5,11 +5,14 @@ [library [lux (.except) [abstract + [monad (.only do)] ["[0]" equivalence ["[1]T" \\test]] ["[0]" hash ["[1]T" \\test]]] [data + ["[0]" bit (.use "[1]#[0]" equivalence)] + ["[0]" text (.use "[1]#[0]" equivalence)] [collection ["[0]" set]]] [math @@ -29,7 +32,11 @@ (def .public test Test (<| (_.covering /._) - (_.for [/.ID]) + (do random.monad + [left ..random + right ..random]) + (_.for [/.ID + /.#module /.#artifact]) (all _.and (_.for [/.equivalence] (equivalenceT.spec /.equivalence ..random)) @@ -38,4 +45,7 @@ (_.coverage [/.none] (set.empty? /.none)) + (_.coverage [/.format] + (bit#= (of /.equivalence = left right) + (text#= (/.format left) (/.format right)))) ))) diff --git a/stdlib/source/test/lux/meta/compiler/meta/cache.lux b/stdlib/source/test/lux/meta/compiler/meta/cache.lux index 5d4d59ba4..c01794cc1 100644 --- a/stdlib/source/test/lux/meta/compiler/meta/cache.lux +++ b/stdlib/source/test/lux/meta/compiler/meta/cache.lux @@ -25,24 +25,21 @@ ["[1][0]" artifact] ["[1][0]" purge] ["[1][0]" dependency - ["[1]/[0]" module]] - ["$/[1]" // - ["[1][0]" context]]]) + ["[1]/[0]" module]]]) (def .public test Test (<| (_.covering /._) (do [! random.monad] - [context $//context.random - .let [/ "/" + [.let [/ "/" fs (file.mock /)]] (all _.and (in (do [! async.monad] - [pre/0 (of fs directory? (/.path fs context)) - pre/1 (/.enabled? fs context) - outcome (/.enable! ! fs context) - post/0 (of fs directory? (/.path fs context)) - post/1 (/.enabled? fs context)] + [pre/0 (of fs directory? /.path) + pre/1 (/.enabled? fs) + outcome (/.enable! ! fs) + post/0 (of fs directory? /.path) + post/1 (/.enabled? fs)] (unit.coverage [/.path /.enabled? /.enable!] (and (not pre/0) (not pre/1) diff --git a/stdlib/source/test/lux/meta/compiler/meta/cache/archive.lux b/stdlib/source/test/lux/meta/compiler/meta/cache/archive.lux index 38ed57d7a..61d35ef1d 100644 --- a/stdlib/source/test/lux/meta/compiler/meta/cache/archive.lux +++ b/stdlib/source/test/lux/meta/compiler/meta/cache/archive.lux @@ -35,7 +35,6 @@ ["[0]" document]]]]]]] ["$" // [// - ["[1][0]" context] ["[1][0]" archive (.only) ["[2][0]" signature]] [/// @@ -45,8 +44,7 @@ Test (<| (_.covering /._) (do [! random.monad] - [context $context.random - .let [/ "/" + [.let [/ "/" fs (file.mock /)] module/0 (random.lower_cased 1) module/1 (random.lower_cased 2) @@ -75,11 +73,11 @@ try.trusted)]] (all _.and (in (do [! async.monad] - [pre/0 (of fs file? (/.descriptor fs context)) - enabled? (//.enable! ! fs context) - cached? (/.cache! fs configuration context archive) - actual (of fs read (/.descriptor fs context)) - post/0 (of fs file? (/.descriptor fs context))] + [pre/0 (of fs file? (/.descriptor fs)) + enabled? (//.enable! ! fs) + cached? (/.cache! fs configuration archive) + actual (of fs read (/.descriptor fs)) + post/0 (of fs file? (/.descriptor fs))] (unit.coverage [/.descriptor /.cache!] (and (not pre/0) (|> (do try.monad diff --git a/stdlib/source/test/lux/meta/compiler/meta/cache/artifact.lux b/stdlib/source/test/lux/meta/compiler/meta/cache/artifact.lux index 9c3d95663..5a3083614 100644 --- a/stdlib/source/test/lux/meta/compiler/meta/cache/artifact.lux +++ b/stdlib/source/test/lux/meta/compiler/meta/cache/artifact.lux @@ -42,7 +42,7 @@ (all _.and (in (do [! async.monad] [pre (of fs file? (/.path fs context @module @artifact)) - _ (//module.enable! ! fs context @module) + _ (//module.enable! ! fs @module) write! (/.cache! fs context @module @artifact expected) post (of fs file? (/.path fs context @module @artifact)) read! (/.cache fs context @module @artifact)] diff --git a/stdlib/source/test/lux/meta/compiler/meta/cache/module.lux b/stdlib/source/test/lux/meta/compiler/meta/cache/module.lux index bdf4b01fe..98cf9da8f 100644 --- a/stdlib/source/test/lux/meta/compiler/meta/cache/module.lux +++ b/stdlib/source/test/lux/meta/compiler/meta/cache/module.lux @@ -19,9 +19,7 @@ ["[0]" unit] ["_" property (.only Test)]]]] [\\library - ["[0]" /]] - ["$[0]" /// - ["[1][0]" context]]) + ["[0]" /]]) (`` (def (bad it) (-> (file.System Async) (file.System Async)) @@ -54,17 +52,16 @@ Test (<| (_.covering /._) (do [! random.monad] - [context $///context.random - @module random.nat] + [@module random.nat] (all _.and (in (do [! async.monad] [.let [/ "/" fs (file.mock /)] - pre/0 (of fs directory? (/.path fs context @module)) - pre/1 (/.enabled? fs context @module) - outcome (/.enable! ! fs context @module) - post/0 (of fs directory? (/.path fs context @module)) - post/1 (/.enabled? fs context @module)] + pre/0 (of fs directory? (/.path fs @module)) + pre/1 (/.enabled? fs @module) + outcome (/.enable! ! fs @module) + post/0 (of fs directory? (/.path fs @module)) + post/1 (/.enabled? fs @module)] (unit.coverage [/.path /.enabled? /.enable!] (and (not pre/0) (not pre/1) @@ -78,11 +75,11 @@ (in (do [! async.monad] [.let [/ "/" fs (file.mock /)] - pre/0 (of fs directory? (/.path fs context @module)) - pre/1 (/.enabled? fs context @module) - outcome (/.enable! ! (..bad fs) context @module) - post/0 (of fs directory? (/.path fs context @module)) - post/1 (/.enabled? fs context @module)] + pre/0 (of fs directory? (/.path fs @module)) + pre/1 (/.enabled? fs @module) + outcome (/.enable! ! (..bad fs) @module) + post/0 (of fs directory? (/.path fs @module)) + post/1 (/.enabled? fs @module)] (unit.coverage [/.cannot_enable] (and (not pre/0) (not pre/1) diff --git a/stdlib/source/test/lux/meta/compiler/meta/cache/purge.lux b/stdlib/source/test/lux/meta/compiler/meta/cache/purge.lux index e3d3cc5c8..e18c56e05 100644 --- a/stdlib/source/test/lux/meta/compiler/meta/cache/purge.lux +++ b/stdlib/source/test/lux/meta/compiler/meta/cache/purge.lux @@ -36,8 +36,6 @@ ["[0]" dependency ["[1]" module]] ["/[1]" // - ["[0]" context (.only) - ["$[1]" \\test]] ["[0]" archive (.only) ["[0]" registry] ["[0]" module (.only) @@ -67,8 +65,7 @@ ////.#hash (the descriptor.#hash descriptor) ////.#code source_code] / "/" - fs (file.mock /)] - context $context.random] + fs (file.mock /)]] (all _.and (_.for [/.Cache] (all _.and @@ -120,14 +117,14 @@ (and (dictionary.key? (/.purge cache order) name/0) (dictionary.key? (/.purge cache order) name/1))))))) (in (do [! async.monad] - [_ (//module.enable! ! fs context id/0) - .let [dir (//module.path fs context id/0) + [_ (//module.enable! ! fs id/0) + .let [dir (//module.path fs id/0) file/0 (%.format dir / name/0) file/1 (%.format dir / name/1)] _ (of fs write file/0 content/0) _ (of fs write file/1 content/1) pre (of fs directory_files dir) - _ (/.purge! fs context id/0) + _ (/.purge! fs id/0) post (of fs directory_files dir)] (unit.coverage [/.purge!] (<| (try.else false) diff --git a/stdlib/source/test/lux/world/time/series/average.lux b/stdlib/source/test/lux/world/time/series/average.lux index fc5843ca6..32955cba6 100644 --- a/stdlib/source/test/lux/world/time/series/average.lux +++ b/stdlib/source/test/lux/world/time/series/average.lux @@ -57,7 +57,7 @@ Test (<| (_.covering /._) (do [! random.monad] - [expected_events (of ! each (|>> (n.% 9) (n.+ 2)) random.nat) + [expected_events (of ! each (|>> (n.% 16) (n.+ 8)) random.nat) input (series expected_events) additional (of ! each (n.% expected_events) random.nat)]) (all _.and @@ -110,9 +110,9 @@ (well_windowed? input additional weighted)) all_are_different! - (and (not (//#= exponential simple)) - (not (//#= exponential weighted)) - (not (//#= simple weighted)))]] + (not (or (//#= exponential simple) + (//#= exponential weighted) + (//#= simple weighted)))]] (in (and all_are_well_windowed! all_are_different!))))) )) -- cgit v1.2.3