From b80f79ae6b2e240949ebd709a253e21f7caf7ed3 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 26 Jun 2021 00:56:43 -0400 Subject: Delegate text (lower|upper)-casing to the host-platform implementations. --- stdlib/source/test/aedifex.lux | 35 ++-- stdlib/source/test/aedifex/command/test.lux | 8 +- stdlib/source/test/aedifex/local.lux | 6 +- stdlib/source/test/aedifex/metadata/artifact.lux | 7 +- stdlib/source/test/aedifex/metadata/snapshot.lux | 31 ++- stdlib/source/test/lux.lux | 2 + stdlib/source/test/lux/data/text.lux | 45 +++- stdlib/source/test/lux/data/text/escape.lux | 12 +- stdlib/source/test/lux/debug.lux | 254 +++++++++++++++++++++++ stdlib/source/test/lux/macro/template.lux | 18 +- stdlib/source/test/lux/math.lux | 24 +-- stdlib/source/test/lux/type.lux | 6 +- 12 files changed, 383 insertions(+), 65 deletions(-) create mode 100644 stdlib/source/test/lux/debug.lux (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux index ae9bde67c..b7d0d29d9 100644 --- a/stdlib/source/test/aedifex.lux +++ b/stdlib/source/test/aedifex.lux @@ -8,42 +8,49 @@ ["#." artifact] ["#." cli] ["#." command] - ## ["#." input] - ## ["#." local] - ## ["#." dependency - ## ## ["#/." resolution] - ## ["#/." status]] + ["#." dependency + ["#/." resolution] + ["#/." status]] + ["#." hash] + ["#." input] + ["#." local] + ["#." metadata] ## ["#." package] ## ["#." profile] ## ["#." project] - ## ["#." hash] ## ["#." parser] ## ["#." pom] ## ["#." repository] ## ["#." runtime] - ## ["#." metadata] ]) +(def: dependency + Test + ($_ _.and + /dependency.test + /dependency/resolution.test + /dependency/status.test + )) + (def: test Test ($_ _.and /artifact.test /cli.test /command.test - ## /input.test - ## /local.test - ## /dependency.test - ## ## /dependency/resolution.test - ## /dependency/status.test + ..dependency + /hash.test + /input.test + /local.test + /metadata.test + ## /package.test ## /profile.test ## /project.test - ## /hash.test ## /parser.test ## /pom.test ## /repository.test ## /runtime.test - ## /metadata.test )) (program: args diff --git a/stdlib/source/test/aedifex/command/test.lux b/stdlib/source/test/aedifex/command/test.lux index 36c21b520..6b7ba9324 100644 --- a/stdlib/source/test/aedifex/command/test.lux +++ b/stdlib/source/test/aedifex/command/test.lux @@ -44,7 +44,7 @@ Test (<| (_.covering /._) (do {! random.monad} - [program (random.ascii/alpha 5) + [test (random.ascii/alpha 5) target (random.ascii/alpha 5) home (random.ascii/alpha 5) working_directory (random.ascii/alpha 5) @@ -52,11 +52,11 @@ (\ ///.monoid identity)) with_target (: (-> Profile Profile) (set@ #///.target (#.Some target))) - with_program (: (-> Profile Profile) - (set@ #///.program (#.Some program))) + with_test (: (-> Profile Profile) + (set@ #///.test (#.Some test))) profile (|> empty_profile - with_program + with_test with_target)] resolution @build.resolution] ($_ _.and diff --git a/stdlib/source/test/aedifex/local.lux b/stdlib/source/test/aedifex/local.lux index 6729d4485..3f6574ed9 100644 --- a/stdlib/source/test/aedifex/local.lux +++ b/stdlib/source/test/aedifex/local.lux @@ -10,7 +10,9 @@ [// ["@." artifact]] {#program - ["." /]}) + ["." / + ["/#" // #_ + ["#." artifact]]]}) (def: #export test Test @@ -20,5 +22,5 @@ ($_ _.and (_.cover [/.repository /.uri] (text.starts_with? /.repository - (/.uri sample))) + (/.uri (get@ #//artifact.version sample) sample))) )))) diff --git a/stdlib/source/test/aedifex/metadata/artifact.lux b/stdlib/source/test/aedifex/metadata/artifact.lux index 9977be8e1..6c3e509b1 100644 --- a/stdlib/source/test/aedifex/metadata/artifact.lux +++ b/stdlib/source/test/aedifex/metadata/artifact.lux @@ -33,9 +33,9 @@ (random.ascii/alpha 5) (random.list 5 (random.ascii/alpha 5)) (do {! random.monad} - [year (\ ! map (|>> (n.% 10,000) .int) random.nat) - month (\ ! map (n.% 13) random.nat) - day_of_month (\ ! map (n.% 29) random.nat) + [year (\ ! map (|>> (n.% 9,000) (n.+ 1,000) .int) random.nat) + month (\ ! map (|>> (n.% 12) (n.+ 1)) random.nat) + day_of_month (\ ! map (|>> (n.% 28) (n.+ 1)) random.nat) hour (\ ! map (n.% 24) random.nat) minute (\ ! map (n.% 60) random.nat) second (\ ! map (n.% 60) random.nat)] @@ -63,6 +63,7 @@ (_.cover [/.format /.parser] (|> expected /.format + list (.run /.parser) (try\map (\ /.equivalence = expected)) (try.default false)))) diff --git a/stdlib/source/test/aedifex/metadata/snapshot.lux b/stdlib/source/test/aedifex/metadata/snapshot.lux index a2f0b65db..1858cae25 100644 --- a/stdlib/source/test/aedifex/metadata/snapshot.lux +++ b/stdlib/source/test/aedifex/metadata/snapshot.lux @@ -20,21 +20,28 @@ ["." instant (#+ Instant)] ["." duration]] [math - ["." random (#+ Random)]] + ["." random (#+ Random) ("#\." monad)]] [macro ["." code]]] ["$." /// #_ ["#." artifact - ["#/." type]]] + ["#/." type] + ["#/." time] + ["#/." snapshot #_ + ["#/." version]]]] {#program - ["." /]}) + ["." / + [/// + [artifact + [versioning (#+ Versioning)] + ["#." snapshot]]]]}) (def: random_instant (Random Instant) (do {! random.monad} - [year (\ ! map (|>> (n.% 10,000) .int) random.nat) - month (\ ! map (n.% 13) random.nat) - day_of_month (\ ! map (n.% 29) random.nat) + [year (\ ! map (|>> (n.% 9,000) (n.+ 1,000) .int) random.nat) + month (\ ! map (|>> (n.% 12) (n.+ 1)) random.nat) + day_of_month (\ ! map (|>> (n.% 28) (n.+ 1)) random.nat) hour (\ ! map (n.% 24) random.nat) minute (\ ! map (n.% 60) random.nat) second (\ ! map (n.% 60) random.nat)] @@ -51,18 +58,19 @@ (wrap (instant.from_date_time date time))))))) (def: random_versioning - (Random /.Versioning) + (Random Versioning) ($_ random.and - ..random_instant - random.nat - (random.list 5 $///artifact/type.random) + (random\wrap #/snapshot.Local) + $///artifact/time.random + (random.list 5 $///artifact/snapshot/version.random) )) (def: #export random (Random /.Metadata) ($_ random.and $///artifact.random - ..random_versioning)) + ..random_versioning + )) (def: #export test Test @@ -76,6 +84,7 @@ (_.cover [/.format /.parser] (|> expected /.format + list (.run /.parser) (try\map (\ /.equivalence = expected)) (try.default false)))) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index 69ce89d45..de14f2dea 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -31,6 +31,7 @@ ["#." abstract] ["#." control] ["#." data] + ["#." debug] ["#." locale] ["#." macro] ["#." math] @@ -214,6 +215,7 @@ (`` (_.in_parallel (list /abstract.test /control.test /data.test + /debug.test /locale.test /macro.test /math.test diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux index b5c9f433b..345dbdc26 100644 --- a/stdlib/source/test/lux/data/text.lux +++ b/stdlib/source/test/lux/data/text.lux @@ -205,7 +205,10 @@ #let [dynamic (random.filter (|>> (\ /.equivalence = static) not) (random.ascii/alpha 1))] pre dynamic - post dynamic] + post dynamic + + lower (random.ascii/lower 1) + upper (random.ascii/upper 1)] ($_ _.and (_.cover [/.concat] (n.= (set.size characters) @@ -231,6 +234,46 @@ #.None false)) + (_.cover [/.lower_case] + (let [effectiveness! + (|> upper + /.lower_case + (\ /.equivalence = upper) + not) + + idempotence! + (|> lower + /.lower_case + (\ /.equivalence = lower)) + + inverse! + (|> lower + /.upper_case + /.lower_case + (\ /.equivalence = lower))] + (and effectiveness! + idempotence! + inverse!))) + (_.cover [/.upper_case] + (let [effectiveness! + (|> lower + /.upper_case + (\ /.equivalence = lower) + not) + + idempotence! + (|> upper + /.upper_case + (\ /.equivalence = upper)) + + inverse! + (|> upper + /.lower_case + /.upper_case + (\ /.equivalence = upper))] + (and effectiveness! + idempotence! + inverse!))) ))) (def: #export test diff --git a/stdlib/source/test/lux/data/text/escape.lux b/stdlib/source/test/lux/data/text/escape.lux index e58413ac6..a91ba6247 100644 --- a/stdlib/source/test/lux/data/text/escape.lux +++ b/stdlib/source/test/lux/data/text/escape.lux @@ -141,13 +141,13 @@ (#try.Failure error) true (#try.Success _) false))))] (_.cover [/.invalid_unicode_escape] - (template.with [(!invalid ) - [(case (/.un_escape (format "\u" )) - (#try.Success _) - false + (template.let [(!invalid ) + [(case (/.un_escape (format "\u" )) + (#try.Success _) + false - (#try.Failure error) - (exception.match? /.invalid_unicode_escape error))]] + (#try.Failure error) + (exception.match? /.invalid_unicode_escape error))]] (and (!invalid (\ n.hex encode too_short)) (!invalid code))))) (_.cover [/.escaped] diff --git a/stdlib/source/test/lux/debug.lux b/stdlib/source/test/lux/debug.lux new file mode 100644 index 000000000..508f9fd6d --- /dev/null +++ b/stdlib/source/test/lux/debug.lux @@ -0,0 +1,254 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [control + ["." try ("#\." functor)] + ["." exception]] + [data + ["." text ("#\." equivalence) + ["%" format (#+ format)]] + [collection + ["." list ("#\." functor)]] + [format + [json (#+ JSON)] + [xml (#+ XML)]]] + ["." macro + [syntax (#+ syntax:)] + ["." code]] + [math + ["." random (#+ Random)] + [number + [ratio (#+ Ratio)]]] + [time (#+ Time) + [instant (#+ Instant)] + [date (#+ Date)] + [duration (#+ Duration)] + [month (#+ Month)] + [day (#+ Day)]]] + {1 + ["." /]} + ["$." // #_ + ["#." type] + [data + ["#." name] + [format + ["#." json] + ["#." xml]]] + [macro + ["#." code]] + [math + [number + ["#." ratio]]] + [meta + ["#." location]]]) + +(def: can_represent_simple_types + (Random Bit) + (do random.monad + [sample_bit random.bit + sample_int random.int + sample_frac random.frac + sample_text (random.ascii/upper 10) + sample_nat random.nat + sample_rev random.rev] + (wrap (`` (and (~~ (template [ ] + [(|> (/.represent ) + (try\map (text\= ( ))) + (try.default false))] + + [Bit %.bit sample_bit] + [Nat %.nat sample_nat] + [Int %.int sample_int] + [Rev %.rev sample_rev] + [Frac %.frac sample_frac] + [Text %.text sample_text])) + ))))) + +(def: can_represent_structure_types + (Random Bit) + (do random.monad + [sample_bit random.bit + sample_int random.int + sample_frac random.frac] + (wrap (`` (and (case (/.represent (type [Bit Int Frac]) + [sample_bit sample_int sample_frac]) + (#try.Success actual) + (text\= (format "[" (%.bit sample_bit) + " " (%.int sample_int) + " " (%.frac sample_frac) + "]") + actual) + + (#try.Failure error) + false) + ## TODO: Uncomment after switching from the old (tag+last?) to the new (lefts+right?) representation for variants + ## (~~ (template [ ] + ## [(|> (/.represent (type (| Bit Int Frac)) + ## (: (| Bit Int Frac) + ## ( ))) + ## (try\map (text\= (format "(" (%.nat ) + ## " " (%.bit ) + ## " " ( ) ")"))) + ## (try.default false))] + + ## [0 #0 sample_bit %.bit] + ## [1 #0 sample_int %.int] + ## [1 #1 sample_frac %.frac] + ## )) + ))))) + +(def: can_represent_complex_types + (Random Bit) + (do random.monad + [sample_ratio $//ratio.random + sample_name ($//name.random 5 5) + sample_location $//location.random + sample_type $//type.random + sample_code $//code.random + sample_xml $//xml.random + sample_json $//json.random] + (wrap (`` (and (~~ (template [ ] + [(|> (/.represent ) + (try\map (text\= ( ))) + (try.default false))] + + [Ratio %.ratio sample_ratio] + [Name %.name sample_name] + [Location %.location sample_location] + [Code %.code sample_code] + [Type %.type sample_type] + [XML %.xml sample_xml] + [JSON %.json sample_json])) + ))))) + +(def: can_represent_time_types + (Random Bit) + (do random.monad + [sample_instant random.instant + sample_duration random.duration + sample_date random.date + sample_month random.month + sample_time random.time + sample_day random.day] + (wrap (`` (and (~~ (template [ ] + [(|> (/.represent ) + (try\map (text\= ( ))) + (try.default false))] + + [Instant %.instant sample_instant] + [Duration %.duration sample_duration] + [Date %.date sample_date] + [Month %.month sample_month] + [Time %.time sample_time] + [Day %.day sample_day])) + ))))) + +(def: representation + Test + (do random.monad + [sample_bit random.bit + sample_nat random.nat + sample_int random.int + sample_frac random.frac + + can_represent_simple_types! ..can_represent_simple_types + can_represent_structure_types! ..can_represent_structure_types + can_represent_complex_types! ..can_represent_complex_types + can_represent_time_types! ..can_represent_time_types] + ($_ _.and + (_.cover [/.represent] + (`` (and can_represent_simple_types! + can_represent_structure_types! + can_represent_complex_types! + can_represent_time_types! + + (|> (/.represent .Any sample_frac) + (try\map (text\= "[]")) + (try.default false)) + (|> (/.represent (type (List Nat)) (: (List Nat) (list sample_nat))) + (try\map (text\= (%.list %.nat (list sample_nat)))) + (try.default false)) + (~~ (template [] + [(|> (/.represent (type (Maybe Nat)) (: (Maybe Nat) )) + (try\map (text\= (%.maybe %.nat ))) + (try.default false))] + + [(#.Some sample_nat)] + [#.None] + )) + ))) + (_.cover [/.cannot_represent_value] + (case (/.represent (-> Nat Nat) (|>>)) + (#try.Success representation) + false + + (#try.Failure error) + (exception.match? /.cannot_represent_value error))) + ))) + +(def: inspection + Test + (do random.monad + [sample_bit random.bit + sample_int random.int + sample_frac random.frac + sample_text (random.ascii/upper 10)] + (_.cover [/.inspect] + (`` (and (~~ (template [ ] + [(text\= ( ) (/.inspect ))] + + [%.bit sample_bit] + [%.int sample_int] + [%.frac sample_frac] + [%.text sample_text] + )) + (text\= (|> (list sample_bit sample_int sample_frac sample_text) + (: (List Any)) + (list\map /.inspect) + (text.join_with " ") + (text.enclose ["[" "]"])) + (/.inspect [sample_bit sample_int sample_frac sample_text]))))))) + +(syntax: (macro_error macro) + (function (_ compiler) + (case ((macro.expand macro) compiler) + (#try.Failure error) + (#try.Success [compiler (list (code.text error))]) + + (#try.Success _) + (#try.Failure "OOPS!")))) + +(type: My_Text + Text) + +(def: #export test + Test + (<| (_.covering /._) + ($_ _.and + ..inspection + ..representation + (_.cover [/.:hole /.type_hole] + (let [error (: My_Text (..macro_error (/.:hole)))] + (and (exception.match? /.type_hole error) + (text.contains? (%.type My_Text) error)))) + (do random.monad + [foo (random.ascii/upper 10) + bar random.nat + baz random.bit] + (_.cover [/.here] + (exec + (/.here) + (/.here foo + {bar %.nat}) + true))) + (_.cover [/.unknown_local_binding] + (exception.match? /.unknown_local_binding + (..macro_error (/.here yolo)))) + (_.cover [/.private] + (exec + (: (/.private /.Inspector) + /.inspect) + true)) + ))) diff --git a/stdlib/source/test/lux/macro/template.lux b/stdlib/source/test/lux/macro/template.lux index 9f8b5af6c..8f68ff501 100644 --- a/stdlib/source/test/lux/macro/template.lux +++ b/stdlib/source/test/lux/macro/template.lux @@ -19,8 +19,8 @@ {1 ["." /]}) -(/.with [(!pow/2 ) - [(nat.* )]] +(/.let [(!pow/2 ) + [(nat.* )]] (def: pow/2 (-> Nat Nat) (|>> !pow/2))) @@ -82,16 +82,16 @@ (nat.= right var1))))) (do ! [scalar random.nat] - (_.cover [/.with] + (_.cover [/.let] (let [can_use_with_statements! (nat.= ($_ nat.* scalar scalar) (..pow/2 scalar))] (and can_use_with_statements! - (/.with [(pow/3 ) - [($_ nat.* )] + (/.let [(pow/3 ) + [($_ nat.* )] - (pow/9 ) - [(pow/3 (pow/3 ))]] + (pow/9 ) + [(pow/3 (pow/3 ))]] (let [can_use_with_expressions! (nat.= ($_ nat.* scalar scalar scalar) (pow/3 scalar)) @@ -113,8 +113,8 @@ can_shadow!))) )))) (_.cover [/.irregular_arguments] - (/.with [(arity/3 <0> <1> <2>) - [""]] + (/.let [(arity/3 <0> <1> <2>) + [""]] (exception.match? /.irregular_arguments (macro_error (arity/3 "a" "b"))))) ))) diff --git a/stdlib/source/test/lux/math.lux b/stdlib/source/test/lux/math.lux index 3645ef1bf..919a9c694 100644 --- a/stdlib/source/test/lux/math.lux +++ b/stdlib/source/test/lux/math.lux @@ -98,20 +98,20 @@ 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))))] + (template.let [(odd! ) + [(_.cover [] + (~= (f.negate ( angle)) + ( (f.negate angle))))] - (even! ) - [(_.cover [] - (~= ( angle) - ( (f.negate angle))))] + (even! ) + [(_.cover [] + (~= ( angle) + ( (f.negate angle))))] - (inverse! ) - [(_.cover [ ] - (~= ( ) - ( (f./ +1.0))))]] + (inverse! ) + [(_.cover [ ] + (~= ( ) + ( (f./ +1.0))))]] ($_ _.and (odd! /.sinh) (even! /.cosh) diff --git a/stdlib/source/test/lux/type.lux b/stdlib/source/test/lux/type.lux index b881aec70..86e7a63e5 100644 --- a/stdlib/source/test/lux/type.lux +++ b/stdlib/source/test/lux/type.lux @@ -39,13 +39,13 @@ (def: #export random (Random Type) - (let [(^open "R\.") random.monad] + (let [(^open "random\.") random.monad] (random.rec (function (_ recur) (let [pairG (random.and recur recur) idG random.nat - quantifiedG (random.and (R\wrap (list)) recur)] + quantifiedG (random.and (random\wrap (list)) recur)] ($_ random.or - (random.and ..short (R\wrap (list))) + (random.and ..short (random\wrap (list))) pairG pairG pairG -- cgit v1.2.3