aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/library/lux/test/inline.lux
blob: 191a798cb5278e8e2aa0d511801255ddfd8ce3fa (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
(.require
 [library
  [lux (.except static)
   [abstract
    [monad (.only do)]]
   [control
    ["?" parser]
    ["[0]" try]
    ["[0]" exception (.only Exception)]]
   [data
    ["[0]" text (.only)
     ["%" \\format]]]
   [math
    [number (.only hex)]
    ["[0]" random (.only Random)]]
   ["[0]" meta (.only)
    ["[0]" code (.only)
     ["?[1]" \\parser (.only Parser)]]
    [macro
     [syntax (.only syntax)]]]]])

(exception.def .public (failure test)
  (Exception Code)
  (exception.report
   (list ["Test" (%.code test)])))

(type .public Test
  (Random Bit))

(def pcg_32_magic_inc
  Nat
  (hex "FEDCBA9876543210"))

(def ?static
  (Parser [(Maybe Nat)
           Code])
  (?.either (do ?.monad
              [seed ?code.nat
               term ?code.any]
              (in [{.#Some seed} term]))
            (do ?.monad
              [term ?code.any]
              (in [{.#None} term]))))

(def .public static
  (syntax (_ [[seed term] ?static])
    (do [! meta.monad]
      [test (meta.eval Test term)
       seed (when seed
              {.#Some seed}
              (in seed)

              _
              meta.seed)
       .let [[_ success?] (random.result (random.pcg_32 [..pcg_32_magic_inc seed])
                                         (as Test test))]]
      (if success?
        (in (list))
        (meta.failure (exception.error ..failure [term]))))))

(def .public dynamic
  (syntax (_ [test ?code.any])
    (do [! meta.monad]
      [error_message (meta.try (meta.failure (exception.error ..failure [test])))]
      (in (list (` (is Any
                       (if (is Bit (, test))
                         []
                         (panic! (, (code.text (when error_message
                                                 {try.#Failure error}
                                                 error
                                                 
                                                 {try.#Success _}
                                                 ""))))))))))))