Fix CTYP-105, typo in HMap subtyping

clojure · Feb 19, 2014 · 0e0a41c · 0e0a41c
1 parent 0b815cc
commit 0e0a41c
Show file tree

Hide file tree

Showing 4 changed files with 59 additions and 3 deletions.
diff --git a/src/main/clojure/clojure/core/typed/base_env.clj b/src/main/clojure/clojure/core/typed/base_env.clj
@@ -1214,6 +1214,9 @@ clojure.string/join
      (Fn [(Option (Seqable Any)) -> String]
          [Any (Option (Seqable Any)) -> String])
 
+clojure.string/upper-case
+      [CharSequence -> String]
+
 clojure.core/interpose (All [x] (Fn [x (Option (Seqable x)) -> (Seq x)]))
 clojure.core/interleave (All [x] [(Option (Seqable x)) (Option (Seqable x)) (Option (Seqable x)) * -> (Seq x)])
 

diff --git a/src/main/clojure/clojure/core/typed/subtype.clj b/src/main/clojure/clojure/core/typed/subtype.clj
@@ -526,9 +526,9 @@
                                           (c/complete-hmap? s))]
                                   (cond
                                     (c/partial-hmap? s)
-                                      (and (contains? (:absent-keys s) k)
-                                           matches-entry?))
-                                    :else matches-entry?))
+                                      (or (contains? (:absent-keys s) k)
+                                          matches-entry?)
+                                    :else matches-entry?)))
                                 (:optional t)))
                    )
             *sub-current-seen*

diff --git a/src/test/clojure/clojure/core/typed/test/core.clj b/src/test/clojure/clojure/core/typed/test/core.clj
@@ -2992,6 +2992,13 @@
   ; ensure check-ns still runs even if timbre isn't loaded
   (is (check-ns-info 'clojure.core.typed.test.destructure
                      :profile true)))
+
+; CTYP-105
+(deftest hmap-absent-and-optional-subtype-test
+  (is (sub? (HMap :absent-keys #{:a})
+            (HMap :optional {:a Any})))
+  (is (check-ns 'clojure.core.typed.test.ctyp105)))
+
 ;(deftest collect-on-eval-test
 ;  (is (do (ann foo-bar Number)
 ;          (cf (def foo-bar 1))

diff --git a/src/test/clojure/clojure/core/typed/test/ctyp105.clj b/src/test/clojure/clojure/core/typed/test/ctyp105.clj
@@ -0,0 +1,46 @@
+(ns clojure.core.typed.test.ctyp105
+  (:require [clojure.string :as str]
+            [clojure.core.typed :refer 
+             [check-ns cf ann ann-many ann-form 
+              def-alias ann-many Seqable Option 
+              AnyInteger 
+              fn> doseq>
+              print-env Seq tc-ignore]
+             :as t])
+  (:import [clojure.lang IPersistentList IPersistentVector IPersistentSet IPersistentMap Keyword Symbol]))
+
+(def-alias PatInfo (HMap :mandatory {:ptnt_nr String}
+                         :optional {:ptnt_vertrekdatum String
+                                     :ptnt_voorv2denaam String 
+                                     :ptnt_tweedenaam   String
+                                     :ptnt_fullname     String
+                                     :ptnt_roepnaam  String
+                                     :roepnaam       String
+                                     :ptnt_geboren   String
+                                     :geboortedatum String
+                                     :ptnt_voorletters String
+                                     :voorletters String
+                                     :ptnt_voorveigen   String
+                                     :voorvoegsel String
+                                     :actief Boolean
+                                     :achternaam String
+                                     :ptnt_ruiter String
+                                     :sms_status String
+                                     }))
+
+(ann ptnt-check-ruiters [PatInfo -> PatInfo])
+(defn ptnt-check-ruiters
+  "Check the SMS-status of a patient.
+    :sms_satus Status will be set to 'ON', 'OFF' or ''"
+  [rec]
+  (let [smsStat (if-let [ruiters (:ptnt_ruiter rec)]
+                  (let [ruiters (str/upper-case ruiters)]
+                    (if (re-find #"\*SN" ruiters)
+                      "Off"
+                      (if (re-find #"\*SO" ruiters)
+                        "On"
+                        "?")))
+                  "?")]
+    (ann-form rec PatInfo)
+    (assoc (ann-form (dissoc rec :ptnt_ruiter) PatInfo)
+      :sms_status (str smsStat))))