Skip to content

Test ancestors #833

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Nov 30, 2025
Merged

Test ancestors #833

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
161 changes: 161 additions & 0 deletions test/clojure/core_test/ancestors.cljc
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -0,0 +1,161 @@
(ns clojure.core-test.ancestors
(:require [clojure.test :refer [are deftest is testing use-fixtures]]
[clojure.core-test.portability #?(:cljs :refer-macros :default :refer) [when-var-exists]]))

(when-var-exists ancestors

; Some classes for testing ancestors by type inheritance
(def AncestorT #?(:cljs js/Object :default Object))
(def ChildT #?(:cljs :default :default clojure.lang.PersistentHashSet))

; Some custom types for testing ancestors by type inheritance
(defprotocol TestAncestorsProtocol)
(defrecord TestAncestorsRecord [] TestAncestorsProtocol)
(deftype TestAncestorsType [] TestAncestorsProtocol)

; A global hierarchy for testing `ancestors tag` and `ancestors h tag`
(def global-hierarchy [[TestAncestorsRecord ::record]
[::record ::object]
[::leaf ::t]
[::t ::p-1]
[::t ::p-2]
[::p-1 'ns/p-0]])

(defn register-global-hierarchy []
(doseq [[tag parent] global-hierarchy]
(derive tag parent)))

(defn unregister-global-hierarchy []
(doseq [[tag parent] global-hierarchy]
(underive tag parent)))

(defn with-global-hierarchy [tests]
(register-global-hierarchy)
(tests)
(unregister-global-hierarchy))

(use-fixtures :once with-global-hierarchy)

; A hierarchy for testing `ancestors h tag`
(def datatypes
(-> (make-hierarchy)
(derive TestAncestorsRecord ::datatype)
(derive TestAncestorsType ::datatype)
(derive TestAncestorsType ::mutable)
(derive ::datatype ::type)))

; Another hierarchy for testing `ancestors h tag`
(def diamond
(-> (make-hierarchy)
(derive ::b ::a)
(derive ::c ::a)
(derive ::d ::b)
(derive ::d ::c)
(derive ::leaf ::d)))

(deftest test-ancestors

(testing "ancestors tag"

(testing "returns ancestors by relationship globally defined with derive"
(are [expected tag] (= expected (ancestors tag))
#{::t ::p-1 ::p-2 'ns/p-0} ::leaf
#{::p-1 ::p-2 'ns/p-0} ::t
#{'ns/p-0} ::p-1
nil ::p-2)
#?(:bb "bb doesn't report ancestors by relationship globally defined with derive for custom types
(https://github.com/babashka/babashka/issues/1893)"
:default (is (= #{::record ::object} (->> (ancestors TestAncestorsRecord)
(filter keyword?) ; filter out parents by type, tested in next sections
set)))))

(testing "returns ancestors by type inheritance when tag is a class"
#?(:cljs "cljs doesn't report ancestors by type inheritance yet (CLJS-3464)"
:clj (is (contains? (ancestors ChildT) AncestorT))))

#?(:bb "bb doesn't report ancestors by type inheritance for custom types"
:cljs "cljs doesn't report ancestors by type inheritance yet (CLJS-3464)"
:default (testing "returns ancestors by type inheritance when tag is a custom type"
(is (contains? (ancestors TestAncestorsType) clojure.core_test.ancestors.TestAncestorsProtocol))
(is (contains? (ancestors TestAncestorsRecord) clojure.core_test.ancestors.TestAncestorsProtocol))
(is (contains? (ancestors TestAncestorsRecord) clojure.lang.Associative))
(is (nil? (ancestors TestAncestorsProtocol)))))

(testing "does not throw on invalid tag"
(are [tag] (nil? (ancestors tag))
nil
"anything"
42
3.14
true
false
[]
{}
#{}
'())))

(testing "parents h tag"

(testing "returns only ancestors declared in h, whether the tag is in global hierarchy or not"
(are [expected h tag] (= expected (->> (ancestors h tag)
(filter keyword?) ; filter out ancestors by type, tested in next sections
set))

; tag in h and not in global hierarchy
#{::a ::b ::c} diamond ::d
#{::a} diamond ::b
#{} diamond ::a
#?@(; bb doesn't report ancestors by relationship declared in h for custom types
; (https://github.com/babashka/babashka/issues/1893)
:bb []
:default [#{::datatype ::mutable ::type} datatypes TestAncestorsType])

; tag in both h and global hierarchy, only ancestors in h are returned
#{::a ::b ::c ::d} diamond ::leaf
#?@(; bb doesn't report ancestors by relationship declared in h for custom types
; (https://github.com/babashka/babashka/issues/1893)
:bb []
:default [#{::datatype ::type} datatypes TestAncestorsRecord])

; tag not in h but in global hierarchy
#{} datatypes ::t
#{} datatypes ::p-1
#{} datatypes ::p-2

; tag neither in h nor in global hierarchy
#{} datatypes ::d
#{} datatypes ::b
#{} datatypes ::a))

#?(:cljs "cljs doesn't report ancestors by type inheritance yet (CLJS-3464)"
:default (testing "returns ancestors by type inheritance when tag is a class, whether the tag is in h or not"
(are [h] (contains? (ancestors h ChildT) AncestorT)
; tag in h
(derive (make-hierarchy) ChildT ::object)
; tag not in h
diamond
datatypes)))

#?(:bb "bb doesn't report ancestors by type inheritance for custom types"
:cljs "cljs doesn't report ancestors by type inheritance yet (CLJS-3464)"
:default (testing "returns ancestors by type inheritance when tag is a custom type, whether the tag is in h or not"
(are [h tag] (let [actual-ancestors (ancestors h tag)]
(and (contains? actual-ancestors clojure.core_test.ancestors.TestAncestorsProtocol)
(contains? actual-ancestors clojure.lang.Associative)))
; tag in h
datatypes TestAncestorsRecord
; tag not in h
diamond TestAncestorsRecord)))

(testing "does not throw on invalid tag or hierarchy"
(are [invalid] (nil? (ancestors invalid invalid))
nil
"anything"
42
3.14
true
false
[]
{}
#{}
'())))))
15 changes: 7 additions & 8 deletions test/clojure/core_test/parents.cljc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,10 +2,9 @@
(:require [clojure.test :refer [are deftest is testing use-fixtures]]
[clojure.core-test.portability #?(:cljs :refer-macros :default :refer) [when-var-exists]]))

(when-var-exists
parents
(when-var-exists parents

; Some types for testing parents by type
; Some custom types for testing parents by type inheritance
(defprotocol TestParentsProtocol)
(defrecord TestParentsRecord [] TestParentsProtocol)
(deftype TestParentsType [] TestParentsProtocol)
Expand Down Expand Up @@ -62,13 +61,13 @@
(https://github.com/babashka/babashka/issues/1893)"
:default (is (contains? (parents TestParentsRecord) ::record))))

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

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

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

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