nostr/more-speech
1
0
Fork 0
mirror of https://github.com/unclebob/more-speech.git synced 2024-09-30 18:40:47 +00:00
Code Issues Packages Projects Releases Wiki Activity

I found a test that repeats my threading bug. It is currently failing.

Browse Source
This commit is contained in:
Robert C. Martin 2022-06-03 11:23:47 -05:00
parent 3e7b3d4afe
commit afd4dc7a16
2 changed files with 188 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

180
spec/more_speech/ui/swing/article_tree_spec.clj
View File

@ -1,4 +1,5 @@
(ns more-speech.ui.swing.article-tree-spec (ns more-speech.ui.swing.article-tree-spec
(:use [seesaw core font tree])
(:require [speclj.core :refer :all] (:require [speclj.core :refer :all]
[more-speech.ui.swing.article-tree :refer :all] [more-speech.ui.swing.article-tree :refer :all]
[more-speech.ui.swing.article-tree-util :refer :all] [more-speech.ui.swing.article-tree-util :refer :all]
@ -7,6 +8,8 @@
[more-speech.ui.swing.article-panel :as article-panel]) [more-speech.ui.swing.article-panel :as article-panel])
(:import (javax.swing.tree DefaultMutableTreeNode))) (:import (javax.swing.tree DefaultMutableTreeNode)))
(defn hexify [n] (util/num32->hex-string n))
(describe "header tree" (describe "header tree"
(context "finding chronological insertion point" (context "finding chronological insertion point"
(it "returns zero if empty tree" (it "returns zero if empty tree"
@ -336,3 +339,180 @@
(should= [[tab-name selected-event-id]] event-history) (should= [[tab-name selected-event-id]] event-history)
(should= 0 back-count))))) (should= 0 back-count)))))
) )
(declare depict-tree
make-event-map
add-events)
(describe "adding events"
(with-stubs)
(it "adds one event"
(let [tab-id :tab
filter {:selected []
:blocked []}
header-tree (make-header-tree tab-id)
_ (config! header-tree :id tab-id :user-data filter)
frame (frame :content header-tree)
event-id 99
event {:id event-id}
event-state {:tabs {tab-id nil}}
event-context (atom event-state)]
(reset! ui-context {:frame frame
:event-context event-context})
(add-event event)
(should= ["Root" [event-id]] (depict-tree header-tree))))
(it "adds two events"
(with-redefs [render-event (stub :render-event)]
(let [tab-id :tab
filter {:selected []
:blocked []}
header-tree (make-header-tree tab-id)
_ (config! header-tree :id tab-id :user-data filter)
frame (frame :content header-tree)
event-list [{:id 99 :created-at 2} {:id 88 :created-at 1}]
event-map (make-event-map event-list)
event-state {:tabs {tab-id nil}
:text-event-map event-map}
event-context (atom event-state)]
(reset! ui-context {:frame frame
:event-context event-context})
(add-events event-list)
(should= ["Root" [99] [88]] (depict-tree header-tree)))))
(it "adds four events and keeps them in reverse chronologial order"
(with-redefs [render-event (stub :render-event)]
(let [tab-id :tab
filter {:selected []
:blocked []}
header-tree (make-header-tree tab-id)
_ (config! header-tree :id tab-id :user-data filter)
frame (frame :content header-tree)
event-list [{:id 99 :created-at 1}
{:id 88 :created-at 2}
{:id 77 :created-at 3}
{:id 66 :created-at 4}]
event-map (make-event-map event-list)
event-state {:tabs {tab-id nil}
:text-event-map event-map}
event-context (atom event-state)]
(reset! ui-context {:frame frame
:event-context event-context})
(add-events event-list)
(should= ["Root" [66] [77] [88] [99]] (depict-tree header-tree)))))
(it "adds an event, and a reply when received in order."
(with-redefs [render-event (stub :render-event)]
(let [tab-id :tab
filter {:selected []
:blocked []}
header-tree (make-header-tree tab-id)
_ (config! header-tree :id tab-id :user-data filter)
frame (frame :content header-tree)
event-list [{:id 99 :created-at 1}
{:id 88 :created-at 2 :tags [[:e (hexify 99) "" "reply"]]}
]
event-map (make-event-map event-list)
event-state {:tabs {tab-id nil}
:text-event-map event-map}
event-context (atom event-state)]
(reset! ui-context {:frame frame
:event-context event-context})
(add-events event-list)
(should= ["Root" [88] [99 [88]]] (depict-tree header-tree)))))
(it "adds an event, and a reply when received out of order."
(with-redefs [render-event (stub :render-event)]
(let [tab-id :tab
filter {:selected []
:blocked []}
header-tree (make-header-tree tab-id)
_ (config! header-tree :id tab-id :user-data filter)
frame (frame :content header-tree)
event-list [{:id 88 :created-at 2 :tags [[:e (hexify 99) "" "reply"]]}
{:id 99 :created-at 1}]
event-map (make-event-map event-list)
event-state {:tabs {tab-id nil}
:text-event-map event-map}
event-context (atom event-state)]
(reset! ui-context {:frame frame
:event-context event-context})
(add-events event-list)
(should= ["Root" [88] [99 [88]]] (depict-tree header-tree)))))
(it "adds a chain of replies in order."
(with-redefs [render-event (stub :render-event)]
(let [tab-id :tab
filter {:selected []
:blocked []}
header-tree (make-header-tree tab-id)
_ (config! header-tree :id tab-id :user-data filter)
frame (frame :content header-tree)
event-list [{:id 99 :created-at 1}
{:id 88 :created-at 2 :tags [[:e (hexify 99) "" "reply"]]}
{:id 77 :created-at 3 :tags [[:e (hexify 88) "" "reply"]]}
{:id 66 :created-at 4 :tags [[:e (hexify 77) "" "reply"]]}
{:id 55 :created-at 5 :tags [[:e (hexify 88) "" "reply"]]}
]
event-map (make-event-map event-list)
event-state {:tabs {tab-id nil}
:text-event-map event-map}
event-context (atom event-state)]
(reset! ui-context {:frame frame
:event-context event-context})
(add-events event-list)
(should= ["Root" [55] [66] [77 [66]] [88 [77 [66]] [55]] [99 [88 [77 [66]] [55]]]] (depict-tree header-tree)))))
(it "adds a chain of replies in reverse order."
(with-redefs [render-event (stub :render-event)]
(let [tab-id :tab
filter {:selected []
:blocked []}
header-tree (make-header-tree tab-id)
_ (config! header-tree :id tab-id :user-data filter)
frame (frame :content header-tree)
event-list [{:id 99 :created-at 1}
{:id 88 :created-at 2 :tags [[:e (hexify 99) "" "reply"]]}
{:id 77 :created-at 3 :tags [[:e (hexify 88) "" "reply"]]}
{:id 66 :created-at 4 :tags [[:e (hexify 77) "" "reply"]]}
{:id 55 :created-at 5 :tags [[:e (hexify 88) "" "reply"]]}
]
event-list (reverse event-list)
event-map (make-event-map event-list)
event-state {:tabs {tab-id nil}
:text-event-map event-map}
event-context (atom event-state)]
(reset! ui-context {:frame frame
:event-context event-context})
(add-events event-list)
(should= ["Root" [55] [66] [77 [66]] [88 [77 [66]] [55]] [99 [88 [77 [66]] [55]]]] (depict-tree header-tree)))))
)
(declare depict-node)
(defn depict-tree [tree]
(let [model (config tree :model)
root (.getRoot model)]
(depict-node model root)))
(defn depict-node [model node]
(loop [ns (range (.getChildCount node))
node-depiction [(.getUserObject node)]]
(if (empty? ns)
node-depiction
(let [n (first ns)
child (.getChild model node n)]
(recur (rest ns) (conj node-depiction (depict-node model child)))))))
(defn make-event-map [event-list]
(loop [event-list event-list
event-map {}]
(if (empty? event-list)
event-map
(let [event (first event-list)]
(recur (rest event-list) (assoc event-map (:id event) event))))))
(defn add-events [event-list]
(doseq [event event-list]
(add-event event)))

10
src/more_speech/ui/swing/article_tree.clj
View File

@ -15,7 +15,7 @@
(let [header-tree (tree :renderer render-event (let [header-tree (tree :renderer render-event
:root-visible? false :root-visible? false
:expands-selected-paths? true :expands-selected-paths? true
:model (DefaultTreeModel. (DefaultMutableTreeNode. "Empty")))] :model (DefaultTreeModel. (DefaultMutableTreeNode. "Root")))]
(listen header-tree :selection (partial node-selected tab-name)) (listen header-tree :selection (partial node-selected tab-name))
(listen header-tree :mouse-pressed mouse-pressed) (listen header-tree :mouse-pressed mouse-pressed)
header-tree)) header-tree))
@ -159,15 +159,15 @@
(update-in ui-context [:orphaned-references referent] conj id))))) (update-in ui-context [:orphaned-references referent] conj id)))))
(defn node-contains? [node id] (defn node-contains? [node id]
(loop [child-indeces (range (.getChildCount node))] (loop [child-indices (range (.getChildCount node))]
(if (empty? child-indeces) (if (empty? child-indices)
false false
(let [child-index (first child-indeces) (let [child-index (first child-indices)
child (.getChildAt node child-index) child (.getChildAt node child-index)
child-id (.getUserObject child)] child-id (.getUserObject child)]
(if (= child-id id) (if (= child-id id)
true true
(recur (rest child-indeces))))) (recur (rest child-indices)))))
)) ))
(defn add-this-node-to-reference-nodes [reference-nodes this-id] (defn add-this-node-to-reference-nodes [reference-nodes this-id]