nandi/jolt-native · tests.clj

⑂ 2271a9188bb358e15c020f96d9923f906e495c56

tests.clj · 248 lines · 10.5 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]
Make a list follow what arrives in it   8            [jvui.widgets :as w]
Write dvui's shape in jolt, on SDL3, with no shared object  Veronika Winters 9            [glimmer.core :as gui]
          [glimmer-jvui.core :as jv]
          [jvui.core :as c]))
13(def ^:private failures (atom 0))
15(defn- check! [ok? msg]
(when-not ok?
  (swap! failures inc)
  (println "  FAIL:" msg)))
20(defn- ctx []
(c/context {:size [400 300]
            :measure (fn [s _] [(* 8.0 (count s)) 16.0])
            :line-height (fn [_] 16.0)}))
25(defn- walk [n] (cons n (mapcat walk (:children @n))))
26(defn- tagged [root tag] (first (filter #(= tag (:tag @%)) (walk root))))
27(defn- labels [root]
(map #(str (:label (:props @%)))
     (filter #(= :label (:tag @%)) (walk root))))
31(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))]))
36(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}])
41;; --- the reconciler reaches the backend --------------------------------------
43(def ^:private clicks (ra/atom 0))
44(def ^:private on? (ra/atom false))
46(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? %)}]])
54(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")))
62(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"))))
74;; --- a click goes all the way round ------------------------------------------
76(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"))))
92(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")))
106;; --- identity follows the node, not its index --------------------------------
108(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")))))
131;; --- the vocabulary ----------------------------------------------------------
133(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")))
140(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))))))
Report Enter from a field, and take its width request   153(defn- check-enter-sends! []
;; Enter is the one key a field must not swallow. frq sends its message
;; on it, so a compose box that accepted text and never reported Enter
;; would take a message and have no way to say it was finished — typing
;; works, sending does not, and nothing looks broken.
(let [root (jv/root-node) cx (ctx)
      text (ra/atom "hello")
      sent (ra/atom nil)]
  (gui/mount root :page
             [(fn [] [:entry {:value (ra/deref text)
                              :on-change #(ra/reset! text %)
Fire :on-activate with nothing, wrap a row, and break a word that cannot fit   164                                ;; A THUNK, which is what frq's handlers
                              ;; are: s/send-draft! takes no arguments
                              ;; and the text is already the caller's
                              ;; from :on-change.
                              :on-activate #(ra/reset! sent (ra/deref text))}])])
Report Enter from a field, and take its width request   169    (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 :key-down :key :return}])
  (check! (= "hello" (ra/deref sent))
          (str "Enter reached :on-activate: " (pr-str (ra/deref sent))))))
Make a list follow what arrives in it   176(defn- label-node [root text]
(first (filter #(and (= :label (:tag @%)) (= text (str (:label (:props @%)))))
               (walk root))))
180(defn- check-scroll-sticks! []
;; A chat that does not follow new messages is the difference between a
;; window you read and one you drag.
;; Asserted on GEOMETRY and not on which labels exist: every line is in
;; the tree whether or not it is on screen, so `labels` cannot tell a
;; stuck list from a pinned one. What tells them apart is where the last
;; line was PUT — inside the viewport, or far below it.
(let [root (jv/root-node) cx (ctx)
      n (ra/atom 3)]
  (gui/mount root :page
             [(fn [] [:scroll {:height 60 :scroll-key "chat" :stick-to-bottom true}
                      (into [:vbox {}]
                            (for [i (range (ra/deref n))]
                              [:label {:key i :label (str "line " i)}]))])])
  (dotimes [_ 3] (jv/render-once root cx))
  (ra/reset! n 40)
  (dotimes [_ 3] (jv/render-once root cx))
  ;; Forty lines of sixteen in a sixty-tall viewport leaves a long way
  ;; to scroll. A stuck list is at the far end of it; a pinned one is
  ;; still at zero.
  (let [off (w/scroll-offset "chat")]
    (check! (and off (> off 100.0))
            (str "a stuck list followed its content: offset=" off))
    ;; And it must STOP following once the reader has moved, or they can
    ;; never read anything but the newest line.
    ;; The mouse has to be OVER the list: a wheel is delivered to
    ;; whatever is under the pointer, and the pointer only moves on a
    ;; motion event.
    (jv/render-once root cx [{:kind :motion :x 20 :y 30}])
    (dotimes [_ 4]
      (jv/render-once root cx [{:kind :motion :x 20 :y 30}
                               {:kind :wheel :x 20 :y 30 :dy 3}]))
    (let [off2 (w/scroll-offset "chat")]
      (check! (and off2 (< off2 off))
              (str "and let go when the reader scrolled up: " off " -> " off2))))))
Write dvui's shape in jolt, on SDL3, with no shared object  Veronika Winters 217(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?)))))
228;; --- runner ------------------------------------------------------------------
230(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!]
Make a list follow what arrives in it   237   ["a list sticks to the end"     check-scroll-sticks!]
Report Enter from a field, and take its width request   238   ["Enter sends"                  check-enter-sends!]
Write dvui's shape in jolt, on SDL3, with no shared object  Veronika Winters 239   ["an entry round-trips"          check-entry-round-trips!]
 ["a checkbox round-trips"        check-checkbox-round-trips!]])
242(defn -main [& _]
(doseq [[name f] checks]
  (println "-" name)
245
(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]
Make a list follow what arrives in it 95540ef nandi 9d ago	8	[jvui.widgets :as w]
Write dvui's shape in jolt, on SDL3, with no shared object 109c7e4 Veronika Winters 9d ago	9	[glimmer.core :as gui]
	10	[glimmer-jvui.core :as jv]
	11	[jvui.core :as c]))
	12
	13	(def ^:private failures (atom 0))
	14
	15	(defn- check! [ok? msg]
	16	(when-not ok?
	17	(swap! failures inc)
	18	(println " FAIL:" msg)))
	19
	20	(defn- ctx []
	21	(c/context {:size [400 300]
	22	:measure (fn [s _] [(* 8.0 (count s)) 16.0])
	23	:line-height (fn [_] 16.0)}))
	24
	25	(defn- walk [n] (cons n (mapcat walk (:children @n))))
	26	(defn- tagged [root tag] (first (filter #(= tag (:tag @%)) (walk root))))
	27	(defn- labels [root]
	28	(map #(str (:label (:props @%)))
	29	(filter #(= :label (:tag @%)) (walk root))))
	30
	31	(defn- centre
	32	"The middle of the rectangle jvui gave this node on the last walk."
	33	[n]
	34	(let [[x y w h] (:rect @n)] [(+ x (/ w 2.0)) (+ y (/ h 2.0))]))
	35
	36	(defn- click-at [x y]
	37	[{:kind :motion :x x :y y}
	38	{:kind :mouse-down :x x :y y :button 1 :clicks 1}
	39	{:kind :mouse-up :x x :y y :button 1}])
	40
	41	;; --- the reconciler reaches the backend --------------------------------------
	42
	43	(def ^:private clicks (ra/atom 0))
	44	(def ^:private on? (ra/atom false))
	45
	46	(defn- app []
	47	[:card {}
	48	[:title {:label "Counter"}]
	49	[:label {:label (str "Count: " (ra/deref clicks))}]
	50	[:button {:label "+1" :kind :primary :on-click #(ra/swap! clicks inc)}]
	51	[:checkbox {:label "loud" :checked (ra/deref on?)
	52	:on-change #(ra/reset! on? %)}]])
	53
	54	(defn- check-tree! []
	55	(let [root (jv/root-node)]
	56	(gui/mount root :page [app])
	57	(check! (some? (tagged root :card)) "the reconciler built a card")
	58	(check! (some? (tagged root :button)) "and a button")
	59	(check! (some #{"Count: 0"} (labels root))
	60	"and a label that read the ratom")))
	61
	62	(defn- check-walk-places-widgets! []
	63	(let [root (jv/root-node) cx (ctx)]
	64	(gui/mount root :page [app])
	65	(jv/render-once root cx)
	66	(let [placed (vals (:data @cx))
	67	card (first (filter #(and (:rect %) (> (first (:min-size % [0 0])) 100))
	68	placed))]
	69	(check! (some? card) "the walk placed a container with a rectangle")
	70	(check! (every? (fn [[_ _ w h]] (and (>= w 0) (>= h 0)))
	71	(keep :rect placed))
	72	"and no rectangle came out negative"))))
73
74	;; --- a click goes all the way round ------------------------------------------
75
76	(defn- check-click-fires-the-handler! []
77	(let [root (jv/root-node) cx (ctx)]
78	(ra/reset! clicks 0)
79	(gui/mount root :page [app])
80	(jv/render-once root cx)
81	(jv/render-once root cx)
82	(let [before (ra/deref clicks)
83	[bx by] (centre (tagged root :button))]
84	(jv/render-once root cx (click-at bx by))
85	(check! (= (inc before) (ra/deref clicks))
86	(str "the click reached :on-click (" before " -> "
87	(ra/deref clicks) ")"))
88	(jv/render-once root cx)
89	(check! (some #{(str "Count: " (ra/deref clicks))} (labels root))
90	"and the reactive re-render reached the tree"))))
91
92	(defn- check-press-alone-is-not-a-click! []
93	(let [root (jv/root-node) cx (ctx)]
94	(ra/reset! clicks 0)
95	(gui/mount root :page [app])
96	(jv/render-once root cx)
97	(jv/render-once root cx)
98	(let [[bx by] (centre (tagged root :button))]
99	(jv/render-once root cx [{:kind :motion :x bx :y by}
100	{:kind :mouse-down :x bx :y by :button 1 :clicks 1}]))
101	(check! (zero? (ra/deref clicks)) "a press alone must not fire the handler")
102	(jv/render-once root cx [{:kind :motion :x 390 :y 290}
103	{:kind :mouse-up :x 390 :y 290 :button 1}])
104	(check! (zero? (ra/deref clicks)) "and releasing off it must not either")))
105
106	;; --- identity follows the node, not its index --------------------------------
107
108	(defn- check-reorder-keeps-identity! []
109	;; The reason every node carries a serial as its jvui key. Render a list,
110	;; reorder it, and the ids the walk hands out must travel with the nodes.
111	(let [root (jv/root-node) cx (ctx)
112	items (ra/atom [:a :b :c])
113	list-app (fn []
114	(into [:vbox {}]
115	(for [k (ra/deref items)]
116	^{:key k} [:button {:label (name k)}])))
117	ids (fn [] (into {} (map (fn [n] [(:label (:props @n)) (:key @n)])
118	(filter #(= :button (:tag @%)) (walk root)))))]
119	(gui/mount root :page [list-app])
120	(jv/render-once root cx)
121	(let [before (ids)]
122	(ra/reset! items [:c :a :b])
123	(jv/render-once root cx)
124	(let [after (ids)]
125	(check! (= 3 (count after)) "the list still has three buttons")
126	(check! (= (get before "a") (get after "a"))
127	"a keyed node keeps its jvui key across a reorder")
128	(check! (= (get before "c") (get after "c"))
129	"including the one that moved to the front")))))
130
131	;; --- the vocabulary ----------------------------------------------------------
132
133	(defn- check-unknown-tag-is-a-container! []
134	(let [root (jv/root-node) cx (ctx)]
135	(gui/mount root :page [(fn [] [:flerb {} [:label {:label "inside"}]])])
136	(jv/render-once root cx)
137	(check! (some #{"inside"} (labels root))
138	"an unknown tag shows its contents rather than raising")))
139
140	(defn- check-entry-round-trips! []
141	(let [root (jv/root-node) cx (ctx)
142	text (ra/atom "")]
143	(gui/mount root :page
144	[(fn [] [:entry {:value (ra/deref text)
145	:on-change #(ra/reset! text %)}])])
146	(jv/render-once root cx)
147	(let [[ex ey] (centre (tagged root :entry))]
148	(jv/render-once root cx (click-at ex ey))) ; take focus
149	(jv/render-once root cx [{:kind :text :text "hi"}])
150	(check! (= "hi" (ra/deref text))
151	(str "typed text reached :on-change: " (pr-str (ra/deref text))))))
152
Report Enter from a field, and take its width request c03a752 nandi 9d ago	153	(defn- check-enter-sends! []
	154	;; Enter is the one key a field must not swallow. frq sends its message
	155	;; on it, so a compose box that accepted text and never reported Enter
	156	;; would take a message and have no way to say it was finished — typing
	157	;; works, sending does not, and nothing looks broken.
	158	(let [root (jv/root-node) cx (ctx)
	159	text (ra/atom "hello")
	160	sent (ra/atom nil)]
	161	(gui/mount root :page
	162	[(fn [] [:entry {:value (ra/deref text)
	163	:on-change #(ra/reset! text %)
Fire :on-activate with nothing, wrap a row, and break a word that cannot fit 2271a91 nandi 9d ago	164	;; A THUNK, which is what frq's handlers
	165	;; are: s/send-draft! takes no arguments
	166	;; and the text is already the caller's
	167	;; from :on-change.
	168	:on-activate #(ra/reset! sent (ra/deref text))}])])
Report Enter from a field, and take its width request c03a752 nandi 9d ago	169	(jv/render-once root cx)
	170	(let [[ex ey] (centre (tagged root :entry))]
	171	(jv/render-once root cx (click-at ex ey))) ; take focus
	172	(jv/render-once root cx [{:kind :key-down :key :return}])
	173	(check! (= "hello" (ra/deref sent))
	174	(str "Enter reached :on-activate: " (pr-str (ra/deref sent))))))
	175
Make a list follow what arrives in it 95540ef nandi 9d ago	176	(defn- label-node [root text]
	177	(first (filter #(and (= :label (:tag @%)) (= text (str (:label (:props @%)))))
	178	(walk root))))
	179
	180	(defn- check-scroll-sticks! []
	181	;; A chat that does not follow new messages is the difference between a
	182	;; window you read and one you drag.
	183	;;
	184	;; Asserted on GEOMETRY and not on which labels exist: every line is in
	185	;; the tree whether or not it is on screen, so `labels` cannot tell a
	186	;; stuck list from a pinned one. What tells them apart is where the last
	187	;; line was PUT — inside the viewport, or far below it.
	188	(let [root (jv/root-node) cx (ctx)
	189	n (ra/atom 3)]
	190	(gui/mount root :page
	191	[(fn [] [:scroll {:height 60 :scroll-key "chat" :stick-to-bottom true}
	192	(into [:vbox {}]
	193	(for [i (range (ra/deref n))]
	194	[:label {:key i :label (str "line " i)}]))])])
	195	(dotimes [_ 3] (jv/render-once root cx))
	196	(ra/reset! n 40)
	197	(dotimes [_ 3] (jv/render-once root cx))
	198	;; Forty lines of sixteen in a sixty-tall viewport leaves a long way
	199	;; to scroll. A stuck list is at the far end of it; a pinned one is
	200	;; still at zero.
	201	(let [off (w/scroll-offset "chat")]
	202	(check! (and off (> off 100.0))
	203	(str "a stuck list followed its content: offset=" off))
	204	;; And it must STOP following once the reader has moved, or they can
	205	;; never read anything but the newest line.
	206	;; The mouse has to be OVER the list: a wheel is delivered to
	207	;; whatever is under the pointer, and the pointer only moves on a
	208	;; motion event.
	209	(jv/render-once root cx [{:kind :motion :x 20 :y 30}])
	210	(dotimes [_ 4]
	211	(jv/render-once root cx [{:kind :motion :x 20 :y 30}
	212	{:kind :wheel :x 20 :y 30 :dy 3}]))
	213	(let [off2 (w/scroll-offset "chat")]
	214	(check! (and off2 (< off2 off))
	215	(str "and let go when the reader scrolled up: " off " -> " off2))))))
	216
Write dvui's shape in jolt, on SDL3, with no shared object 109c7e4 Veronika Winters 9d ago	217	(defn- check-checkbox-round-trips! []
	218	(let [root (jv/root-node) cx (ctx)]
	219	(ra/reset! on? false)
	220	(gui/mount root :page [app])
	221	(jv/render-once root cx)
	222	(jv/render-once root cx)
	223	(let [[bx by] (centre (tagged root :checkbox))]
	224	(jv/render-once root cx (click-at bx by)))
	225	(check! (true? (ra/deref on?))
	226	(str "the checkbox reached :on-change: " (ra/deref on?)))))
	227
	228	;; --- runner ------------------------------------------------------------------
	229
	230	(def ^:private checks
	231	[["the reconciler builds a tree" check-tree!]
	232	["the walk places widgets" check-walk-places-widgets!]
	233	["a click fires the handler" check-click-fires-the-handler!]
	234	["a press alone does not" check-press-alone-is-not-a-click!]
	235	["a reorder keeps identity" check-reorder-keeps-identity!]
	236	["an unknown tag is a container" check-unknown-tag-is-a-container!]
Make a list follow what arrives in it 95540ef nandi 9d ago	237	["a list sticks to the end" check-scroll-sticks!]
Report Enter from a field, and take its width request c03a752 nandi 9d ago	238	["Enter sends" check-enter-sends!]
Write dvui's shape in jolt, on SDL3, with no shared object 109c7e4 Veronika Winters 9d ago	239	["an entry round-trips" check-entry-round-trips!]
	240	["a checkbox round-trips" check-checkbox-round-trips!]])
	241
	242	(defn -main [& _]
	243	(doseq [[name f] checks]
	244	(println "-" name)
	245	(f))
	246	(if (zero? @failures)
	247	(println "\nall" (count checks) "checks passed")
	248	(do (println "\n" @failures "failed") (System/exit 1))))