From 2c99b4515447315d76a8dc203a2dbcafc09506ea Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 17 Jul 2021 01:48:49 -0400 Subject: Now properly loading cached modules. --- stdlib/source/library/lux.lux | 13 +- .../library/lux/control/concurrency/actor.lux | 5 +- stdlib/source/library/lux/data/bit.lux | 8 + stdlib/source/library/lux/data/collection/tree.lux | 10 +- .../lux/phase/generation/python/runtime.lux | 4 + .../lux/tool/compiler/language/lux/syntax.lux | 20 +- .../library/lux/tool/compiler/meta/archive.lux | 26 +- .../library/lux/tool/compiler/meta/io/archive.lux | 79 ++-- stdlib/source/library/lux/world/file.lux | 46 +- stdlib/source/program/aedifex/command/test.lux | 25 +- stdlib/source/program/aedifex/runtime.lux | 3 +- stdlib/source/test/aedifex/artifact.lux | 9 +- stdlib/source/test/aedifex/artifact/time/date.lux | 36 +- stdlib/source/test/aedifex/artifact/type.lux | 4 +- stdlib/source/test/aedifex/command/auto.lux | 2 + stdlib/source/test/aedifex/command/build.lux | 10 +- stdlib/source/test/lux.lux | 517 +++++++++++++++++---- stdlib/source/test/lux/data/bit.lux | 6 + stdlib/source/test/lux/ffi.old.lux | 7 +- stdlib/source/test/lux/macro/code.lux | 101 ++-- 20 files changed, 660 insertions(+), 271 deletions(-) (limited to 'stdlib') diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index 6d1f82632..4d3141587 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -5903,14 +5903,13 @@ _ (fail (..wrong_syntax_error (name_of ..^code))))) -(template [ ] - [(def: #export #0) - (def: #export #1)] +(def: #export false + Bit + #0) - [false true] - [no yes] - [off on] - ) +(def: #export true + Bit + #1) (macro: #export (:let tokens) (case tokens diff --git a/stdlib/source/library/lux/control/concurrency/actor.lux b/stdlib/source/library/lux/control/concurrency/actor.lux index a12e65471..78ed99765 100644 --- a/stdlib/source/library/lux/control/concurrency/actor.lux +++ b/stdlib/source/library/lux/control/concurrency/actor.lux @@ -12,6 +12,7 @@ ["<>" parser ["<.>" code (#+ Parser)]]] [data + ["." bit] ["." product] [text ["%" format (#+ format)]] @@ -113,10 +114,10 @@ promise.poll (\ io.functor map (|>> (case> #.None - yes + bit.yes _ - no)))))) + bit.no)))))) (def: #export (obituary actor) (All [s] (-> (Actor s) (IO (Maybe (Obituary s))))) diff --git a/stdlib/source/library/lux/data/bit.lux b/stdlib/source/library/lux/data/bit.lux index 5a62ecce5..05d419b8f 100644 --- a/stdlib/source/library/lux/data/bit.lux +++ b/stdlib/source/library/lux/data/bit.lux @@ -9,6 +9,14 @@ [control ["." function]]]]) +(template [ ] + [(def: #export Bit #0) + (def: #export Bit #1)] + + [no yes] + [off on] + ) + (implementation: #export equivalence (Equivalence Bit) diff --git a/stdlib/source/library/lux/data/collection/tree.lux b/stdlib/source/library/lux/data/collection/tree.lux index 6ed986476..045b176c6 100644 --- a/stdlib/source/library/lux/data/collection/tree.lux +++ b/stdlib/source/library/lux/data/collection/tree.lux @@ -8,7 +8,7 @@ [monad (#+ do)]] [control ["<>" parser - ["" code (#+ Parser)]]] + ["<.>" code (#+ Parser)]]] [data [collection ["." list ("#\." monad fold)]]] @@ -41,13 +41,13 @@ (def: tree^ (Parser Tree_Code) (|> (|>> <>.some - .record - (<>.and .any)) + .record + (<>.and .any)) <>.rec <>.some - .record + .record (<>.default (list)) - (<>.and .any))) + (<>.and .any))) (syntax: #export (tree {root tree^}) {#.doc (doc "Tree literals." diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux index 1b7c4310c..7a19539df 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/python/runtime.lux @@ -188,6 +188,10 @@ (runtime: (io::log! message) ($_ _.then (_.print message) + (|> (_.__import__/1 (_.unicode "sys")) + (_.the "stdout") + (_.do "flush" (list)) + _.statement) (_.return ..unit))) (runtime: (io::throw! message) diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/syntax.lux b/stdlib/source/library/lux/tool/compiler/language/lux/syntax.lux index e41cd0f79..de266d0ad 100644 --- a/stdlib/source/library/lux/tool/compiler/language/lux/syntax.lux +++ b/stdlib/source/library/lux/tool/compiler/language/lux/syntax.lux @@ -483,17 +483,24 @@ (with_expansions [ (as_is where (!inc offset/0) source_code) (as_is [(!forward 1 where) (!inc offset/0) source_code]) (as_is [(!forward 1 where) (!inc/2 offset/0) source_code]) - (as_is (parse current_module aliases source_code//size)) - (as_is (recur (!horizontal where offset/0 source_code)))] + (as_is (parse current_module aliases source_code//size))] (template: (!close closer) (#.Left [ closer])) + + (def: (bit_syntax value [where offset/0 source_code]) + (-> Bit (Parser Code)) + (#.Right [[(update@ #.column (|>> !inc/2) where) + (!inc/2 offset/0) + source_code] + [where (#.Bit value)]])) (def: #export (parse current_module aliases source_code//size) (-> Text Aliases Nat (Parser Code)) ## The "exec []" is only there to avoid function fusion. ## This is to preserve the loop as much as possible and keep it tight. - (exec [] + (exec + [] (function (recur [where offset/0 source_code]) (<| (!with_char+ source_code//size source_code offset/0 char/0 (!end_of_file where offset/0 source_code current_module)) @@ -511,7 +518,7 @@ (`` ("lux syntax char case!" char/0 [[(~~ (static text.space)) (~~ (static text.carriage_return))] - + (recur (!horizontal where offset/0 source_code)) ## New line [(~~ (static text.new_line))] @@ -543,10 +550,7 @@ (~~ (template [ ] [[] - (#.Right [[(update@ #.column (|>> !inc/2) where) - (!inc offset/1) - source_code] - [where (#.Bit )]])] + (..bit_syntax [where offset/0 source_code])] ["0" #0] ["1" #1]))] diff --git a/stdlib/source/library/lux/tool/compiler/meta/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/archive.lux index d04f1227f..735e315c5 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/archive.lux @@ -9,9 +9,10 @@ ["." exception (#+ exception:)] ["." function] ["<>" parser - ["" binary (#+ Parser)]]] + ["<.>" binary (#+ Parser)]]] [data [binary (#+ Binary)] + ["." bit] ["." product] ["." name] ["." text @@ -149,10 +150,10 @@ (-> Archive Module Bit) (case (..find module archive) (#try.Success _) - yes + bit.yes (#try.Failure _) - no)) + bit.no)) (def: #export archived (-> Archive (List Module)) @@ -169,10 +170,10 @@ (let [(^slots [#..resolver]) (:representation archive)] (case (dictionary.get module resolver) (#.Some [id _]) - yes + bit.yes #.None - no))) + bit.no))) (def: #export reserved (-> Archive (List Module)) @@ -206,15 +207,18 @@ (dictionary.entries +resolver)))) :abstraction))) - (type: Reservation [Module ID]) - (type: Frozen [Version ID (List Reservation)]) + (type: Reservation + [Module ID]) + + (type: Frozen + [Version ID (List Reservation)]) (def: reader (Parser ..Frozen) ($_ <>.and - .nat - .nat - (.list (<>.and .text .nat)))) + .nat + .nat + (.list (<>.and .text .nat)))) (def: writer (Writer ..Frozen) @@ -266,7 +270,7 @@ (def: #export (import expected binary) (-> Version Binary (Try Archive)) (do try.monad - [[actual next reservations] (.run ..reader binary) + [[actual next reservations] (.run ..reader binary) _ (exception.assert ..version_mismatch [expected actual] (n\= expected actual)) _ (exception.assert ..corrupt_data [] diff --git a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux index b5ed4b84b..0b7a54a34 100644 --- a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux +++ b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux @@ -213,20 +213,22 @@ (def: (loaded_document extension host module_id expected actual document) (All [expression directive] (-> Text (generation.Host expression directive) archive.ID (Row Artifact) (Dictionary Text Binary) (Document .Module) - (Try [(Document .Module) Bundles]))) + (Try [(Document .Module) Bundles Output]))) (do {! try.monad} - [[definitions bundles] (: (Try [Definitions Bundles]) + [[definitions bundles] (: (Try [Definitions Bundles Output]) (loop [input (row.to_list expected) definitions (: Definitions (dictionary.new text.hash)) - bundles ..empty_bundles] + bundles ..empty_bundles + output (: Output row.empty)] (let [[analysers synthesizers generators directives] bundles] (case input (#.Cons [[artifact_id artifact_category] input']) (case (do ! [data (try.from_maybe (dictionary.get (format (%.nat artifact_id) extension) actual)) #let [context [module_id artifact_id] - directive (\ host ingest context data)]] + directive (\ host ingest context data) + output (row.add [artifact_id data] output)]] (case artifact_category #artifact.Anonymous (do ! @@ -235,7 +237,8 @@ [analysers synthesizers generators - directives]])) + directives] + output])) (#artifact.Definition name) (if (text\= $/program.name name) @@ -243,14 +246,16 @@ [analysers synthesizers generators - directives]]) + directives] + output]) (do ! [value (\ host re_load context directive)] (wrap [(dictionary.put name value definitions) [analysers synthesizers generators - directives]]))) + directives] + output]))) (#artifact.Analyser extension) (do ! @@ -259,7 +264,8 @@ [(dictionary.put extension (:as analysis.Handler value) analysers) synthesizers generators - directives]])) + directives] + output])) (#artifact.Synthesizer extension) (do ! @@ -268,7 +274,8 @@ [analysers (dictionary.put extension (:as synthesis.Handler value) synthesizers) generators - directives]])) + directives] + output])) (#artifact.Generator extension) (do ! @@ -277,7 +284,8 @@ [analysers synthesizers (dictionary.put extension (:as generation.Handler value) generators) - directives]])) + directives] + output])) (#artifact.Directive extension) (do ! @@ -286,15 +294,16 @@ [analysers synthesizers generators - (dictionary.put extension (:as directive.Handler value) directives)]])))) - (#try.Success [definitions' bundles']) - (recur input' definitions' bundles') + (dictionary.put extension (:as directive.Handler value) directives)] + output])))) + (#try.Success [definitions' bundles' output']) + (recur input' definitions' bundles' output') failure failure) - #.None - (#try.Success [definitions bundles]))))) + #.Nil + (#try.Success [definitions bundles output]))))) content (document.read $.key document) definitions (monad.map ! (function (_ [def_name def_global]) (case def_global @@ -302,23 +311,26 @@ (wrap [def_name (#.Alias alias)]) (#.Definition [exported? type annotations _]) - (do ! - [value (try.from_maybe (dictionary.get def_name definitions))] - (wrap [def_name (#.Definition [exported? type annotations value])])))) + (|> definitions + (dictionary.get def_name) + try.from_maybe + (\ ! map (|>> [exported? type annotations] + #.Definition + [def_name]))))) (get@ #.definitions content))] (wrap [(document.write $.key (set@ #.definitions definitions content)) bundles]))) -(def: (load_definitions fs static module_id host_environment [descriptor document output]) +(def: (load_definitions fs static module_id host_environment descriptor document) (All [expression directive] (-> (file.System Promise) Static archive.ID (generation.Host expression directive) - [Descriptor (Document .Module) Output] + Descriptor (Document .Module) (Promise (Try [[Descriptor (Document .Module) Output] Bundles])))) (do (try.with promise.monad) [actual (cached_artifacts fs static module_id) #let [expected (|> descriptor (get@ #descriptor.registry) artifact.artifacts)] - [document bundles] (promise\wrap (loaded_document (get@ #static.artifact_extension static) host_environment module_id expected actual document))] + [document bundles output] (promise\wrap (loaded_document (get@ #static.artifact_extension static) host_environment module_id expected actual document))] (wrap [[descriptor document output] bundles]))) (def: (purge! fs static [module_name module_id]) @@ -344,7 +356,7 @@ (Dictionary Module archive.ID)) (def: initial_purge - (-> (List [Bit [Module [archive.ID [Descriptor (Document .Module) Output]]]]) + (-> (List [Bit [Module [archive.ID [Descriptor (Document .Module)]]]]) Purge) (|>> (list.all (function (_ [valid_cache? [module_name [module_id _]]]) (if valid_cache? @@ -353,10 +365,10 @@ (dictionary.from_list text.hash))) (def: (full_purge caches load_order) - (-> (List [Bit [Module [archive.ID [Descriptor (Document .Module) Output]]]]) + (-> (List [Bit [Module [archive.ID [Descriptor (Document .Module)]]]]) dependency.Order Purge) - (list\fold (function (_ [module_name [module_id [descriptor document output]]] purge) + (list\fold (function (_ [module_name [module_id [descriptor document]]] purge) (let [purged? (: (Predicate Module) (dictionary.key? purge))] (if (purged? module_name) @@ -387,16 +399,16 @@ [descriptor document] (promise\wrap (.run ..parser data))] (if (text\= archive.runtime_module module_name) (wrap [true - [module_name [module_id [descriptor document (: Output row.empty)]]]]) + [module_name [module_id [descriptor document]]]]) (do ! [input (//context.read fs ..pseudo_module import contexts (get@ #static.host_module_extension static) module_name)] (wrap [(..valid_cache? descriptor input) - [module_name [module_id [descriptor document (: Output row.empty)]]]]))))))) + [module_name [module_id [descriptor document]]]]))))))) load_order (|> pre_loaded_caches (list\map product.right) (monad.fold try.monad - (function (_ [module [module_id descriptor,document,output]] archive) - (archive.add module descriptor,document,output archive)) + (function (_ [module [module_id [descriptor document]]] archive) + (archive.add module [descriptor document (: Output row.empty)] archive)) archive) (\ try.monad map (dependency.load_order $.key)) (\ try.monad join) @@ -406,18 +418,17 @@ dictionary.entries (monad.map ! (..purge! fs static))) loaded_caches (|> load_order - (list.filter (function (_ [module_name [module_id [descriptor document output]]]) - (not (dictionary.key? purge module_name)))) - (monad.map ! (function (_ [module_name [module_id descriptor,document,output]]) + (list.filter (|>> product.left (dictionary.key? purge) not)) + (monad.map ! (function (_ [module_name [module_id [descriptor document _]]]) (do ! - [[descriptor,document,output bundles] (..load_definitions fs static module_id host_environment descriptor,document,output)] + [[descriptor,document,output bundles] (..load_definitions fs static module_id host_environment descriptor document)] (wrap [[module_name descriptor,document,output] bundles])))))] (promise\wrap (do {! try.monad} [archive (monad.fold ! - (function (_ [[module descriptor,document] _bundle] archive) - (archive.add module descriptor,document archive)) + (function (_ [[module descriptor,document,output] _bundle] archive) + (archive.add module descriptor,document,output archive)) archive loaded_caches) analysis_state (..analysis_state (get@ #static.host static) archive)] diff --git a/stdlib/source/library/lux/world/file.lux b/stdlib/source/library/lux/world/file.lux index 7f95b3282..3a7b4463d 100644 --- a/stdlib/source/library/lux/world/file.lux +++ b/stdlib/source/library/lux/world/file.lux @@ -153,15 +153,6 @@ [cannot_read_all_data] ) -(with_expansions [ (as_is (exception: #export (cannot_move {target Path} {source Path}) - (exception.report - ["Source" source] - ["Target" target])))] - (for {@.old (as_is ) - @.jvm (as_is ) - @.lua (as_is )} - (as_is))) - (with_expansions [ (as_is (exception: #export (cannot_modify_file {instant Instant} {file Path}) (exception.report ["Instant" (%.instant instant)] @@ -336,7 +327,7 @@ (accessSync [ffi.String ffi.Number] #io #try Any) (renameSync [ffi.String ffi.String] #io #try Any) (utimesSync [ffi.String ffi.Number ffi.Number] #io #try Any) - (unlink [ffi.String] #io #try Any) + (unlinkSync [ffi.String] #io #try Any) (readdirSync [ffi.String] #io #try (Array ffi.String)) (mkdirSync [ffi.String] #io #try Any) (rmdirSync [ffi.String] #io #try Any)]) @@ -375,13 +366,16 @@ [node_path "path" ..JsPath] ) + (def: js_separator + (if ffi.on_node_js? + (JsPath::sep (..node_path [])) + "/")) + (`` (implementation: #export default (System IO) (def: separator - (if ffi.on_node_js? - (JsPath::sep (..node_path [])) - "/")) + ..js_separator) (~~ (template [ ] [(def: ( path) @@ -418,6 +412,7 @@ subs (Fs::readdirSync [path] node_fs)] (|> subs array.to_list + (list\map (|>> (format path ..js_separator))) (monad.map ! (function (_ sub) (do ! [stats (Fs::statSync [sub] node_fs)] @@ -465,7 +460,7 @@ stats (Fs::statSync [path] node_fs) verdict (Stats::isFile [] stats)] (if verdict - (Fs::unlink [path] node_fs) + (Fs::unlinkSync [path] node_fs) (Fs::rmdirSync [path] node_fs)))) (def: (modify time_stamp path) @@ -520,11 +515,14 @@ (#static getsize [ffi.String] #io #try ffi.Integer) (#static getmtime [ffi.String] #io #try ffi.Float)]) + (def: python_separator + (os/path::sep)) + (`` (implementation: #export default (System IO) (def: separator - (os/path::sep)) + ..python_separator) (~~ (template [ ] [(def: @@ -539,15 +537,17 @@ os::mkdir) (~~ (template [ ] - [(def: + [(def: ( path) (let [! (try.with io.monad)] - (|>> os::listdir - (\ ! map (|>> array.to_list - (monad.map ! (function (_ sub) - (\ ! map (|>> [sub]) ( [sub])))) - (\ ! map (|>> (list.filter product.right) - (list\map product.left))))) - (\ ! join))))] + (|> path + os::listdir + (\ ! map (|>> array.to_list + (list\map (|>> (format path ..python_separator))) + (monad.map ! (function (_ sub) + (\ ! map (|>> [sub]) ( [sub])))) + (\ ! map (|>> (list.filter product.right) + (list\map product.left))))) + (\ ! join))))] [directory_files os/path::isfile] [sub_directories os/path::isdir] diff --git a/stdlib/source/program/aedifex/command/test.lux b/stdlib/source/program/aedifex/command/test.lux index 15f8d6f22..65f2bdc4e 100644 --- a/stdlib/source/program/aedifex/command/test.lux +++ b/stdlib/source/program/aedifex/command/test.lux @@ -6,9 +6,6 @@ [control [concurrency ["." promise (#+ Promise) ("#\." monad)]]] - [data - [text - ["%" format (#+ format)]]] [math [number ["i" int]]] @@ -42,19 +39,19 @@ (if (i.= shell.normal build_exit) (do ! [_ (console.write_line ..start console) - #let [[compiler_command compiler_parameters] (case compiler - (^template [ ] - [( artifact) - (///runtime.for (get@ profile) program)]) - ([#//build.JVM #///.java] - [#//build.JS #///.js] - [#//build.Python #///.python] - [#//build.Lua #///.lua] - [#//build.Ruby #///.ruby]))] + #let [[test_command test_parameters] (case compiler + (^template [ ] + [( artifact) + (///runtime.for (get@ profile) program)]) + ([#//build.JVM #///.java] + [#//build.JS #///.js] + [#//build.Python #///.python] + [#//build.Lua #///.lua] + [#//build.Ruby #///.ruby]))] process (\ shell execute [environment working_directory - compiler_command - compiler_parameters]) + test_command + test_parameters]) _ (//build.log_output! console process) _ (//build.log_error! console process) exit (\ process await []) diff --git a/stdlib/source/program/aedifex/runtime.lux b/stdlib/source/program/aedifex/runtime.lux index f5aeef36a..e6b61d360 100644 --- a/stdlib/source/program/aedifex/runtime.lux +++ b/stdlib/source/program/aedifex/runtime.lux @@ -34,7 +34,8 @@ [default_js "node" ["--stack_size=8192"]] [default_python "python3" []] [default_lua "lua" []] - [default_ruby "RUBY_THREAD_VM_STACK_SIZE=15700000 ruby" []] + ## [default_ruby "RUBY_THREAD_VM_STACK_SIZE=15700000 ruby" []] + [default_ruby "ruby" []] ) (def: #export (for runtime path) diff --git a/stdlib/source/test/aedifex/artifact.lux b/stdlib/source/test/aedifex/artifact.lux index ce0af7e7f..9152a3d22 100644 --- a/stdlib/source/test/aedifex/artifact.lux +++ b/stdlib/source/test/aedifex/artifact.lux @@ -31,10 +31,11 @@ (def: #export random (Random /.Artifact) - ($_ random.and - (random.ascii/alpha 1) - (random.ascii/alpha 1) - (random.ascii/alpha 1))) + (let [size 4] + ($_ random.and + (random.ascii/lower size) + (random.ascii/lower size) + (random.ascii/lower size)))) (def: #export test Test diff --git a/stdlib/source/test/aedifex/artifact/time/date.lux b/stdlib/source/test/aedifex/artifact/time/date.lux index e68645b8a..35ae3a157 100644 --- a/stdlib/source/test/aedifex/artifact/time/date.lux +++ b/stdlib/source/test/aedifex/artifact/time/date.lux @@ -3,9 +3,12 @@ [lux #* ["_" test (#+ Test)] [abstract - [monad (#+ do)]] + [monad (#+ do)] + [\\specification + ["$." equivalence]]] [control ["." try ("#\." functor)] + ["." exception] [parser ["<.>" text]]] [math @@ -14,7 +17,7 @@ ["n" nat] ["i" int]]] [time - ["." date] + ["." date ("#\." equivalence)] ["." year]]]] [\\program ["." /]]) @@ -35,13 +38,32 @@ Test (<| (_.covering /._) (_.for [/.Date]) - ($_ _.and - (do random.monad - [expected ..random] + (do random.monad + [expected ..random + candidate random.date] + ($_ _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.cover [/.format /.parser] (|> expected /.format (.run /.parser) (try\map (\ /.equivalence = expected)) - (try.default false)))) - ))) + (try.default false))) + (_.cover [/.value /.date] + (|> expected + /.value + /.date + (try\map (\ /.equivalence = expected)) + (try.default false))) + (_.cover [/.year_is_out_of_range] + (case (/.date candidate) + (#try.Success date) + (is? candidate (/.value date)) + + (#try.Failure error) + (exception.match? /.year_is_out_of_range error))) + (_.cover [/.epoch] + (date\= date.epoch (/.value /.epoch))) + )))) diff --git a/stdlib/source/test/aedifex/artifact/type.lux b/stdlib/source/test/aedifex/artifact/type.lux index 8418febee..93a13e26a 100644 --- a/stdlib/source/test/aedifex/artifact/type.lux +++ b/stdlib/source/test/aedifex/artifact/type.lux @@ -33,9 +33,9 @@ (<| (_.covering /._) (_.for [/.Type] ($_ _.and - (_.cover [/.lux_library /.jvm_library + (_.cover [/.lux_library /.jvm_library /.js_library /.pom /.md5 /.sha-1] - (let [options (list /.lux_library /.jvm_library + (let [options (list /.lux_library /.jvm_library /.js_library /.pom /.md5 /.sha-1) uniques (set.from_list text.hash options)] (n.= (list.size options) diff --git a/stdlib/source/test/aedifex/command/auto.lux b/stdlib/source/test/aedifex/command/auto.lux index 8539ce672..a7ea2795b 100644 --- a/stdlib/source/test/aedifex/command/auto.lux +++ b/stdlib/source/test/aedifex/command/auto.lux @@ -93,6 +93,8 @@ dummy_path (\ ! map (|>> (format source /)) (random.ascii/alpha 5)) [compiler resolution] $build.resolution] ($_ _.and + (_.cover [/.delay] + (n.> 0 /.delay)) (wrap (do promise.monad [verdict (do ///action.monad [_ (\ fs make_directory source) diff --git a/stdlib/source/test/aedifex/command/build.lux b/stdlib/source/test/aedifex/command/build.lux index a702d4c3d..1292c232f 100644 --- a/stdlib/source/test/aedifex/command/build.lux +++ b/stdlib/source/test/aedifex/command/build.lux @@ -158,8 +158,14 @@ (wrap (and (text\= /.start start) (text\= /.success end))))] (_.cover' [/.do! - /.lux_group /.jvm_compiler_name /.js_compiler_name - /.start /.success] + /.lux_group + /.jvm_compiler_name + /.js_compiler_name + /.python_compiler_name + /.lua_compiler_name + /.ruby_compiler_name + /.start + /.success] (try.default false verdict))))) (do ! [#let [console (@version.echo "")] diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index f1af7f5a5..26924ef8e 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -8,6 +8,7 @@ [program (#+ program:)] ["_" test (#+ Test)] ["@" target] + ["." meta] [abstract [monad (#+ do)] [predicate (#+ Predicate)]] @@ -16,9 +17,11 @@ [concurrency ["." atom (#+ Atom)]]] [data - ["." name] - [text + ["." bit ("#\." equivalence)] + ["." text ("#\." equivalence) ["%" format (#+ format)]]] + [macro + ["." code ("#\." equivalence)]] ["." math ["." random (#+ Random) ("#\." functor)] [number @@ -72,52 +75,6 @@ (not (is? self other)))) ))) -(def: increment_and_decrement - Test - (do random.monad - [value random.i64] - ($_ _.and - (_.test "'inc' and 'dec' are opposites." - (and (|> value inc dec (n.= value)) - (|> value dec inc (n.= value)))) - (_.test "'inc' and 'dec' shift the number by 1." - (and (|> (inc value) (n.- value) (n.= 1)) - (|> value (n.- (dec value)) (n.= 1))))))) - -(def: (check_neighbors has_property? value) - (All [a] (-> (Predicate (I64 a)) (I64 a) Bit)) - (and (|> value inc has_property?) - (|> value dec has_property?))) - -(def: (even_or_odd rand_gen even? odd?) - (All [a] (-> (Random (I64 a)) (Predicate (I64 a)) (Predicate (I64 a)) Test)) - (do random.monad - [value rand_gen] - ($_ _.and - (_.test "Every number is either even or odd." - (if (even? value) - (not (odd? value)) - (odd? value))) - (_.test "Every odd/even number is surrounded by two of the other kind." - (if (even? value) - (check_neighbors odd? value) - (check_neighbors even? value)))))) - -(type: (Equivalence a) - (-> a a Bit)) - -(def: (conversion rand_gen forward backward =) - (All [a b] (-> (Random a) (-> a b) (-> b a) (Equivalence a) Test)) - (do random.monad - [value rand_gen] - (_.test "Can convert between types in a lossless way." - (|> value forward backward (= value))))) - -(def: frac_rev - (Random Rev) - (let [bits_to_ignore 11] - (\ random.functor map (i64.left_shift bits_to_ignore) random.rev))) - (def: prelude_macros Test ($_ _.and @@ -132,36 +89,6 @@ (if (n.< iterations counter) (recur (inc counter) (n.+ factor value)) value))))) - - (do random.monad - [first random.nat - second random.nat - third random.nat] - (_.test "Can create lists easily through macros." - (and (case (list first second third) - (#.Cons first' (#.Cons second' (#.Cons third' #.Nil))) - (and (n.= first first') - (n.= second second') - (n.= third third')) - - _ - false) - (case (list& first (list second third)) - (#.Cons first' (#.Cons second' (#.Cons third' #.Nil))) - (and (n.= first first') - (n.= second second') - (n.= third third')) - - _ - false) - (case (list& first second (list third)) - (#.Cons first' (#.Cons second' (#.Cons third' #.Nil))) - (and (n.= first first') - (n.= second second') - (n.= third third')) - - _ - false)))) )) (template: (quadrance cat0 cat1) @@ -198,18 +125,6 @@ @.php on_valid_host} on_default)))))) -(def: conversion_tests - Test - (`` ($_ _.and - (~~ (template [<=> ] - [(<| (_.context (format (%.name (name_of )) - " " (%.name (name_of )))) - (..conversion <=>))] - - [i.= .nat .int (random\map (i.% +1,000,000) random.int)] - [n.= .int .nat (random\map (n.% 1,000,000) random.nat)] - ))))) - (def: sub_tests Test (with_expansions [## TODO: Update & expand tests for this @@ -240,28 +155,428 @@ ))))) +(def: for_bit + Test + (do random.monad + [expected random.nat + dummy random.nat] + (_.for [/.Bit /.if] + ($_ _.and + (_.cover [/.false] + (n.= expected + (/.if /.false + dummy + expected))) + (_.cover [/.true] + (n.= expected + (/.if /.true + expected + dummy))) + (_.cover [/.or] + (and (not (/.or /.false /.false)) + (/.or /.false /.true) + (/.or /.true /.false) + (/.or /.true /.true))) + (_.cover [/.and] + (and (not (/.and /.false /.false)) + (not (/.and /.false /.true)) + (not (/.and /.true /.false)) + (/.and /.true /.true))) + (_.cover [/.not] + (and (bit\= /.true (/.not /.false)) + (bit\= /.false (/.not /.true)))) + (_.cover [/.cond] + (and (n.= expected + (/.cond /.true + expected + + ## else + dummy)) + (n.= expected + (/.cond /.false + dummy + + ## else + expected)) + (n.= expected + (/.cond /.true + expected + + /.false + dummy + + ## else + dummy)) + (n.= expected + (/.cond /.false + dummy + + /.true + expected + + ## else + dummy)))) + )))) + +(def: for_try + Test + (do random.monad + [expected_error (random.ascii/lower 5) + expected random.nat] + ($_ _.and + (_.cover [/.try] + (case (/.try expected) + (#.Left _) + false + + (#.Right actual) + (n.= expected actual))) + (_.cover [/.undefined] + (case (/.try (/.undefined)) + (#.Left _) + true + + (#.Right _) + false)) + (_.cover [/.error!] + (case (/.try (/.error! expected_error)) + (#.Left actual_error) + (text.contains? expected_error actual_error) + + (#.Right _) + false)) + ))) + +(def: for_list + Test + (do random.monad + [e/0 random.nat + e/1 random.nat + e/2 random.nat + e/3 random.nat] + ($_ _.and + (_.cover [/.list] + (case (/.list e/0 e/1) + (^ (/.list a/0 a/1)) + (and (n.= e/0 a/0) + (n.= e/1 a/1)) + + _ + false)) + (_.cover [/.list&] + (case (/.list& e/0 e/1 (/.list e/2 e/3)) + (^ (/.list& a/0 a/1 (/.list a/2 a/3))) + (and (n.= e/0 a/0) + (n.= e/1 a/1) + (n.= e/2 a/2) + (n.= e/3 a/3)) + + _ + false)) + ))) + +(interface: (Returner a) + (: (-> Any a) + return)) + +(implementation: (global_returner value) + (All [a] (-> a (Returner a))) + + (def: (return _) + value)) + +(def: for_interface + Test + (do random.monad + [expected random.nat + #let [local_returner (: (Returner Nat) + (/.implementation + (def: (return _) + expected)))]] + (_.for [/.interface:] + ($_ _.and + (_.cover [/.implementation:] + (n.= expected (\ (global_returner expected) return []))) + (_.cover [/.implementation] + (n.= expected (\ local_returner return []))) + )))) + +(def: for_module + Test + ($_ _.and + (let [[module short] (/.name_of .example)] + (_.cover [/.name_of /.prelude_module] + (and (text\= /.prelude_module module) + (text\= short "example")))) + (let [[module short] (/.name_of ..example)] + (_.cover [/.module_separator] + (and (text.contains? /.module_separator module) + (not (text.contains? /.module_separator short))))) + )) + +(def: for_pipe + Test + (do random.monad + [start random.nat + factor random.nat + #let [expected (n.* factor (inc start))]] + ($_ _.and + (_.cover [/.|>] + (n.= expected + (/.|> start inc (n.* factor)))) + (_.cover [/.|>>] + (n.= expected + ((/.|>> inc (n.* factor)) start))) + (_.cover [/.<|] + (n.= expected + (/.<| (n.* factor) inc start))) + (_.cover [/.<<|] + (n.= expected + ((/.<<| (n.* factor) inc) start))) + ))) + +(def: example "YOLO") +(def: i8 8) + +(def: current_module + Text + (let [[module _] (name_of .._)] + module)) + +(def: for_code/' + Test + (do random.monad + [example_nat random.nat] + (_.cover [/.'] + (and (code\= (code.nat 0) (/.' 0)) + (code\= (code.int -1) (/.' -1)) + (code\= (code.rev .2) (/.' .2)) + (code\= (code.frac +3.4) (/.' +3.4)) + (code\= (code.text "5") (/.' "5")) + (code\= (code.identifier ["" "example"]) + (/.' example)) + (code\= (code.identifier [/.prelude_module "example"]) + (/.' .example)) + (code\= (code.identifier [..current_module "example"]) + (/.' ..example)) + (code\= (code.tag ["" "example"]) + (/.' #example)) + (code\= (code.tag [/.prelude_module "example"]) + (/.' #.example)) + (code\= (code.tag [..current_module "example"]) + (/.' #..example)) + (code\= (code.form (list (code.nat 6) (code.int +7) (code.rev .8))) + (/.' (6 +7 .8))) + (code\= (code.tuple (list (code.frac +9.0) + (code.text "9") + (code.identifier ["" "i8"]))) + (/.' [+9.0 "9" i8])) + (code\= (code.record (list [(code.identifier [/.prelude_module "i7"]) + (code.identifier [..current_module "i6"])])) + (/.' {.i7 ..i6})) + (not (code\= (code.nat example_nat) + (/.' (~ (code.nat example_nat))))) + )))) + +(def: for_code/` + Test + (do random.monad + [example_nat random.nat] + (_.cover [/.`] + (and (code\= (code.nat 0) (/.` 0)) + (code\= (code.int -1) (/.` -1)) + (code\= (code.rev .2) (/.` .2)) + (code\= (code.frac +3.4) (/.` +3.4)) + (code\= (code.text "5") (/.` "5")) + (code\= (code.identifier [..current_module "example"]) + (/.` example)) + (code\= (code.identifier [/.prelude_module "example"]) + (/.` .example)) + (code\= (code.identifier [..current_module "example"]) + (/.` ..example)) + (code\= (code.tag [..current_module "example"]) + (/.` #example)) + (code\= (code.tag [/.prelude_module "example"]) + (/.` #.example)) + (code\= (code.tag [..current_module "example"]) + (/.` #..example)) + (code\= (code.form (list (code.nat 6) (code.int +7) (code.rev .8))) + (/.` (6 +7 .8))) + (code\= (code.tuple (list (code.frac +9.0) + (code.text "9") + (code.identifier [..current_module "i8"]))) + (/.` [+9.0 "9" i8])) + (code\= (code.record (list [(code.identifier [/.prelude_module "i7"]) + (code.identifier [..current_module "i6"])])) + (/.` {.i7 ..i6})) + (code\= (code.nat example_nat) + (/.` (~ (code.nat example_nat)))))))) + +(def: for_code/`' + Test + (do random.monad + [example_nat random.nat] + (_.cover [/.`'] + (and (code\= (code.nat 0) (/.`' 0)) + (code\= (code.int -1) (/.`' -1)) + (code\= (code.rev .2) (/.`' .2)) + (code\= (code.frac +3.4) (/.`' +3.4)) + (code\= (code.text "5") (/.`' "5")) + (code\= (code.identifier ["" "example"]) + (/.`' example)) + (code\= (code.identifier [/.prelude_module "example"]) + (/.`' .example)) + (code\= (code.identifier [..current_module "example"]) + (/.`' ..example)) + (code\= (code.tag ["" "example"]) + (/.`' #example)) + (code\= (code.tag [/.prelude_module "example"]) + (/.`' #.example)) + (code\= (code.tag [..current_module "example"]) + (/.`' #..example)) + (code\= (code.form (list (code.nat 6) (code.int +7) (code.rev .8))) + (/.`' (6 +7 .8))) + (code\= (code.tuple (list (code.frac +9.0) + (code.text "9") + (code.identifier ["" "i8"]))) + (/.`' [+9.0 "9" i8])) + (code\= (code.record (list [(code.identifier [/.prelude_module "i7"]) + (code.identifier [..current_module "i6"])])) + (/.`' {.i7 ..i6})) + (code\= (code.nat example_nat) + (/.`' (~ (code.nat example_nat)))))))) + +(def: for_code + Test + (do random.monad + [example_nat random.nat] + (_.for [/.Code /.Code'] + ($_ _.and + ..for_code/' + ..for_code/` + ..for_code/`' + )))) + +(/.macro: (identity_macro tokens) + (\ meta.monad wrap tokens)) + +(def: for_macro + Test + (let [macro (: /.Macro' + (function (_ tokens lux) + (#.Right [lux (list)])))] + (do random.monad + [expected random.nat] + ($_ _.and + (_.cover [/.Macro'] + (|> macro + (: /.Macro') + (is? macro))) + (_.cover [/.Macro] + (|> macro + "lux macro" + (: /.Macro) + (: Any) + (is? (: Any macro)))) + (_.cover [/.macro:] + (is? expected (..identity_macro expected))) + )))) + +(def: for_type + Test + (do random.monad + [expected random.nat + + expected_left random.nat + expected_right random.nat] + ($_ _.and + (_.cover [/.:] + (|> expected + (/.: Any) + (is? (/.: Any expected)))) + (_.cover [/.:as] + (|> expected + (/.: Any) + (/.:as /.Nat) + (is? expected))) + (_.cover [/.:assume] + (|> expected + (/.: Any) + /.:assume + (/.: /.Nat) + (is? expected))) + (_.cover [/.:let] + (let [[actual_left actual_right] + (: (/.:let [side /.Nat] + (& side side)) + [expected_left expected_right])] + (and (is? expected_left actual_left) + (is? expected_right actual_right)))) + (_.cover [/.:of] + (is? /.Nat (/.:of expected))) + ))) + +(def: for_i64 + Test + (do random.monad + [expected random.i64] + ($_ _.and + (_.cover [/.i64] + (is? (: Any expected) + (: Any (/.i64 expected)))) + (_.cover [/.nat] + (is? (: Any expected) + (: Any (/.nat expected)))) + (_.cover [/.int] + (is? (: Any expected) + (: Any (/.int expected)))) + (_.cover [/.rev] + (is? (: Any expected) + (: Any (/.rev expected)))) + (_.cover [/.inc] + (n.= 1 (n.- expected + (/.inc expected)))) + (_.cover [/.dec] + (n.= 1 (n.- (/.dec expected) + expected))) + ))) + +(def: for_function + Test + (do random.monad + [expected_left random.nat + expected_right random.nat] + (_.cover [/.-> /.function] + (let [actual (: (/.-> Nat Nat Nat) + (/.function (_ actual_left actual_right) + (n.* (inc actual_left) (dec actual_right))))] + (n.= (n.* (inc expected_left) (dec expected_right)) + (actual expected_left expected_right)))))) + (def: test Test - (<| (_.context (name.module (name_of /._))) + (<| (_.covering /._) ($_ _.and (<| (_.context "Identity.") ..identity) - (<| (_.context "Increment & decrement.") - ..increment_and_decrement) - (<| (_.context "Even or odd.") - ($_ _.and - (<| (_.context "Natural numbers.") - (..even_or_odd random.nat n.even? n.odd?)) - (<| (_.context "Integers.") - (..even_or_odd random.int i.even? i.odd?)))) - (<| (_.context "Conversion.") - ..conversion_tests) (<| (_.context "Prelude macros.") ..prelude_macros) (<| (_.context "Templates.") ..templates) (<| (_.context "Cross-platform support.") ..cross_platform_support) + + ..for_bit + ..for_try + ..for_list + ..for_interface + ..for_module + ..for_pipe + ..for_code + ..for_macro + ..for_type + ..for_i64 + ..for_function ..sub_tests ))) diff --git a/stdlib/source/test/lux/data/bit.lux b/stdlib/source/test/lux/data/bit.lux index fda210668..bffa5b808 100644 --- a/stdlib/source/test/lux/data/bit.lux +++ b/stdlib/source/test/lux/data/bit.lux @@ -33,6 +33,12 @@ (_.for [/.codec] ($codec.spec /.equivalence /.codec random.bit)) + (_.cover [/.no /.yes] + (and (\ /.equivalence = false /.no) + (\ /.equivalence = true /.yes))) + (_.cover [/.off /.on] + (and (\ /.equivalence = false /.off) + (\ /.equivalence = true /.on))) (_.cover [/.complement] (and (not (\ /.equivalence = value ((/.complement function.identity) value))) (\ /.equivalence = value ((/.complement not) value)))) diff --git a/stdlib/source/test/lux/ffi.old.lux b/stdlib/source/test/lux/ffi.old.lux index 36ec40e21..aa4b73548 100644 --- a/stdlib/source/test/lux/ffi.old.lux +++ b/stdlib/source/test/lux/ffi.old.lux @@ -91,8 +91,11 @@ [long random.int int (\ ! map (|>> /.long_to_int) random.int) char (\ ! map (|>> /.long_to_int /.int_to_char) random.int) - double random.frac - float (\ ! map (|>> /.double_to_float) random.frac)] + double (|> random.frac + (random.filter (|>> f.not_a_number? not))) + float (|> random.frac + (random.filter (|>> f.not_a_number? not)) + (\ ! map (|>> /.double_to_float)))] (`` ($_ _.and (~~ (template [<=> ] [(_.cover [ ] diff --git a/stdlib/source/test/lux/macro/code.lux b/stdlib/source/test/lux/macro/code.lux index 8a037cc08..f0764fda7 100644 --- a/stdlib/source/test/lux/macro/code.lux +++ b/stdlib/source/test/lux/macro/code.lux @@ -113,6 +113,57 @@ (list.zip/2 parts' parts')))])) ))))) +(def: for_format + Test + (`` ($_ _.and + (~~ (template [ ] + [(do {! random.monad} + [expected ] + (_.cover [] + (and (case (..read (/.format ( expected))) + (#try.Success actual) + (\ /.equivalence = + actual + ( expected)) + + (#try.Failure error) + false) + (\ /.equivalence = + [location.dummy ( expected)] + ( expected)))))] + + [/.bit random.bit #.Bit] + [/.nat random.nat #.Nat] + [/.int random.int #.Int] + [/.rev random.rev #.Rev] + [/.frac random.safe_frac #.Frac] + [/.text ..random_text #.Text] + [/.tag ..random_name #.Tag] + [/.identifier ..random_name #.Identifier] + [/.form (..random_sequence ..random) #.Form] + [/.tuple (..random_sequence ..random) #.Tuple] + [/.record (..random_record ..random) #.Record])) + (~~ (template [ ] + [(do {! random.monad} + [expected ] + (_.cover [] + (and (case (..read (/.format ( expected))) + (#try.Success actual) + (\ /.equivalence = + actual + ( expected)) + + (#try.Failure error) + false) + (\ /.equivalence = + [location.dummy ( ["" expected])] + ( expected))) + ))] + + [/.local_tag ..random_text #.Tag] + [/.local_identifier ..random_text #.Identifier] + ))))) + (def: #export test Test (<| (_.covering /._) @@ -121,54 +172,8 @@ ($equivalence.spec /.equivalence ..random)) (_.for [/.format] - (`` ($_ _.and - (~~ (template [ ] - [(do {! random.monad} - [expected ] - (_.cover [] - (and (case (..read (/.format ( expected))) - (#try.Success actual) - (\ /.equivalence = - actual - ( expected)) - - (#try.Failure error) - false) - (\ /.equivalence = - [location.dummy ( expected)] - ( expected)))))] - - [/.bit random.bit #.Bit] - [/.nat random.nat #.Nat] - [/.int random.int #.Int] - [/.rev random.rev #.Rev] - [/.frac random.safe_frac #.Frac] - [/.text ..random_text #.Text] - [/.tag ..random_name #.Tag] - [/.identifier ..random_name #.Identifier] - [/.form (..random_sequence ..random) #.Form] - [/.tuple (..random_sequence ..random) #.Tuple] - [/.record (..random_record ..random) #.Record])) - (~~ (template [ ] - [(do {! random.monad} - [expected ] - (_.cover [] - (and (case (..read (/.format ( expected))) - (#try.Success actual) - (\ /.equivalence = - actual - ( expected)) - - (#try.Failure error) - false) - (\ /.equivalence = - [location.dummy ( ["" expected])] - ( expected))) - ))] - - [/.local_tag ..random_text #.Tag] - [/.local_identifier ..random_text #.Identifier] - ))))) + ..for_format) + (do {! random.monad} [[original substitute] (random.filter (function (_ [original substitute]) (not (\ /.equivalence = original substitute))) -- cgit v1.2.3