diff options
| author | Eduardo Julian | 2021-06-26 00:56:43 -0400 | 
|---|---|---|
| committer | Eduardo Julian | 2021-06-26 00:56:43 -0400 | 
| commit | b80f79ae6b2e240949ebd709a253e21f7caf7ed3 (patch) | |
| tree | 0347461baa5544b0afa65fe260d7f804ff238c97 /stdlib/source/test | |
| parent | ce1a7a131f7c4df8eae5c019eba2893b56f04d46 (diff) | |
Delegate text (lower|upper)-casing to the host-platform implementations.
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/test/aedifex.lux | 35 | ||||
| -rw-r--r-- | stdlib/source/test/aedifex/command/test.lux | 8 | ||||
| -rw-r--r-- | stdlib/source/test/aedifex/local.lux | 6 | ||||
| -rw-r--r-- | stdlib/source/test/aedifex/metadata/artifact.lux | 7 | ||||
| -rw-r--r-- | stdlib/source/test/aedifex/metadata/snapshot.lux | 31 | ||||
| -rw-r--r-- | stdlib/source/test/lux.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/text.lux | 45 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/text/escape.lux | 12 | ||||
| -rw-r--r-- | stdlib/source/test/lux/debug.lux | 254 | ||||
| -rw-r--r-- | stdlib/source/test/lux/macro/template.lux | 18 | ||||
| -rw-r--r-- | stdlib/source/test/lux/math.lux | 24 | ||||
| -rw-r--r-- | stdlib/source/test/lux/type.lux | 6 | 
12 files changed, 383 insertions, 65 deletions
| 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                           (<xml>.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                           (<xml>.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 <code>) -                                     [(case (/.un_escape (format "\u" <code>)) -                                        (#try.Success _) -                                        false +                     (template.let [(!invalid <code>) +                                    [(case (/.un_escape (format "\u" <code>)) +                                       (#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 [<type> <format> <sample>] +                         [(|> (/.represent <type> <sample>) +                              (try\map (text\= (<format> <sample>))) +                              (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 [<lefts> <right?> <value> <format>] +                   ##       [(|> (/.represent (type (| Bit Int Frac)) +                   ##                         (: (| Bit Int Frac) +                   ##                            (<lefts> <right?> <value>))) +                   ##            (try\map (text\= (format "(" (%.nat <lefts>) +                   ##                                     " " (%.bit <right?>) +                   ##                                     " " (<format> <value>) ")"))) +                   ##            (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 [<type> <format> <sample>] +                         [(|> (/.represent <type> <sample>) +                              (try\map (text\= (<format> <sample>))) +                              (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 [<type> <format> <sample>] +                         [(|> (/.represent <type> <sample>) +                              (try\map (text\= (<format> <sample>))) +                              (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 [<sample>] +                                [(|> (/.represent (type (Maybe Nat)) (: (Maybe Nat) <sample>)) +                                     (try\map (text\= (%.maybe %.nat <sample>))) +                                     (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 [<format> <sample>] +                            [(text\= (<format> <sample>) (/.inspect <sample>))] + +                            [%.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 <scalar>) -         [(nat.* <scalar> <scalar>)]] +(/.let [(!pow/2 <scalar>) +        [(nat.* <scalar> <scalar>)]]    (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 <scalar>) -                                         [($_ nat.* <scalar> <scalar> <scalar>)] +                                (/.let [(pow/3 <scalar>) +                                        [($_ nat.* <scalar> <scalar> <scalar>)] -                                         (pow/9 <scalar>) -                                         [(pow/3 (pow/3 <scalar>))]] +                                        (pow/9 <scalar>) +                                        [(pow/3 (pow/3 <scalar>))]]                                    (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! <function>) -                            [(_.cover [<function>] -                                      (~= (f.negate (<function> angle)) -                                          (<function> (f.negate angle))))] +            (template.let [(odd! <function>) +                           [(_.cover [<function>] +                                     (~= (f.negate (<function> angle)) +                                         (<function> (f.negate angle))))] -                            (even! <function>) -                            [(_.cover [<function>] -                                      (~= (<function> angle) -                                          (<function> (f.negate angle))))] +                           (even! <function>) +                           [(_.cover [<function>] +                                     (~= (<function> angle) +                                         (<function> (f.negate angle))))] -                            (inverse! <left> <right> <input>) -                            [(_.cover [<left> <right>] -                                      (~= (<right> <input>) -                                          (<left> (f./ <input> +1.0))))]] +                           (inverse! <left> <right> <input>) +                           [(_.cover [<left> <right>] +                                     (~= (<right> <input>) +                                         (<left> (f./ <input> +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 | 
