Browse files

Related to CTYP-124 - Update target in the default `case` branch

Not useful currently, since `case` aliases the target expression.
We need aliasing filters to update the target properly.
  • Loading branch information...
1 parent ba7072c commit c13396739b3b5bc8b6349b4fdb2613bc942224a9 @frenchy64 frenchy64 committed Mar 22, 2014
@@ -4926,8 +4926,9 @@
cthe-expr (check (:the-expr expr))
etype (expr-type cthe-expr)
ctests (mapv check (:tests expr))
+ tst-rets (map expr-type ctests)
cthens-and-envs (doall
- (for [[tst-ret thn] (map vector (map expr-type ctests) (:thens expr))]
+ (for [[tst-ret thn] (map vector tst-rets (:thens expr))]
(let [{{fs+ :then} :fl :as rslt} (tc-equiv := etype tst-ret)
flag+ (atom true)
env-thn (env+ lex/*lexical-env* [fs+] flag+)
@@ -4936,8 +4937,16 @@
[(assoc thn
expr-type (expr-type then-ret))
- ;TODO consider tests that failed to refine env
- cdefault (check (:default expr) expected)
+ cdefault (let [flag+ (atom true)
+ neg-tst-fl (if (every? r/Value? (map (comp c/fully-resolve-type ret-t) tst-rets))
+ (fo/-not-filter-at (apply c/Un (map ret-t tst-rets))
+ (ret-o etype))
+ fl/-top)
+ _ (prn "neg-tst-fl" neg-tst-fl)
+ env-default (env+ lex/*lexical-env* [neg-tst-fl] flag+)]
+ (prn "env-default" env-default)
+ (var-env/with-lexical-env env-default
+ (check (:default expr) expected)))
case-result (let [type (apply c/Un (map (comp :t expr-type) (cons cdefault (map first cthens-and-envs))))
filter (fo/-FS fl/-top fl/-top)
@@ -0,0 +1,9 @@
+(ns clojure.core.typed.test.CTYP-124-case-update-default
+ (:require [clojure.core.typed :as t]))
+(t/ann case-default [(U ':a ':b) -> ':b])
+(defn case-default [e]
+ (case e
+ :a :b
+ e))
@@ -3093,6 +3093,9 @@
(deftest ctyp97-tvar-scoping-test
(is (check-ns 'clojure.core.typed.test.ctyp97-tvar-scoping)))
+;(deftest ctyp124)
(deftest get-bounded-tvar-test
(is (check-ns 'clojure.core.typed.test.get-bounded-tvar)))

0 comments on commit c133967

Please sign in to comment.