path: root/stdlib/source/test/lux.lux

(.with-expansions [<host-modules> (.as-is [runtime (#+)]
                                          [primitive (#+)]
                                          [structure (#+)]
                                          [reference (#+)]
                                          [case (#+)]
                                          [loop (#+)]
                                          [function (#+)]
                                          [extension (#+)])]
  (.module:
    ["/" lux #*
     [abstract
      [monad (#+ do)]
      [predicate (#+ Predicate)]]
     [control
      ["." io (#+ io)]
      [function
       [mixin (#+)]]
      [parser
       [cli (#+ program:)]]]
     [data
      ["." name]
      [number
       ["." i64]
       ["n" nat]
       ["i" int]
       ["r" rev]
       ["f" frac]]]
     ["." math]
     ["_" test (#+ Test)]
     ## These modules do not need to be tested.
     [type
      [variance (#+)]]
     [locale (#+)
      [language (#+)]
      [territory (#+)]]
     ["%" data/text/format (#+ format)]
     [math
      ["." random (#+ Random) ("#@." functor)]]
     ## TODO: Test these modules
     [data
      [format
       [css (#+)]
       [markdown (#+)]]]
     ["@" target
      [js (#+)]
      [python (#+)]
      [lua (#+)]
      [ruby (#+)]
      [php (#+)]
      [common-lisp (#+)]
      [scheme (#+)]]
     ## [tool
     ##  [compiler
     ##   [language
     ##    [lux
     ##     [phase
     ##      [generation
     ##       [jvm (#+)
     ##        <host-modules>]
     ##       [js (#+)
     ##        <host-modules>]
     ##       [python (#+)
     ##        <host-modules>]
     ##       [lua (#+)
     ##        <host-modules>]
     ##       [ruby (#+)
     ##        <host-modules>]
     ##       ## [php (#+)
     ##       ##  <host-modules>]
     ##       ## [common-lisp (#+)
     ##       ##  <host-modules>]
     ##       ## [scheme (#+)
     ##       ##  <host-modules>]
     ##       ]
     ##      [extension
     ##       [generation
     ##        [jvm (#+)]
     ##        [js (#+)]
     ##        [python (#+)]
     ##        [lua (#+)]
     ##        [ruby (#+)]]]]]]]]
     ## [control
     ##  ["._" predicate]
     ##  [function
     ##   ["._" contract]]
     ##  [monad
     ##   ["._" free]]
     ##  [parser
     ##   [type (#+)]]]
     ## [data
     ##  ["._" env]
     ##  ["._" trace]
     ##  ["._" store]
     ##  [format
     ##   ["._" context]
     ##   ["._" html]
     ##   ["._" css]
     ##   ["._" binary]]
     ##  [collection
     ##   [tree
     ##    [rose
     ##     ["._" parser]]]
     ##   [dictionary
     ##    ["._" plist]]
     ##   [set
     ##    ["._" multi]]]
     ##  [text
     ##   ["._" buffer]]]
     ## ["._" macro]
     ## [type
     ##  ["._" unit]
     ##  ["._" refinement]
     ##  ["._" quotient]]
     ## [world
     ##  ["._" environment]
     ##  ["._" console]]
     ## [compiler
     ##  ["._" cli]
     ##  ["._" default
     ##   ["._" evaluation]
     ##   [phase
     ##    ["._" generation]
     ##    [extension
     ##     ["._" directive]]]
     ##   ["._default" cache]]
     ##  [meta
     ##   ["._meta" io
     ##    ["._meta_io" context]
     ##    ["._meta_io" archive]]
     ##   ["._meta" archive]
     ##   ["._meta" cache]]]
     ## ["._" interpreter
     ##  ["._interpreter" type]]
     ]
    ## TODO: Must have 100% coverage on tests.
    ["." / #_
     ["#." abstract]
     ["#." control]
     ["#." data]
     ["#." macro]
     ["#." math]
     ["#." time]
     ## ["#." tool]
     ["#." type]
     ["#." world]
     ["#." host]
     ["#." extension]
     ["#." target #_
      ["#/." jvm]]]
    ))

## TODO: Get rid of this ASAP
(template: (!bundle body)
  (: Test
     (do random.monad
       [_ (wrap [])]
       body)))

(def: identity
  Test
  (do {@ random.monad}
    [self (random.unicode 1)]
    ($_ _.and
        (_.test "Every value is identical to itself."
                (is? self self))
        (do @
          [other (random.unicode 1)]
          (_.test "Values created separately can't be identical."
                  (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: (Choice a)
  (-> a a a))

(type: (Order a)
  (-> a a Bit))

(type: (Equivalence a)
  (-> a a Bit))

(def: (choice rand-gen = [< choose])
  (All [a] (-> (Random a) (Equivalence a) [(Order a) (Choice a)] Test))
  (do random.monad
    [left rand-gen
     right rand-gen
     #let [choice (choose left right)]]
    ($_ _.and
        (_.test "The choice between 2 values is one of them."
                (or (= left choice)
                    (= right choice)))
        (_.test "The choice between 2 values implies an order relationship between them."
                (if (= left choice)
                  (< right choice)
                  (< left choice))))))

(def: (minimum-and-maximum rand-gen = min' max')
  (All [a] (-> (Random a) (Equivalence a) [(Order a) (Choice a)] [(Order a) (Choice a)] Test))
  ($_ _.and
      (<| (_.context "Minimum.")
          (choice rand-gen = min'))
      (<| (_.context "Maximum.")
          (choice rand-gen = max'))))

(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
      (do random.monad
        [factor (random@map (|>> (n.% 10) (n.max 1)) random.nat)
         iterations (random@map (n.% 100) random.nat)
         #let [expected (n.* factor iterations)]]
        (_.test "Can write loops."
                (n.= expected
                     (loop [counter 0
                            value 0]
                       (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)
  (n.+ (n.* cat0 cat0) (n.* cat1 cat1)))

(def: templates
  Test
  (do random.monad
    [cat0 random.nat
     cat1 random.nat]
    (_.test "Template application is a stand-in for the templated code."
            (n.= (n.+ (n.* cat0 cat0) (n.* cat1 cat1))
                 (quadrance cat0 cat1)))))

(def: cross-platform-support
  Test
  (do random.monad
    [on-default random.nat
     on-fake-host random.nat
     on-valid-host random.nat]
    ($_ _.and
        (_.test "Can provide default in case there is no particular host/platform support."
                (n.= on-default
                     (for {"" on-fake-host}
                          on-default)))
        (_.test "Can pick code depending on the host/platform being targeted."
                (n.= on-valid-host
                     (`` (for {(~~ (static @.old)) on-valid-host
                               (~~ (static @.jvm)) on-valid-host
                               (~~ (static @.js)) on-valid-host}
                              on-default)))))))

(def: test
  (<| (_.context (name.module (name-of /._)))
      ($_ _.and
          (!bundle ($_ _.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 "Minimum and maximum.")
                           (`` ($_ _.and
                                   (~~ (template [<=> <lt> <min> <gt> <max> <gen> <context>]
                                         [(<| (_.context <context>)
                                              (..minimum-and-maximum <gen> <=> [<lt> <min>] [<gt> <max>]))]

                                         [i.= i.< i.min i.> i.max random.int       "Integers."]
                                         [n.= n.< n.min n.> n.max random.nat       "Natural numbers."]
                                         [r.= r.< r.min r.> r.max random.rev       "Revolutions."]
                                         [f.= f.< f.min f.> f.max random.safe-frac "Fractions."]
                                         )))))
                       (<| (_.context "Conversion.")
                           (`` ($_ _.and
                                   (~~ (template [<=> <forward> <backward> <gen>]
                                         [(<| (_.context (format (%.name (name-of <forward>))
                                                                 " " (%.name (name-of <backward>))))
                                              (..conversion <gen> <forward> <backward> <=>))]

                                         [i.= .nat   .int   (random@map (i.% +1,000,000) random.int)]
                                         [n.= .int   .nat   (random@map (n.%  1,000,000) random.nat)]
                                         [i.= i.frac f.int  (random@map (i.% +1,000,000) random.int)]
                                         [f.= f.int  i.frac (random@map (|>> (i.% +1,000,000) i.frac) random.int)]
                                         [r.= r.frac f.rev  frac-rev]
                                         )))))
                       (<| (_.context "Prelude macros.")
                           ..prelude-macros)
                       (<| (_.context "Templates.")
                           ..templates)
                       (<| (_.context "Cross-platform support.")
                           ..cross-platform-support)))
          (_.in-parallel (list /abstract.test
                               /control.test
                               /data.test
                               /macro.test
                               /math.test
                               /time.test
                               ## /tool.test
                               /type.test
                               /world.test
                               /host.test
                               /extension.test
                               /target/jvm.test))
          )))

(program: args
  (<| io
      _.run!
      (_.times 100)
      ..test))