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

(.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 (#+)]
         [js (#+)]
         ## [python (#+)]
         ## [lua (#+)]
         ## [ruby (#+)]
         ## [php (#+)]
         ## [common-lisp (#+)]
         ## [scheme (#+)]
         ]
        [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 {@.old on-valid-host
                           @.jvm on-valid-host
                           @.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))