blob: effad7726380567ac4f6712fafe4f5cd4f6d7b6a (
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
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
|
(.module:
lux
(lux [io {"+" [IO]}]
(control [monad {"+" [do]}]
pipe)
(data ["e" error]
text/format
[number]
(coll [list "list/" Functor<List>]
[set]))
[math]
["r" math/random]
(macro [code])
test)
(luxc (lang [synthesis {"+" [Synthesis]}]))
(test/luxc common))
(def: upper-alpha-ascii
(r.Random Nat)
(|> r.nat (:: r.Functor<Random> each (|>> (n/% +91) (n/max +65)))))
(def: (test-primitive-identity synthesis)
(-> Synthesis Bit)
(|> (run-js (` ("lux is" (~ synthesis) (~ synthesis))))
(case> (#e.Success valueV)
(:coerce Bit valueV)
_
#0)))
(type: Check (-> (e.Error Any) Bit))
(template [<name> <type> <pre> <=>]
[(def: (<name> angle)
(-> <type> Check)
(|>> (case> (#e.Success valueV)
(<=> (<pre> angle) (:coerce <type> valueV))
(#e.Error error)
#0)))]
[sin-check Frac math.sin f/=]
[length-check Nat id n/=]
)
(context: "[JS] Primitives."
($_ seq
(test "Null is equal to itself."
(test-primitive-identity (` ("js null"))))
(test "Undefined is equal to itself."
(test-primitive-identity (` ("js undefined"))))
(test "Object comparison is by reference, not by value."
(not (test-primitive-identity (` ("js object")))))
(test "Values are equal to themselves."
(test-primitive-identity (` ("js global" "Math"))))
(<| (times +100)
(do @
[value r.int
#let [frac-value (int-to-frac value)]]
(test "Can call primitive functions."
(|> (run-js (` ("js call" ("js global" "Math.sin") (~ (code.text (%f frac-value))))))
(sin-check frac-value)))))
))
(context: "[JS] Objects."
(<| (times +100)
(do @
[field (:: @ each code.text (r.text' upper-alpha-ascii +5))
value r.int
#let [empty-object (` ("js object"))
object (` ("js object set" (~ field) (~ (code.int value)) (~ empty-object)))
frac-value (int-to-frac value)]]
($_ seq
(test "Cannot get non-existing fields from objects."
(|> (run-js (` ("js object get" (~ field) (~ empty-object))))
(case> (^multi (#e.Success valueV)
[(:coerce (Maybe Int) valueV) #.None])
#1
_
#0)))
(test "Can get fields from objects."
(|> (run-js (` ("js object get" (~ field) (~ object))))
(case> (^multi (#e.Success valueV)
[(:coerce (Maybe Int) valueV) (#.Some valueV)])
(i/= value (:coerce Int valueV))
_
#0)))
(test "Can delete fields from objects."
(|> (run-js (let [post-delete (` ("js object delete" (~ field) (~ object)))]
(` ("js object get" (~ field) (~ post-delete)))))
(case> (^multi (#e.Success valueV)
[(:coerce (Maybe Int) valueV) #.None])
#1
_
#0)))
(test "Can instance new objects."
(let [base (` ("js object new" ("js global" "Number") (~ (code.text (%f frac-value)))))]
(|> (run-js (` ("lux frac +" (~ base) 0.0)))
(case> (#e.Success valueV)
(f/= frac-value (:coerce Frac valueV))
(#e.Error error)
#0))))
(test "Can call methods on objects."
(|> (run-js (` ("js object call" ("js global" "Math") "sin" (~ (code.text (%f frac-value))))))
(sin-check frac-value)))
))))
(context: "[JS] Arrays."
(<| (times +100)
(do @
[length (|> r.nat (:: @ each (|>> (n/% +10) (n/max +1))))
idx (|> r.nat (:: @ each (n/% length)))
overwrite r.nat
elems (|> (r.set number.Hash<Nat> length r.nat)
(:: @ each set.to-list))
#let [arrayS (` ("js array literal" (~+ (list/each code.nat elems))))]]
($_ seq
(test "Can get the length of an array."
(|> (run-js (` ("js array length" (~ arrayS))))
(length-check length)))
(test "Can get an element from an array."
(|> (run-js (` ("js array read" (~ (code.nat idx)) (~ arrayS))))
(case> (^multi (#e.Success elemV)
[[(list.nth idx elems) (:coerce (Maybe Nat) elemV)]
[(#.Some reference) (#.Some sample)]])
(n/= reference sample)
_
#0)))
(test "Can write an element into an array."
(let [idxS (code.nat idx)
overwriteS (code.nat overwrite)]
(|> (run-js (` ("js array read" (~ idxS)
("js array write" (~ idxS) (~ overwriteS) (~ arrayS)))))
(case> (^multi (#e.Success elemV)
[(:coerce (Maybe Nat) elemV)
(#.Some sample)])
(n/= overwrite sample)
_
#0))))
(test "Can delete an element from an array."
(let [idxS (code.nat idx)
deleteS (` ("js array delete" (~ idxS) (~ arrayS)))]
(and (|> (run-js (` ("js array length" (~ deleteS))))
(length-check length))
(|> (run-js (` ("js array read" (~ idxS) (~ deleteS))))
(case> (^multi (#e.Success elemV)
[(:coerce (Maybe Nat) elemV)
#.None])
#1
_
#0))
)))
))))
|
