forked from Licenser/clj-sandbox
/
tester.clj
125 lines (108 loc) · 3.75 KB
/
tester.clj
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
(ns net.licenser.sandbox.tester
(:use (net.licenser.sandbox matcher safe-fns))
(:require [clojure.set :as set]))
(try
(require '[clojure.contrib.seq-utils :as su])
(catch Exception e (require '[clojure.contrib.seq :as su])))
(defn s-seq
"Convertns a form into a sequence."
[form]
(tree-seq #(and (coll? %) (not (empty? %)))
#(let [a (macroexpand %)]
(or (and (coll? a)
(seq a))
(list a)))
form))
; Weeh thanks to bsteuber for advice on resolve!
(defn fn-seq
"Converts a form into a sequence of functions."
[form]
(remove nil? (map (fn [s]
(if (some (partial = s) '(fn* let* def loop* recur new .))
s
(resolve s)))
(filter symbol? (s-seq form)))))
(defn whitelist
"Creates a whitelist of testers. Testers take a var and unless
they return true the test will fail."
([test & tests]
{:type :whitelist
:tests (apply combine-matchers test tests)})
([test]
{:type :whitelist
:tests test}))
(defn blacklist
"Creates a blacklist of testers. Testers take a var and if they
return true the blacklist will fail the test."
([test & tests]
{:type :blacklist
:tests (apply combine-matchers test tests)})
([test]
{:type :blacklist
:tests test}))
(defn run-list [p l t]
(p true? (su/flatten (map #(% t) l))))
(defn new-tester
"Creates a new tester combined from a set of black and whitelists.
Usage: (new-tester (whitelist (function-matcher 'println)))
This returns a tester that takes 2 arguments a function, and a namespace."
[& definitions]
(let [{wl :whitelist bl :blacklist} (reduce #(assoc %1 (:type %2)
(conj (get %1 (:type %2))
(:tests %2))) {} definitions)]
(fn
([]
[new-tester definitions])
([form nspace]
(let [forms (if (= (type form) clojure.lang.Var) (list form) (fn-seq form))]
(if (empty? forms)
true
(let [r (map
(fn [f]
(and
(run-list some (conj wl (namespace-matcher nspace)) f)
(run-list not-any? bl f)))
forms)]
(and (not (empty? r)) (every? true? r)))))))))
(defn new-object-tester
"Creates a new tester combined from a set of black and whitelists.
Usage: (new-tester (whitelist (function-matcher 'println)))
This returns a tester that takes 2 arguments a function, and a namespace."
[& definitions]
(let [{wl :whitelist bl :blacklist} (reduce #(assoc %1 (:type %2)
(conj (get %1 (:type %2))
(:tests %2))) {} definitions)]
(fn
([]
[new-object-tester definitions])
([object method]
(let [method (symbol method)
c (type object)]
(and
(run-list not-any? bl c)
(run-list not-any? bl method)
(or
(run-list some wl c)
(run-list some wl method)
false)))))))
(defn extend-tester "Extends a tester with more definitions."
[tester & definitions]
(let [[tester tester-defs] (tester)]
(apply tester (concat tester-defs definitions))))
(defn combine-testers
[& testers]
(apply new-tester (apply concat (map #(%) testers))))
(defn i-want
[& forms]
(let [[good bad] (split-with (partial not= :but-not) forms)
good (su/flatten (map fn-seq good))
bad (set/difference (set good) (set (su/flatten (map fn-seq good))))]
(new-tester (whitelist (apply function-matcher (map #(:name (meta %)) good))) (blacklist (apply function-matcher (map #(:name (meta %)) bad))))))
(defn find-bad-forms
"Just a helper function to detect the forms that failed the test."
[tester ns form]
(filter #(not (tester % ns)) (fn-seq form)))
(def
#^{:doc "A tester that passes everything, convinent for trying and debugging but
not secure."}
debug-tester (constantly true))