Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Added test-utils

  • Loading branch information...
commit 715c37c321941d88cfbeb9f5bc8d7862410bc048 1 parent 43d85b3
Sean authored
View
15 src/lib/sfd/debug.clj
@@ -115,7 +115,10 @@ well with a SINGLE_TREE_SELECTION model."
"Creates a graphical (Swing) inspector on the supplied hierarchical data"
[data]
(let [expr (agent data)
+ inspector (JFrame. "Clojure Inspector")
tree (JTree. (tree-model @expr))
+ eval-menu (eval-node-menu-item tree)
+ real-seq-menu (realize-seq-menu-item tree)
make-macro-menu (fn [title f vk]
(accel (menu-item title
(fn [evt] (.setModel tree (tree-model (f @expr)))))
@@ -129,8 +132,8 @@ well with a SINGLE_TREE_SELECTION model."
(.setModel tree (tree-model new-data))
new-data))))))
(menu "Exp. Eval"
- (eval-node-menu-item tree)
- (realize-seq-menu-item tree))
+ eval-menu
+ real-seq-menu)
(menu "Macros"
(make-macro-menu "None" identity KeyEvent/VK_1)
(make-macro-menu "Expand" macroexpand KeyEvent/VK_2)
@@ -141,15 +144,15 @@ well with a SINGLE_TREE_SELECTION model."
(do (-> tree .getSelectionModel (.setSelectionMode TreeSelectionModel/SINGLE_TREE_SELECTION))
(doto tree
(.setComponentPopupMenu (popup-menu (make-doc-menu-item tree)
- (eval-node-menu-item tree)
- (realize-seq-menu-item tree)
+ eval-menu
+ real-seq-menu
(menu-item "Sub Inspector"
(fn [evt]
(deep-inspect (get-selected-node tree))))))
;(.setCellRenderer tree-renderer)
)
- (doto (JFrame. "Clojure Inspector")
+ (doto inspector
(.add (JScrollPane. tree))
(.setJMenuBar mb)
- (.setSize 400 400)
+ (.setSize 720 480)
(.setVisible true)))))
View
4 src/lib/sfd/swing/messages.clj
@@ -1,9 +1,11 @@
(ns lib.sfd.swing.messages
(:import [javax.swing JOptionPane JFileChooser]))
+(def *parent-frame* nil)
+
(defn messenger-factory
[message-type]
- (fn [m t] (JOptionPane/showMessageDialog nil m t message-type nil)))
+ (fn [m t] (JOptionPane/showMessageDialog parnet-frame m t message-type nil)))
(defn plain-message
"Creates a dialog that shows a plain message. Will block the thread it is in. Returns nil."
View
6 src/lib/sfd/table_utils.clj
@@ -87,9 +87,9 @@ join function is provided, it is used on both the left & right hand sides.")
(defn natural-join
"Performs the natural join. If there are no keys that intersect, the join is not performed."
[left-coll right-coll]
- (let [left-keys (keys (first left-coll))
- right-keys (keys (first right-coll))
- intersect (intersection (set left-keys) (set right-keys))]
+ (let [intersect (apply intersection
+ (map (comp set keys first)
+ [left-coll right-coll]))]
(if (empty? intersect)
[]
(inner-join left-coll right-coll (apply fn-tuple intersect)))))
View
46 src/lib/sfd/test_utils.clj
@@ -0,0 +1,46 @@
+(ns lib.sfd.test-utils
+ (:use clojure.test))
+
+(defmacro defspec
+ "This macro is designed to define an abstract specification, that
+accepts specific implementations based on bindings. Designed to test
+interfaces & protocols for invariant behavior."
+ [name bindings & body]
+ `(def ~name (quote [~bindings ~@body])))
+
+(defmacro enforce
+ "This is what actually enforces an abtract specification. A test case
+is created with the name mangled based on the spec and implementation."
+ [spec & impl]
+ (let [test-name (symbol (apply str (name spec) "-" (map name impl)))]
+ `(let ~(vec (interleave (first (eval spec)) impl))
+ (deftest ~test-name
+ ~@(rest (eval spec))))))
+
+
+;;----------------
+;; Example
+;;----------------
+(defspec rotate-spec
+ [rotate-imp]
+ (are [n] (= (rotate-imp n []) '())
+ -6 -5 -4 -3 -2 -1 0 1 2 3 4 5 6)
+ (are [n] (= (count (rotate-imp n test-vec)) (count test-vec))
+ -6 -5 -4 -3 -2 -1 0 1 2 3 4 5 6)
+ (are [n coll] (= (rotate-imp n test-vec) (seq coll))
+ -6 [5 1 2 3 4]
+ -5 [1 2 3 4 5]
+ -4 [2 3 4 5 1]
+ -3 [3 4 5 1 2]
+ -2 [4 5 1 2 3]
+ -1 [5 1 2 3 4]
+ 0 [1 2 3 4 5]
+ 1 [2 3 4 5 1]
+ 2 [3 4 5 1 2]
+ 3 [4 5 1 2 3]
+ 4 [5 1 2 3 4]
+ 5 [1 2 3 4 5]
+ 6 [2 3 4 5 1]))
+
+;Would be called like so
+;(enforce rotate-spec a-specific-implementation)
Please sign in to comment.
Something went wrong with that request. Please try again.