nandi/jolt-native · tests.clj

⑂ 58ad86aa2dca060f90c0bbfe7843e249e0f08402

tests.clj · 181 lines · 7.2 KBClojure    Blame HistoryRaw
Write dvui's shape in jolt, on SDL3, with no shared object  Veronika Winters 1(ns glimmer-jvui.tests
"Every check here runs headless: no window, no SDL, no font, no display.
 jvui takes its measurer as a function, so the whole stack — glimmer's
 reconciler, this backend's walk, jvui's layout and event routing — can be
 driven with a stub that says eight pixels a character. `jolt test`."
(:require [glimmer.ratom :as ra]
          [glimmer.core :as gui]
          [glimmer-jvui.core :as jv]
          [jvui.core :as c]))
12(def ^:private failures (atom 0))
14(defn- check! [ok? msg]
(when-not ok?
  (swap! failures inc)
  (println "  FAIL:" msg)))
19(defn- ctx []
(c/context {:size [400 300]
            :measure (fn [s _] [(* 8.0 (count s)) 16.0])
            :line-height (fn [_] 16.0)}))
24(defn- walk [n] (cons n (mapcat walk (:children @n))))
25(defn- tagged [root tag] (first (filter #(= tag (:tag @%)) (walk root))))
26(defn- labels [root]
(map #(str (:label (:props @%)))
     (filter #(= :label (:tag @%)) (walk root))))
30(defn- centre
"The middle of the rectangle jvui gave this node on the last walk."
(let [[x y w h] (:rect @n)] [(+ x (/ w 2.0)) (+ y (/ h 2.0))]))
35(defn- click-at [x y]
[{:kind :motion :x x :y y}
 {:kind :mouse-down :x x :y y :button 1 :clicks 1}
 {:kind :mouse-up :x x :y y :button 1}])
40;; --- the reconciler reaches the backend --------------------------------------
42(def ^:private clicks (ra/atom 0))
43(def ^:private on? (ra/atom false))
45(defn- app []
[:card {}
 [:title {:label "Counter"}]
 [:label {:label (str "Count: " (ra/deref clicks))}]
 [:button {:label "+1" :kind :primary :on-click #(ra/swap! clicks inc)}]
 [:checkbox {:label "loud" :checked (ra/deref on?)
             :on-change #(ra/reset! on? %)}]])
53(defn- check-tree! []
(let [root (jv/root-node)]
  (gui/mount root :page [app])
  (check! (some? (tagged root :card)) "the reconciler built a card")
  (check! (some? (tagged root :button)) "and a button")
  (check! (some #{"Count: 0"} (labels root))
          "and a label that read the ratom")))
61(defn- check-walk-places-widgets! []
(let [root (jv/root-node) cx (ctx)]
  (gui/mount root :page [app])
  (jv/render-once root cx)
  (let [placed (vals (:data @cx))
        card (first (filter #(and (:rect %) (> (first (:min-size % [0 0])) 100))
                            placed))]
    (check! (some? card) "the walk placed a container with a rectangle")
    (check! (every? (fn [[_ _ w h]] (and (>= w 0) (>= h 0)))
                    (keep :rect placed))
            "and no rectangle came out negative"))))
73;; --- a click goes all the way round ------------------------------------------
75(defn- check-click-fires-the-handler! []
(let [root (jv/root-node) cx (ctx)]
  (ra/reset! clicks 0)
  (gui/mount root :page [app])
  (jv/render-once root cx)
  (jv/render-once root cx)
  (let [before (ra/deref clicks)
        [bx by] (centre (tagged root :button))]
    (jv/render-once root cx (click-at bx by))
    (check! (= (inc before) (ra/deref clicks))
            (str "the click reached :on-click (" before " -> "
                 (ra/deref clicks) ")"))
    (jv/render-once root cx)
    (check! (some #{(str "Count: " (ra/deref clicks))} (labels root))
            "and the reactive re-render reached the tree"))))
91(defn- check-press-alone-is-not-a-click! []
(let [root (jv/root-node) cx (ctx)]
  (ra/reset! clicks 0)
  (gui/mount root :page [app])
  (jv/render-once root cx)
  (jv/render-once root cx)
  (let [[bx by] (centre (tagged root :button))]
    (jv/render-once root cx [{:kind :motion :x bx :y by}
                             {:kind :mouse-down :x bx :y by :button 1 :clicks 1}]))
  (check! (zero? (ra/deref clicks)) "a press alone must not fire the handler")
  (jv/render-once root cx [{:kind :motion :x 390 :y 290}
                           {:kind :mouse-up :x 390 :y 290 :button 1}])
  (check! (zero? (ra/deref clicks)) "and releasing off it must not either")))
105;; --- identity follows the node, not its index --------------------------------
107(defn- check-reorder-keeps-identity! []
;; The reason every node carries a serial as its jvui key. Render a list,
;; reorder it, and the ids the walk hands out must travel with the nodes.
(let [root (jv/root-node) cx (ctx)
      items (ra/atom [:a :b :c])
      list-app (fn []
                 (into [:vbox {}]
                       (for [k (ra/deref items)]
                         ^{:key k} [:button {:label (name k)}])))
      ids (fn [] (into {} (map (fn [n] [(:label (:props @n)) (:key @n)])
                               (filter #(= :button (:tag @%)) (walk root)))))]
  (gui/mount root :page [list-app])
  (jv/render-once root cx)
  (let [before (ids)]
    (ra/reset! items [:c :a :b])
    (jv/render-once root cx)
    (let [after (ids)]
      (check! (= 3 (count after)) "the list still has three buttons")
      (check! (= (get before "a") (get after "a"))
              "a keyed node keeps its jvui key across a reorder")
      (check! (= (get before "c") (get after "c"))
              "including the one that moved to the front")))))
130;; --- the vocabulary ----------------------------------------------------------
132(defn- check-unknown-tag-is-a-container! []
(let [root (jv/root-node) cx (ctx)]
  (gui/mount root :page [(fn [] [:flerb {} [:label {:label "inside"}]])])
  (jv/render-once root cx)
  (check! (some #{"inside"} (labels root))
          "an unknown tag shows its contents rather than raising")))
139(defn- check-entry-round-trips! []
(let [root (jv/root-node) cx (ctx)
      text (ra/atom "")]
  (gui/mount root :page
             [(fn [] [:entry {:value (ra/deref text)
                              :on-change #(ra/reset! text %)}])])
  (jv/render-once root cx)
  (let [[ex ey] (centre (tagged root :entry))]
    (jv/render-once root cx (click-at ex ey)))       ; take focus
  (jv/render-once root cx [{:kind :text :text "hi"}])
  (check! (= "hi" (ra/deref text))
          (str "typed text reached :on-change: " (pr-str (ra/deref text))))))
152(defn- check-checkbox-round-trips! []
(let [root (jv/root-node) cx (ctx)]
  (ra/reset! on? false)
  (gui/mount root :page [app])
  (jv/render-once root cx)
  (jv/render-once root cx)
  (let [[bx by] (centre (tagged root :checkbox))]
    (jv/render-once root cx (click-at bx by)))
  (check! (true? (ra/deref on?))
          (str "the checkbox reached :on-change: " (ra/deref on?)))))
163;; --- runner ------------------------------------------------------------------
165(def ^:private checks
[["the reconciler builds a tree"  check-tree!]
 ["the walk places widgets"       check-walk-places-widgets!]
 ["a click fires the handler"     check-click-fires-the-handler!]
 ["a press alone does not"        check-press-alone-is-not-a-click!]
 ["a reorder keeps identity"      check-reorder-keeps-identity!]
 ["an unknown tag is a container" check-unknown-tag-is-a-container!]
 ["an entry round-trips"          check-entry-round-trips!]
 ["a checkbox round-trips"        check-checkbox-round-trips!]])
175(defn -main [& _]
(doseq [[name f] checks]
  (println "-" name)
178
(if (zero? @failures)
  (println "\nall" (count checks) "checks passed")
  (do (println "\n" @failures "failed") (System/exit 1))))

Write dvui's shape in jolt, on SDL3, with no shared object 109c7e4 Veronika Winters 9d ago	1	(ns glimmer-jvui.tests
	2	"Every check here runs headless: no window, no SDL, no font, no display.
	3
	4	jvui takes its measurer as a function, so the whole stack — glimmer's
	5	reconciler, this backend's walk, jvui's layout and event routing — can be
	6	driven with a stub that says eight pixels a character. `jolt test`."
	7	(:require [glimmer.ratom :as ra]
	8	[glimmer.core :as gui]
	9	[glimmer-jvui.core :as jv]
	10	[jvui.core :as c]))
	11
	12	(def ^:private failures (atom 0))
	13
	14	(defn- check! [ok? msg]
	15	(when-not ok?
	16	(swap! failures inc)
	17	(println " FAIL:" msg)))
	18
	19	(defn- ctx []
	20	(c/context {:size [400 300]
	21	:measure (fn [s _] [(* 8.0 (count s)) 16.0])
	22	:line-height (fn [_] 16.0)}))
	23
	24	(defn- walk [n] (cons n (mapcat walk (:children @n))))
	25	(defn- tagged [root tag] (first (filter #(= tag (:tag @%)) (walk root))))
	26	(defn- labels [root]
	27	(map #(str (:label (:props @%)))
	28	(filter #(= :label (:tag @%)) (walk root))))
	29
	30	(defn- centre
	31	"The middle of the rectangle jvui gave this node on the last walk."
	32	[n]
	33	(let [[x y w h] (:rect @n)] [(+ x (/ w 2.0)) (+ y (/ h 2.0))]))
	34
	35	(defn- click-at [x y]
	36	[{:kind :motion :x x :y y}
	37	{:kind :mouse-down :x x :y y :button 1 :clicks 1}
	38	{:kind :mouse-up :x x :y y :button 1}])
	39
	40	;; --- the reconciler reaches the backend --------------------------------------
	41
	42	(def ^:private clicks (ra/atom 0))
	43	(def ^:private on? (ra/atom false))
	44
	45	(defn- app []
	46	[:card {}
	47	[:title {:label "Counter"}]
	48	[:label {:label (str "Count: " (ra/deref clicks))}]
	49	[:button {:label "+1" :kind :primary :on-click #(ra/swap! clicks inc)}]
	50	[:checkbox {:label "loud" :checked (ra/deref on?)
	51	:on-change #(ra/reset! on? %)}]])
	52
	53	(defn- check-tree! []
	54	(let [root (jv/root-node)]
	55	(gui/mount root :page [app])
	56	(check! (some? (tagged root :card)) "the reconciler built a card")
	57	(check! (some? (tagged root :button)) "and a button")
	58	(check! (some #{"Count: 0"} (labels root))
	59	"and a label that read the ratom")))
	60
	61	(defn- check-walk-places-widgets! []
	62	(let [root (jv/root-node) cx (ctx)]
	63	(gui/mount root :page [app])
	64	(jv/render-once root cx)
65	(let [placed (vals (:data @cx))
66	card (first (filter #(and (:rect %) (> (first (:min-size % [0 0])) 100))
67	placed))]
68	(check! (some? card) "the walk placed a container with a rectangle")
69	(check! (every? (fn [[_ _ w h]] (and (>= w 0) (>= h 0)))
70	(keep :rect placed))
71	"and no rectangle came out negative"))))
72
73	;; --- a click goes all the way round ------------------------------------------
74
75	(defn- check-click-fires-the-handler! []
76	(let [root (jv/root-node) cx (ctx)]
77	(ra/reset! clicks 0)
78	(gui/mount root :page [app])
79	(jv/render-once root cx)
80	(jv/render-once root cx)
81	(let [before (ra/deref clicks)
82	[bx by] (centre (tagged root :button))]
83	(jv/render-once root cx (click-at bx by))
84	(check! (= (inc before) (ra/deref clicks))
85	(str "the click reached :on-click (" before " -> "
86	(ra/deref clicks) ")"))
87	(jv/render-once root cx)
88	(check! (some #{(str "Count: " (ra/deref clicks))} (labels root))
89	"and the reactive re-render reached the tree"))))
90
91	(defn- check-press-alone-is-not-a-click! []
92	(let [root (jv/root-node) cx (ctx)]
93	(ra/reset! clicks 0)
94	(gui/mount root :page [app])
95	(jv/render-once root cx)
96	(jv/render-once root cx)
97	(let [[bx by] (centre (tagged root :button))]
98	(jv/render-once root cx [{:kind :motion :x bx :y by}
99	{:kind :mouse-down :x bx :y by :button 1 :clicks 1}]))
100	(check! (zero? (ra/deref clicks)) "a press alone must not fire the handler")
101	(jv/render-once root cx [{:kind :motion :x 390 :y 290}
102	{:kind :mouse-up :x 390 :y 290 :button 1}])
103	(check! (zero? (ra/deref clicks)) "and releasing off it must not either")))
104
105	;; --- identity follows the node, not its index --------------------------------
106
107	(defn- check-reorder-keeps-identity! []
108	;; The reason every node carries a serial as its jvui key. Render a list,
109	;; reorder it, and the ids the walk hands out must travel with the nodes.
110	(let [root (jv/root-node) cx (ctx)
111	items (ra/atom [:a :b :c])
112	list-app (fn []
113	(into [:vbox {}]
114	(for [k (ra/deref items)]
115	^{:key k} [:button {:label (name k)}])))
116	ids (fn [] (into {} (map (fn [n] [(:label (:props @n)) (:key @n)])
117	(filter #(= :button (:tag @%)) (walk root)))))]
118	(gui/mount root :page [list-app])
119	(jv/render-once root cx)
120	(let [before (ids)]
121	(ra/reset! items [:c :a :b])
122	(jv/render-once root cx)
123	(let [after (ids)]
124	(check! (= 3 (count after)) "the list still has three buttons")
125	(check! (= (get before "a") (get after "a"))
126	"a keyed node keeps its jvui key across a reorder")
127	(check! (= (get before "c") (get after "c"))
128	"including the one that moved to the front")))))
129
130	;; --- the vocabulary ----------------------------------------------------------
131
132	(defn- check-unknown-tag-is-a-container! []
133	(let [root (jv/root-node) cx (ctx)]
134	(gui/mount root :page [(fn [] [:flerb {} [:label {:label "inside"}]])])
135	(jv/render-once root cx)
136	(check! (some #{"inside"} (labels root))
137	"an unknown tag shows its contents rather than raising")))
138
139	(defn- check-entry-round-trips! []
140	(let [root (jv/root-node) cx (ctx)
141	text (ra/atom "")]
142	(gui/mount root :page
143	[(fn [] [:entry {:value (ra/deref text)
144	:on-change #(ra/reset! text %)}])])
145	(jv/render-once root cx)
146	(let [[ex ey] (centre (tagged root :entry))]
147	(jv/render-once root cx (click-at ex ey))) ; take focus
148	(jv/render-once root cx [{:kind :text :text "hi"}])
149	(check! (= "hi" (ra/deref text))
150	(str "typed text reached :on-change: " (pr-str (ra/deref text))))))
151
152	(defn- check-checkbox-round-trips! []
153	(let [root (jv/root-node) cx (ctx)]
154	(ra/reset! on? false)
155	(gui/mount root :page [app])
156	(jv/render-once root cx)
157	(jv/render-once root cx)
158	(let [[bx by] (centre (tagged root :checkbox))]
159	(jv/render-once root cx (click-at bx by)))
160	(check! (true? (ra/deref on?))
161	(str "the checkbox reached :on-change: " (ra/deref on?)))))
162
163	;; --- runner ------------------------------------------------------------------
164
165	(def ^:private checks
166	[["the reconciler builds a tree" check-tree!]
167	["the walk places widgets" check-walk-places-widgets!]
168	["a click fires the handler" check-click-fires-the-handler!]
169	["a press alone does not" check-press-alone-is-not-a-click!]
170	["a reorder keeps identity" check-reorder-keeps-identity!]
171	["an unknown tag is a container" check-unknown-tag-is-a-container!]
172	["an entry round-trips" check-entry-round-trips!]
173	["a checkbox round-trips" check-checkbox-round-trips!]])
174
175	(defn -main [& _]
176	(doseq [[name f] checks]
177	(println "-" name)
178	(f))
179	(if (zero? @failures)
180	(println "\nall" (count checks) "checks passed")
181	(do (println "\n" @failures "failed") (System/exit 1))))