~subsetpark/fugue

ref: f1a8cd43916c5c593388bb490b269a783f7f9471 fugue/test/fugue.janet -rw-r--r-- 10.3 KiB
f1a8cd43 — Zach Smith qualified getters 8 months ago
                                                                                
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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
(use testament)
(import /fugue)

(def tab @{})

(deftest table
  (is (not (fugue/prototype? tab))))

(defn- proto-tests [proto]
  (is (fugue/prototype? proto))
  (is (fugue/Root? proto))
  (is (fugue/Root*? proto))
  (is (= fugue/Root (table/getproto proto))))

(defmacro- inst-tests [proto inst]
  (upscope
    @[~(is ,(symbol proto "?") ,inst)
      ~(is ,(symbol proto "*?") ,inst)
      ~(is (not (fugue/prototype? ,inst)))
      ~(is (= ,proto (table/getproto ,inst)))]))

(defmacro- accessor-tests [accessor objs &opt refute]
  ~(each obj ,objs (is (,(if refute not= =) (,accessor obj) (obj ,(keyword accessor))))))

(fugue/defproto Animal ())

(deftest base-defproto
  (proto-tests Animal)
  (let [an-animal (:new Animal)]
    (inst-tests Animal an-animal)))

(deftest constructor
  (let [cat (:new Animal :name "Bowler Cat")]
    (inst-tests Animal cat)
    (is (= "Bowler Cat" (cat :name)))))

(fugue/defproto Human () name {:default "John Doe"})

(deftest defaults
  (proto-tests Human)
  (let [a-human (:new Human)]
    (inst-tests Human a-human)
    # The default value has been set on the instance
    (is (= "John Doe" (a-human :name)))
    # But it's not on the Prototype.
    (is (nil? (Human :name)))
    (accessor-tests name [a-human Human])))

(fugue/defproto Light () speed {:default math/inf})

(deftest symbol-defaults
  (proto-tests Light)
  (let [a-light (:new Light)]
    (inst-tests Light a-light)
    (is (number? (a-light :speed)))))

(fugue/defproto Stack () data {:default-fn |@[]})

(deftest mutable-default-fns
  (let [a-stack (:new Stack)
        b-stack (:new Stack)]
    (array/push (a-stack :data) :ok)
    (is (empty? (b-stack :data)))))

(fugue/defproto SharingStack () data {:default @[]})

(deftest mutable-defaults
  (let [a-stack (:new SharingStack)
        b-stack (:new SharingStack)]
    (array/push (a-stack :data) :ok)
    (is (== @[:ok] (b-stack :data)))))

(def inner-stack @[])
(fugue/defproto DeepStack () data {:default-fn |@[inner-stack]})

(deftest inner-references-are-not-copied
  (let [a-stack (:new DeepStack)
        b-stack (:new DeepStack)]
    (put-in a-stack [:data 0 0] :ok)
    (is (== @[@[:ok]] (b-stack :data)))))

(fugue/defproto Container () capacity {:init? true})

(deftest init
  (proto-tests Container)
  (is (thrown? (:new Container)))
  (let [a-container (:new Container 500)]
    (inst-tests Container a-container)
    (is (= 500 (a-container :capacity)))
    (accessor-tests capacity [a-container Container])))

(fugue/defproto Concat () left {:init? true} right {:init? true})

(deftest multi-inits
  (is (thrown? (:new Concat "left"))))

(fugue/defproto Citizen () president {:allocation :prototype})

(deftest allocation
  (proto-tests Citizen)
  (let [a-citizen (:new Citizen)
        another-citizen (:new Citizen)]
    (inst-tests Citizen a-citizen)
    (fugue/allocate a-citizen :president "The Next Guy")
    # Allocating a field on one instance sets the value on the
    # prototype, and thus is inherited by all instances.
    (is (= "The Next Guy" (Citizen :president)))
    (is (= "The Next Guy" (another-citizen :president)))
    (accessor-tests president [a-citizen another-citizen Citizen])))

(fugue/defproto Editor () mode {:allocate-value "vi"})
(fugue/defproto Light () speed {:allocate-value math/inf})

(deftest allocate-value
  (proto-tests Editor)
  (let [an-editor (:new Editor)
        another-editor (:new Editor)
        some-light (:new Light)]
    (inst-tests Editor an-editor)
    (fugue/allocate an-editor :mode "emacs")
    # The prototype has been allocated a value for `:mode`, which is
    # inherited; but allocating a new value to an instance shadows, it
    # doesn't overwrite.
    (is (= "vi" (Editor :mode)))
    (is (= "vi" (another-editor :mode)))
    (is (= "emacs" (an-editor :mode)))
    (accessor-tests mode [an-editor another-editor Editor])
    (is (= :number (type (some-light :speed))))
    (is (> (some-light :speed) 0))))

(fugue/defproto Dog ()
                name {:allocate-value "Fido"}
                collar-color {:default "blue"})
(fugue/defproto Pekingese Dog
                size {:default "Extremely Small"})

(deftest inheritance
  (is (= Dog (table/getproto Pekingese)))

  (let [a-pekingese (:new Pekingese)]

    (inst-tests Pekingese a-pekingese)
    (accessor-tests name [a-pekingese Dog Pekingese])
    (accessor-tests size [a-pekingese Pekingese])

    (is (nil? (size Dog)))
    (is (= "Fido" (name a-pekingese)))
    (is (= "Extremely Small" (size a-pekingese)))

    (is (Pekingese? a-pekingese))

    (is (Dog? Pekingese))
    (is (not (Dog? a-pekingese)))

    (is (Dog*? a-pekingese))
    (is (Dog*? Pekingese))

    (is (= "blue" (collar-color a-pekingese)))))

(fugue/defproto Form () unique-field {:getter get-unique-field})

(deftest getter
  (let [a-form (:new Form :unique-field :echo)]
    (is (nil? (dyn 'unique-field)))
    (is (= :echo (get-unique-field a-form)))
    (is (= :echo (Form/get-unique-field a-form)))))

(fugue/defproto Form2 () second-unique-field {:getter false})

(deftest no-getter
  (let [a-form (:new Form :second-unique-field :echo)]
    (is (nil? (dyn 'second-unique-field)))))

(fugue/defproto Caster ())
(fugue/defmethod _init Caster [inst] (freeze inst))

(deftest after-init
  (let [casted (:new Caster)]
    (is (not (table? casted)))
    (is (struct? casted))))

(fugue/defgeneric do-nothing [_] :ok)
(fugue/defgeneric raise [_])
(fugue/defgeneric shout [x] (string x "!"))

(deftest generics
  (let [shouting-Dog (:new Dog)]
    (put shouting-Dog :shout (fn [self] (string (name self) "!")))

    (is (= :ok (do-nothing :ok)))
    (is (thrown? (raise :ok)))
    (is (= "hi!" (shout "hi")))
    (is (= "Fido!" (shout shouting-Dog)))))

(fugue/defmethod speak Dog [self] (string "My name is " (self :name)))
(fugue/defmethod speak Pekingese [self] (string (__super self) " and I am " (self :size)))

(deftest methods
  (let [a-pekingese (:new Pekingese)]
    (is (= "My name is Fido and I am Extremely Small" (speak a-pekingese)))
    (is (thrown? (speak (:new Editor))))))

(fugue/defmethod speak2 Dog [self speech] (string "Speak the speech, " speech))

(deftest n-arg methods
  (let [a-dog (:new Dog)]
    (is (= "Speak the speech, I am a dog." (speak2 a-dog "I am a dog.")))))

(fugue/defmethod eat Dog
                 [self & objects]
                 (string (self :name) " eats all of " (string/join objects ", ")))

(deftest ampersand
  (let [a-dog (:new Dog)]
    (is (= "Fido eats all of ball, shoe" (eat a-dog "ball" "shoe")))))

(fugue/defmulti add [Animal] [f] (put f :value 1))
(fugue/defmulti add [:number] [x] (+ x 1))
(fugue/defmulti add [:string] [s] (string s "!"))

(deftest multimethods
  (let [an-animal (:new Animal)]
    (add an-animal)
    (is (= 11 (add 10)))
    (is (= "s!" (add "s")))
    (is (= 1 (an-animal :value)))))

(fugue/defmulti cat [:string _] [s1 s2] (string s1 s2))
(fugue/defmulti cat [:string :number] [s n] (string s " #" n))
(fugue/defmulti cat [_ :number] [m n] (+ m n))
(fugue/defmulti cat [_ _] [x y] (string/format "Falling back to %q<>%q" x y))

(deftest multi-specialization
  # [:string :string] matches [:string :_]
  (is (= "hello world" (cat "hello " @"world")))
  # [:string :number] matches [:string :_] and [:_ :number], but
  # [:string :number] is more specific
  (is (= "hello #100" (cat "hello" 100)))
  # [:number :number] matches [:_ :number]}
  (is (= 9 (cat 4 5)))
  # [:_ :_] will never match before a more specific typing
  (is (= "Falling back to @\"x\"<>@\"y\"" (cat @"x" @"y"))))

(fugue/defmulti cat2 [_ :number] [n m] (+ n m))
(fugue/defmulti cat2 [:string _] [s s2] (string s "+" s2))

(deftest positional-specialization
  # Both [:_ :number] and [:string :_] match, but where there are
  # multiple matches, choose the typing with the more specific term in
  # the earliest position.
  (is (= "x+2" (cat2 "x" 2))))

(fugue/defproto Stack ())
(fugue/defproto Operation ())

(fugue/defmulti push [Stack _] [_ _] :fallback)
(fugue/defmulti push [Stack Operation] [_ _] :pattern-match)

(deftest proto-specialization
  (let [s (:new Stack)
        add (:new Operation)]
    (is (= :fallback (push s 5)))
    (is (= :pattern-match (push s add)))))

(fugue/defmulti to-string [:number] [n] (string "+" n))
(do
  (fugue/defmulti to-string [:string] [s] (string s "!")))

(fugue/declare-open-multi to-string2)
(do
  (fugue/extend-multi to-string2 [:number] [n] (string "+" n))
  (fugue/extend-multi to-string2 [:string] [s] (string s "!")))

(deftest open-multimethods
  # normal multimethods obey scoping rules; a scoped def is not
  # available in enclosing (or adjacent) environments.
  (is (= "+10" (to-string 10)))
  (is (thrown? (to-string "s")))

  # open methods can be extended from other scopes.
  (is (= "s!" (to-string2 "s")))
  (is (= "+10" (to-string2 10))))

(fugue/declare-open-multi to-string3)
(defn inner-f [] :ok)
(fugue/extend-multi to-string3 [:number] [n] (inner-f))
(defn inner-f [] :notok)
(fugue/extend-multi to-string3 [:string] [n] "trigger redefinition of to-string3")

(deftest multi-closures
  (is (= :ok (to-string3 10))))

(deftest multimethod-type-validation
  (is (thrown? (apply fugue/defmulti ['bongo ["ok"] ['x] :ok]))))

(def bare-table @{})
(def child (table/setproto @{} bare-table))
(fugue/defmulti match-on-table [bare-table] [_] :ok)

(deftest table-multimethod
  (is (= :ok (match-on-table child)))
  (is (thrown? (match-on-table @{}))))

(deftest new-root
  (let [a-root (:new fugue/Root)]
    (inst-tests fugue/Root a-root)))

(deftest defproto-in-test
  (fugue/defproto InTest ())
  (proto-tests InTest)
  (let [a-in-test (:new InTest)]
    (inst-tests InTest a-in-test)))

(deftest defgeneric-in-test
  (fugue/defgeneric in-test [x] (string x " ok"))
  (is (= "a ok" (in-test "a"))))

(deftest defmethod-in-test
  (fugue/defproto HasMethod ())
  (fugue/defmethod in-test HasMethod [m] (m :name))
  (let [a-has-method (:new HasMethod :name "dobby")]
    (is (= "dobby" (in-test a-has-method)))))

(deftest defmulti-in-test
  (fugue/defmulti in-test-multi [:number] [n] (inc n))
  (is (= 2 (in-test-multi 1))))

(deftest extend-multi-in-test
  (fugue/declare-open-multi open-in-test)
  (fugue/extend-multi open-in-test [:number] [n] (inc n))
  (is (= 2 (open-in-test 1))))

(fugue/declare-open-multi open-headless)

(deftest open-defaults
  (is (thrown? (open-headless))))

(import /test-support/a)
(import /test-support/b)

(deftest multiple-file-multi-extend 
  (is (= 11 (a/f 10))))

(run-tests!)