Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Fix CTYP-53. HMap is less eager to simplify to Nothing incorrectly.

  • Loading branch information...
commit ad9c1769689809278fef3bbd50bf2efa4864be12 1 parent 0e6d4c4
@frenchy64 frenchy64 authored
View
87 src/main/clojure/clojure/core/typed/check.clj
@@ -3999,33 +3999,82 @@
(r/HeterogeneousMap? t))
(let [{:keys [type path id]} lo
[{fpth-kw :val} & rstpth] path
+ next-filter (fo/-filter type id rstpth)
fpth (r/-val fpth-kw)
- type-at-pth (get (:types t) fpth)]
+ present? (contains? (:types t) fpth)
+ absent? (when-not present?
+ (or ; absent if in :absent-keys
+ (contains? (:absent-keys t) fpth)
+ ; absent if no other keys
+ (not (:other-keys? t))))
+ type-at-pth (or (get (:types t) fpth)
+ (when-not absent?
+ r/-any))]
+ ;updating a positive KeyPE should consider 3 cases:
+ ; 1. the key is declared present
+ ; 2. the key is not declared present, and is not declared absent
+ ; 3. the key is declared absent
(if type-at-pth
- (c/-hmap (assoc (:types t) fpth (update type-at-pth (fo/-filter type id rstpth)))
- (:absent-keys t)
- (:other-keys? t))
+ (c/Un
+ ; assume key is present and update value type
+ (c/-hmap (assoc (:types t) fpth (update type-at-pth next-filter))
+ (:absent-keys t)
+ (:other-keys? t))
+ (let [val-maybe-nil? (not (r/Bottom? (update r/-nil next-filter)))]
+ ; is there any situation where the value could be nil?
+ (if val-maybe-nil?
+ ; if yes, assume key is absent.
+ ; handles (:a {}) => nil
+ (c/-hmap (:types t)
+ (conj (:absent-keys t) fpth)
+ (:other-keys? t))
+ ; otherwise, don't add to type
+ (c/Un))))
(c/Un)))
(and (fl/NotTypeFilter? lo)
- (pe/KeyPE? (first (:path lo))))
- (cond
- (r/HeterogeneousMap? t)
- (let [{:keys [type path id]} lo
- [{fpth-kw :val} & rstpth] path
- fpth (r/-val fpth-kw)
- type-at-pth (get (:types t) fpth)]
- (if type-at-pth
- (c/-hmap (assoc (:types t) fpth (update type-at-pth (fo/-not-filter type id rstpth)))
+ (pe/KeyPE? (first (:path lo)))
+ (r/HeterogeneousMap? t))
+ (let [{:keys [type path id]} lo
+ [{fpth-kw :val} & rstpth] path
+ fpth (r/-val fpth-kw)
+ next-filter (fo/-not-filter type id rstpth)
+ present? (contains? (:types t) fpth)
+ absent? (when-not present?
+ (or ; absent if in :absent-keys
+ (contains? (:absent-keys t) fpth)
+ ; absent if no other keys
+ (not (:other-keys? t))))
+ type-at-pth (or (get (:types t) fpth)
+ (when-not absent?
+ r/-any))]
+ ;updating a negative KeyPE should consider 3 cases:
+ ; 1. the key is declared present
+ ; 2. the key is not declared present, and is not declared absent
+ ; 3. the key is declared absent
+ (if type-at-pth
+ (c/Un
+ ; key is present, update corresponding value
+ (c/-hmap (assoc (:types t) fpth (update type-at-pth next-filter))
(:absent-keys t)
(:other-keys? t))
- (c/Un)))
- ; looking up something that isn't an ILookup, therefore will always result in nil
- (not (sub/subtype? t (c/RClass-of clojure.lang.ILookup [r/-any r/-any])))
- (update r/-nil (update-in lo [:path] rest))
-
- :else t)
+ (let [val-maybe-nil? (not (r/Bottom? (update r/-nil next-filter)))]
+ ; is there any situation where the value could be nil?
+ (if val-maybe-nil?
+ ; if yes, assume key is absent.
+ ; handles (:a {}) => nil
+ (c/-hmap (:types t)
+ (conj (:absent-keys t) fpth)
+ (:other-keys? t))
+ ; otherwise, don't add to type
+ (c/Un))))
+ (c/Un)))
+ ; nil returns nil on keyword lookups
+ (and (fl/NotTypeFilter? lo)
+ (pe/KeyPE? (first (:path lo)))
+ (r/Nil? t))
+ (update r/-nil (update-in lo [:path] rest))
(and (fl/TypeFilter? lo)
(pe/CountPE? (first (:path lo))))
View
2  src/main/clojure/clojure/core/typed/type_ctors.clj
@@ -69,7 +69,7 @@
([types other-keys?] (-hmap types #{} other-keys?))
([types absent-keys other-keys?]
(if (or ; simplify to bottom if an entry is bottom
- (some #{bottom} (concat (keys types) (vals types)))
+ (some #{bottom} (concat (keys types) (vals types) absent-keys))
; contradictory overlap in present/absent keys
(seq (set/intersection (set (keys types)) (set absent-keys))))
bottom
View
81 src/test/clojure/clojure/core/typed/test/core.clj
@@ -47,6 +47,10 @@
(impl/with-clojure-impl
(apply sub/subtype? rs)))
+(defn both-subtype? [s t]
+ (and (subtype? s t)
+ (subtype? t s)))
+
(defn check [& as]
(impl/with-clojure-impl
(apply chk/check as)))
@@ -1322,14 +1326,18 @@
(RClass-of String))))))
(deftest path-update-test
- (is-clj (clj (= (update (Un -nil (-hmap {(-val :foo) (RClass-of Number)}))
- (-not-filter (Un -false -nil) 'id [(->KeyPE :foo)]))
- (-hmap {(-val :foo) (RClass-of Number)}))))
+ (is-clj
+ (both-subtype? (clj (update (Un -nil (-hmap {(-val :foo) (RClass-of Number)}))
+ (-filter (Un -false -nil) 'id [(->KeyPE :foo)])))
+ -nil))
+ (is-clj
+ (both-subtype? (update (Un -nil (-hmap {(-val :foo) (RClass-of Number)}))
+ (-not-filter (Un -false -nil) 'id [(->KeyPE :foo)]))
+ (-hmap {(-val :foo) (RClass-of Number)})))
; if (:foo a) is nil, either a has a :foo entry with nil, or no :foo entry
- ; TODO
- #_(is-clj (= (update (-hmap {})
- (-filter -nil 'id [(->KeyPE :foo)]))
- (make-HMap {} {(-val :foo) -nil}))))
+ (is-clj (both-subtype? (update (-hmap {})
+ (-filter -nil 'id [(->KeyPE :foo)]))
+ (make-HMap {} {(-val :foo) -nil}))))
(deftest multimethod-test
(is (check-ns 'clojure.core.typed.test.mm)))
@@ -1918,6 +1926,65 @@
(is (cf (map inc [1 2 3])
(clojure.core.typed/NonEmptyLazySeq Number))))
+;CTYP-53
+(deftest hmap-cast-test
+ (is (both-subtype?
+ (ety
+ (clojure.core.typed/fn>
+ [m :- (HMap)]
+ (assert (:foo m))
+ m))
+ (parse-clj '['{} ->
+ '{}
+ :filters {:then (! (U nil false) 0)
+ :else (is (U nil false) 0)}
+ :object {:id 0}])))
+ (is (both-subtype?
+ (ety
+ (clojure.core.typed/fn>
+ :- (HMap :mandatory {:foo (clojure.core.typed/Vec Any)})
+ [m :- (HMap)]
+ (assert (vector? (:foo m)))
+ m))
+ (parse-clj '[(HMap) ->
+ (HMap :mandatory {:foo (clojure.core.typed/Vec Any)})
+ :filters {:then (! (U nil false) 0)
+ :else (is (U nil false) 0)}
+ :object {:id 0}])))
+ (is (both-subtype?
+ (ety
+ (clojure.core.typed/fn>
+ [m :- (HMap :mandatory {:bar Any})]
+ (assert (nil? (:foo m)))
+ m))
+ (parse-clj '[(HMap :mandatory {:bar Any}) ->
+ (U (HMap :mandatory {:bar Any, :foo nil})
+ (HMap :mandatory {:bar Any}
+ :absent-keys #{:foo}))
+ :filters {:then (! (U nil false) 0)
+ :else (is (U nil false) 0)}
+ :object {:id 0}])))
+ (is
+ (both-subtype?
+ (ety
+ (clojure.core.typed/fn>
+ [m :- '{}]
+ (assert (not (vector? (:foo m))))
+ m))
+ (parse-clj '[(HMap) ->
+ ; not sure if this should simplify to (HMap)
+ (U (HMap :mandatory {:foo Any})
+ (HMap :absent-keys #{:foo}))
+ :filters {:then (! (U nil false) 0)
+ :else (is (U nil false) 0)}
+ :object {:id 0}])))
+ (is
+ (clj
+ (let [t1 (clj (update (parse-type '(HMap))
+ (parse-filter '(is (clojure.core.typed/Vec Any) m [(Key :foo)]))))
+ t2 (clj (parse-type '(HMap :mandatory {:foo (clojure.core.typed/Vec Any)})))]
+ (both-subtype? t1 t2)))))
+
;CTYP-60
(deftest absent-keys-test
(is (not (sub? (HMap :mandatory {:a String}
Please sign in to comment.
Something went wrong with that request. Please try again.