summaryrefslogtreecommitdiff
path: root/test/jester/types_test.clj
diff options
context:
space:
mode:
Diffstat (limited to 'test/jester/types_test.clj')
-rw-r--r--test/jester/types_test.clj281
1 files changed, 281 insertions, 0 deletions
diff --git a/test/jester/types_test.clj b/test/jester/types_test.clj
new file mode 100644
index 0000000..84b28fe
--- /dev/null
+++ b/test/jester/types_test.clj
@@ -0,0 +1,281 @@
+(ns jester.types-test
+ (:require [clojure.test :refer [deftest testing is are]]
+ [clojure.test.check :refer [quick-check]]
+ [clojure.test.check.generators :as gen]
+ [clojure.test.check.properties :refer [for-all]]
+ [jester.types :as sut]))
+
+(def string-enum-gen (gen/fmap #(cons 'enum %) (gen/vector gen/string)))
+(def number-enum-gen (gen/fmap #(cons 'enum %) (gen/vector gen/double)))
+(def boolean-enum-gen (gen/fmap #(cons 'enum %) (gen/vector gen/boolean)))
+(def enum-gen (gen/one-of [string-enum-gen
+ number-enum-gen
+ boolean-enum-gen]))
+
+(def atomic-type-gen
+ (gen/one-of [(gen/return 'any)
+ (gen/return 'none)
+ (gen/return 'string)
+ (gen/return 'number)
+ (gen/return 'boolean)
+ enum-gen]))
+
+(defn optional-type-gen [subgen]
+ (gen/fmap #(list 'optional %) subgen))
+
+(defn list-type-gen [subgen]
+ (gen/fmap #(list 'list %) subgen))
+
+(defn array-type-gen [subgen]
+ (gen/recursive-gen (fn [gen]
+ (gen/fmap (fn [[main rest]]
+ (into main (when rest ['& rest])))
+ (gen/tuple (gen/vector gen)
+ (gen/one-of
+ [(gen/return nil)
+ (array-type-gen gen)
+ (list-type-gen gen)]))))
+ subgen))
+
+(defn map-type-gen [keygen valgen]
+ (gen/fmap #(cons 'map %) (gen/tuple keygen valgen)))
+
+(defn func-type-gen [argsgen resultgen]
+ (gen/fmap #(cons '-> %) (gen/tuple argsgen resultgen)))
+
+(defn record-type-gen [subgen]
+ (gen/map gen/symbol subgen))
+
+(defn compound-type-gen [subgen]
+ (gen/one-of [(optional-type-gen subgen)
+ (list-type-gen subgen)
+ (array-type-gen subgen)
+ (map-type-gen subgen subgen)
+ (func-type-gen (array-type-gen subgen) subgen)
+ (record-type-gen subgen)]))
+
+(gen/sample (compound-type-gen atomic-type-gen))
+
+(deftest assert-type
+ (testing "happy paths"
+ (are [object type]
+ (nil? (sut/assert-type 'object 'type))
+
+ nil any
+ "a" any
+ 10 any
+ true any
+
+ "b" string
+ 12 number
+ false boolean
+
+ "b" (enum "b")
+ 14 (enum 14)
+ true (enum true)
+
+ nil (optional string)
+ "a" (optional string)
+
+ nil (optional number)
+ 16 (optional number)
+
+ nil (optional boolean)
+ false (optional boolean)
+
+ ["a" "b"] [string string]
+ ["a" false] [string boolean]
+ ["a" false] [string & (list boolean)]
+
+ [true false] (list boolean)
+ [10 20] (list number)
+
+ {"a" 30} (map string number)
+ {a 30} {a number}))
+
+ (testing "failure cases"
+ (are [object type msg]
+ (thrown-with-msg? clojure.lang.ExceptionInfo msg (sut/assert-type 'object 'type))
+
+ nil none #"No value can satisfy none"
+ "a" none #"No value can satisfy none"
+ 10 none #"No value can satisfy none"
+ true none #"No value can satisfy none"
+
+ "b" number #"Expected a number, but got \"b\""
+ 12 boolean #"Expected a boolean, but got 12"
+ true string #"Expected a string, but got true"
+
+ "b" (enum "a") #"Expected \"a\", but got \"b\""
+ 2 (enum 1) #"Expected 1, but got 2"
+ false (enum true) #"Expected true, but got false"
+
+ "b" (enum "a" "c" "d") #"Expected \"a\", \"c\", or \"d\", but got \"b\""
+ 2 (enum 1 3) #"Expected 1 or 3, but got 2"
+
+ "a" (optional number) #"Expected a number, but got \"a\""
+
+ ["a" "b"] [string number] #"Expected a number, but got \"b\""
+ ["a" "b"] [string & (list number)] #"Expected a number, but got \"b\""
+ ["a" "b"] [string] #"Expected at most 1 item, but got 2"
+ ["a" "b" "c"] [string string] #"Expected at most 2 items, but got 3"
+ [] [string] #"Expected at least 1 item, but got 0"
+ ["a"] [string string] #"Expected at least 2 items, but got 1"
+
+ ["a" 2] (list string) #"Expected a string, but got 2"
+
+ {"a" 20} (map number number) #"Expected a number, but got \"a\""
+ {"a" 20} (map string string) #"Expected a string, but got 20"
+
+ {a 10} {a string} #"Expected a string, but got 10")))
+
+
+(defn ^:privat grounded-bounds
+ "Return the current [lower upper] bounds of `type`."
+ [type]
+ [(sut/ground-type type :argument)
+ (sut/ground-type type :return)])
+
+(deftest any-type
+ (testing 'assert-type
+ (are [object] (nil? (sut/assert-type 'object 'any))
+ nil
+ 1
+ "a"
+ true
+ [1]
+ {a "a"}
+ {"a" "b"}))
+ (testing 'subtype?
+ (are [type] (sut/subtype? 'type 'any)
+ none
+ string
+ number
+ boolean
+ (list string)
+ (map number boolean)
+ (-> [string] number)
+ {a number})
+ (are [type] (not (sut/subtype? 'any 'type))
+ none
+ string
+ number
+ boolean
+ (list string)
+ (map number boolean)
+ (-> [string] number)
+ {a number}))
+ (testing '(constrain ground)
+ (sut/in-constraint-environment
+ (sut/constrain '(var n) 'any)
+ (is (= ['any 'any] (grounded-bounds '(var n)))))
+ (sut/in-constraint-environment
+ (sut/constrain 'any '(var n))
+ (is (= ['any 'any] (grounded-bounds '(var n)))))
+ (sut/in-constraint-environment
+ (is (= ['any 'any] (grounded-bounds '(var n)))))))
+
+(deftest enum-type
+ (testing 'assert-type
+ (are [object type] (nil? (sut/assert-type 'object 'type))
+ "a" (enum "a")
+ "a" (enum "a" "b")
+ 1 (enum 1)
+ 1 (enum 1 2)
+ true (enum true)
+ true (enum false true))
+ (are [object type msg]
+ (thrown-with-msg? clojure.lang.ExceptionInfo msg
+ (sut/assert-type 'object 'type))
+ "a" (enum "b" "c" "d") #"Expected \"b\", \"c\", or \"d\", but got \"a\""
+ 1 (enum 2 3) #"Expected 2 or 3, but got 1"
+ true (enum false) #"Expected false, but got true"
+ nil (enum 1) #"Expected 1, but got nil"
+ [] (enum 1) #"Expected 1, but got \[\]"
+ {} (enum 1) #"Expected 1, but got \{\}"))
+ (testing 'subtype?
+ (are [sub super] (sut/subtype? 'sub 'super)
+ none (enum)
+ (enum) any
+ (enum "a") (enum "a")
+ (enum "a") (enum "a" "b")
+ (enum 1) (enum 1)
+ (enum 1) (enum 1 2)
+ (enum true) (enum true)
+ (enum true) (enum true false)
+ (enum) (enum "a"))
+ (are [sub super] (not (sut/subtype? 'sub 'super))
+ (enum "a") (enum "b")
+ (enum 1) (enum 2)
+ (enum true) (enum false)
+ (enum "a") (enum)))
+ (testing '(constrain ground)
+ (sut/in-constraint-environment
+ (sut/constrain '(var a) '(enum "a" "b" "c"))
+ (sut/constrain '(var a) '(enum "a"))
+ (is (= '[(enum "a") any] (grounded-bounds '(var a)))))
+ (sut/in-constraint-environment
+ (sut/constrain '(enum "a" "b" "c") '(var a))
+ (sut/constrain '(enum "a") '(var a))
+ (is (= '[(optional string) (enum "b" "c" "a")] (grounded-bounds '(var a)))))
+ (sut/in-constraint-environment
+ (sut/constrain '(var a) '(enum "a" "b" "c"))
+ (sut/constrain '(var a) '(enum "x"))
+ (is (= '[none any] (grounded-bounds '(var a)))))))
+
+(deftest subtype?
+ (testing "when there is a subtyping relationship"
+ (are [subtype supertype]
+ (is (sut/subtype? 'subtype 'supertype))
+ string any
+ none string
+
+ string string
+ number number
+ boolean boolean
+ (enum "a") (enum "a")
+ (enum 1) (enum 1)
+ (enum 2) (enum 2)
+
+ (enum "a") string
+ (enum 1) number
+ (enum false) boolean
+
+ string (optional string)
+ (enum "a") (optional string)
+ number (optional number)
+ (enum 1) (optional number)
+ boolean (optional boolean)
+ (enum true) (optional boolean)
+
+ (optional string) (optional string)
+ (optional (enum "a")) (optional string)
+ (optional number) (optional number)
+ (optional (enum 1)) (optional number)
+ (optional boolean) (optional boolean)
+ (optional (enum true)) (optional boolean)
+
+ [string] [string]
+ [string string] [string string]
+ [string] [string & (list string)]
+ [string string] [string & (list string)]
+ [number string] [number & (list string)]
+ [number & (list string)] [number & (list string)]
+ [number string & (list string)] [number & (list string)]
+ (map string number) (map string number)
+ (map string (enum 1)) (map (enum "a") number)
+
+ (-> [string number] boolean) (-> [string number] boolean)
+ (-> [string & (list number)] (enum true)) (-> [string number] boolean)
+
+ {a string} {a string}
+ {a string, b string} {a string}
+ {a string, b string} {a (optional string)}))
+ (testing "when there isn't a subtyping relationship"
+ ))
+
+(deftest failing-case
+ (sut/in-constraint-environment
+ (sut/constrain '[(var a) & (var n)] '[(enum 1) & [(enum 3) (enum 4)]])
+ (is (= '[(enum 1) any] (grounded-bounds '(var a))))
+ (is (= '[[(enum 3) (enum 4)] any] (grounded-bounds '(var n))))))
generated by cgit v1.2.3 (git 2.46.0) at 2024-09-19 23:02:31 +0000