Skip to content

Commit 1355cb5

Browse files
super7rampsuper7ramp
authored
Test ancestors (#833)
This closes #137.
1 parent 06f9f02 commit 1355cb5

File tree

2 files changed

+168
-8
lines changed

2 files changed

+168
-8
lines changed

‎test/clojure/core_test/ancestors.cljc‎

Lines changed: 161 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,161 @@
1+
(ns clojure.core-test.ancestors
2+
(:require [clojure.test :refer [are deftest is testing use-fixtures]]
3+
[clojure.core-test.portability #?(:cljs :refer-macros :default :refer) [when-var-exists]]))
4+
5+
(when-var-exists ancestors
6+
7+
; Some classes for testing ancestors by type inheritance
8+
(def AncestorT #?(:cljs js/Object :default Object))
9+
(def ChildT #?(:cljs :default :default clojure.lang.PersistentHashSet))
10+
11+
; Some custom types for testing ancestors by type inheritance
12+
(defprotocol TestAncestorsProtocol)
13+
(defrecord TestAncestorsRecord [] TestAncestorsProtocol)
14+
(deftype TestAncestorsType [] TestAncestorsProtocol)
15+
16+
; A global hierarchy for testing `ancestors tag` and `ancestors h tag`
17+
(def global-hierarchy [[TestAncestorsRecord ::record]
18+
[::record ::object]
19+
[::leaf ::t]
20+
[::t ::p-1]
21+
[::t ::p-2]
22+
[::p-1 'ns/p-0]])
23+
24+
(defn register-global-hierarchy []
25+
(doseq [[tag parent] global-hierarchy]
26+
(derive tag parent)))
27+
28+
(defn unregister-global-hierarchy []
29+
(doseq [[tag parent] global-hierarchy]
30+
(underive tag parent)))
31+
32+
(defn with-global-hierarchy [tests]
33+
(register-global-hierarchy)
34+
(tests)
35+
(unregister-global-hierarchy))
36+
37+
(use-fixtures :once with-global-hierarchy)
38+
39+
; A hierarchy for testing `ancestors h tag`
40+
(def datatypes
41+
(-> (make-hierarchy)
42+
(derive TestAncestorsRecord ::datatype)
43+
(derive TestAncestorsType ::datatype)
44+
(derive TestAncestorsType ::mutable)
45+
(derive ::datatype ::type)))
46+
47+
; Another hierarchy for testing `ancestors h tag`
48+
(def diamond
49+
(-> (make-hierarchy)
50+
(derive ::b ::a)
51+
(derive ::c ::a)
52+
(derive ::d ::b)
53+
(derive ::d ::c)
54+
(derive ::leaf ::d)))
55+
56+
(deftest test-ancestors
57+
58+
(testing "ancestors tag"
59+
60+
(testing "returns ancestors by relationship globally defined with derive"
61+
(are [expected tag] (= expected (ancestors tag))
62+
#{::t ::p-1 ::p-2 'ns/p-0} ::leaf
63+
#{::p-1 ::p-2 'ns/p-0} ::t
64+
#{'ns/p-0} ::p-1
65+
nil ::p-2)
66+
#?(:bb "bb doesn't report ancestors by relationship globally defined with derive for custom types
67+
(https://github.com/babashka/babashka/issues/1893)"
68+
:default (is (= #{::record ::object} (->> (ancestors TestAncestorsRecord)
69+
(filter keyword?) ; filter out parents by type, tested in next sections
70+
set)))))
71+
72+
(testing "returns ancestors by type inheritance when tag is a class"
73+
#?(:cljs "cljs doesn't report ancestors by type inheritance yet (CLJS-3464)"
74+
:clj (is (contains? (ancestors ChildT) AncestorT))))
75+
76+
#?(:bb "bb doesn't report ancestors by type inheritance for custom types"
77+
:cljs "cljs doesn't report ancestors by type inheritance yet (CLJS-3464)"
78+
:default (testing "returns ancestors by type inheritance when tag is a custom type"
79+
(is (contains? (ancestors TestAncestorsType) clojure.core_test.ancestors.TestAncestorsProtocol))
80+
(is (contains? (ancestors TestAncestorsRecord) clojure.core_test.ancestors.TestAncestorsProtocol))
81+
(is (contains? (ancestors TestAncestorsRecord) clojure.lang.Associative))
82+
(is (nil? (ancestors TestAncestorsProtocol)))))
83+
84+
(testing "does not throw on invalid tag"
85+
(are [tag] (nil? (ancestors tag))
86+
nil
87+
"anything"
88+
42
89+
3.14
90+
true
91+
false
92+
[]
93+
{}
94+
#{}
95+
'())))
96+
97+
(testing "parents h tag"
98+
99+
(testing "returns only ancestors declared in h, whether the tag is in global hierarchy or not"
100+
(are [expected h tag] (= expected (->> (ancestors h tag)
101+
(filter keyword?) ; filter out ancestors by type, tested in next sections
102+
set))
103+
104+
; tag in h and not in global hierarchy
105+
#{::a ::b ::c} diamond ::d
106+
#{::a} diamond ::b
107+
#{} diamond ::a
108+
#?@(; bb doesn't report ancestors by relationship declared in h for custom types
109+
; (https://github.com/babashka/babashka/issues/1893)
110+
:bb []
111+
:default [#{::datatype ::mutable ::type} datatypes TestAncestorsType])
112+
113+
; tag in both h and global hierarchy, only ancestors in h are returned
114+
#{::a ::b ::c ::d} diamond ::leaf
115+
#?@(; bb doesn't report ancestors by relationship declared in h for custom types
116+
; (https://github.com/babashka/babashka/issues/1893)
117+
:bb []
118+
:default [#{::datatype ::type} datatypes TestAncestorsRecord])
119+
120+
; tag not in h but in global hierarchy
121+
#{} datatypes ::t
122+
#{} datatypes ::p-1
123+
#{} datatypes ::p-2
124+
125+
; tag neither in h nor in global hierarchy
126+
#{} datatypes ::d
127+
#{} datatypes ::b
128+
#{} datatypes ::a))
129+
130+
#?(:cljs "cljs doesn't report ancestors by type inheritance yet (CLJS-3464)"
131+
:default (testing "returns ancestors by type inheritance when tag is a class, whether the tag is in h or not"
132+
(are [h] (contains? (ancestors h ChildT) AncestorT)
133+
; tag in h
134+
(derive (make-hierarchy) ChildT ::object)
135+
; tag not in h
136+
diamond
137+
datatypes)))
138+
139+
#?(:bb "bb doesn't report ancestors by type inheritance for custom types"
140+
:cljs "cljs doesn't report ancestors by type inheritance yet (CLJS-3464)"
141+
:default (testing "returns ancestors by type inheritance when tag is a custom type, whether the tag is in h or not"
142+
(are [h tag] (let [actual-ancestors (ancestors h tag)]
143+
(and (contains? actual-ancestors clojure.core_test.ancestors.TestAncestorsProtocol)
144+
(contains? actual-ancestors clojure.lang.Associative)))
145+
; tag in h
146+
datatypes TestAncestorsRecord
147+
; tag not in h
148+
diamond TestAncestorsRecord)))
149+
150+
(testing "does not throw on invalid tag or hierarchy"
151+
(are [invalid] (nil? (ancestors invalid invalid))
152+
nil
153+
"anything"
154+
42
155+
3.14
156+
true
157+
false
158+
[]
159+
{}
160+
#{}
161+
'())))))

‎test/clojure/core_test/parents.cljc‎

Lines changed: 7 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -2,10 +2,9 @@
22
(:require [clojure.test :refer [are deftest is testing use-fixtures]]
33
[clojure.core-test.portability #?(:cljs :refer-macros :default :refer) [when-var-exists]]))
44

5-
(when-var-exists
6-
parents
5+
(when-var-exists parents
76

8-
; Some types for testing parents by type
7+
; Some custom types for testing parents by type inheritance
98
(defprotocol TestParentsProtocol)
109
(defrecord TestParentsRecord [] TestParentsProtocol)
1110
(deftype TestParentsType [] TestParentsProtocol)
@@ -62,13 +61,13 @@
6261
(https://github.com/babashka/babashka/issues/1893)"
6362
:default (is (contains? (parents TestParentsRecord) ::record))))
6463

65-
#?(:cljs "cljs doesn't report parents by type inheritance (https://ask.clojure.org/index.php/14764/)"
64+
#?(:cljs "cljs doesn't report parents by type inheritance yet (CLJS-3464)"
6665
:default (testing "returns parents by type inheritance when tag is a class"
6766
(is (contains? (parents String) Object))
6867
(is (nil? (parents Object)))))
6968

7069
#?(:bb "bb doesn't report parents by type inheritance for custom types"
71-
:cljs "cljs doesn't report parents by type inheritance (https://ask.clojure.org/index.php/14764/)"
70+
:cljs "cljs doesn't report parents by type inheritance yet (CLJS-3464)"
7271
:default (testing "returns parents by type inheritance when tag is a custom type"
7372
(is (contains? (parents TestParentsType) clojure.core_test.parents.TestParentsProtocol))
7473
(is (contains? (parents TestParentsRecord) clojure.core_test.parents.TestParentsProtocol))
@@ -120,7 +119,7 @@
120119
#{} datatypes ::b
121120
#{} datatypes ::a))
122121

123-
#?(:cljs "cljs doesn't report parents by type inheritance (https://ask.clojure.org/index.php/14764/)"
122+
#?(:cljs "cljs doesn't report parents by type inheritance yet (CLJS-3464)"
124123
:default (testing "returns parents by type inheritance when tag is a class, whether the tag is in h or not"
125124
(are [h] (contains? (parents h String) Object)
126125
; tag in h
@@ -130,8 +129,8 @@
130129
datatypes)))
131130

132131
#?(:bb "bb doesn't report parents by type inheritance for custom types"
133-
:cljs "cljs doesn't report parents by type inheritance (https://ask.clojure.org/index.php/14764/)"
134-
:default (testing "returns parents by type when tag is a custom type, whether the tag is in h or not"
132+
:cljs "cljs doesn't report parents by type inheritance yet (CLJS-3464)"
133+
:default (testing "returns parents by type inheritance when tag is a custom type, whether the tag is in h or not"
135134
(are [h tag] (contains? (parents h tag) clojure.core_test.parents.TestParentsProtocol)
136135
; tag in h
137136
datatypes TestParentsType

0 commit comments

Comments
 (0)