specs for let, if-let, when-let

Signed-off-by: Rich Hickey <richhickey@gmail.com>

Author: puredanger

src/clj/clojure/core/specs.clj

@@ -1,4 +1,63 @@
 (ns ^{:skip-wiki true} clojure.core.specs
   (:require [clojure.spec :as s]))
 
-(alias 'cc 'clojure.core)
+;;;; destructure
+
+(s/def ::local-name (s/and simple-symbol? #(not= '& %)))
+
+(s/def ::binding-form
+  (s/or :sym ::local-name
+        :seq ::seq-binding-form
+        :map ::map-binding-form))
+
+;; sequential destructuring
+
+(s/def ::seq-binding-form
+  (s/cat :elems (s/* ::binding-form)
+         :rest (s/? (s/cat :amp #{'&} :form ::binding-form))
+         :as (s/? (s/cat :as #{:as} :sym ::local-name))))
+
+;; map destructuring
+
+(s/def ::keys (s/coll-of ident? :kind vector?))
+(s/def ::syms (s/coll-of symbol? :kind vector?))
+(s/def ::strs (s/coll-of simple-symbol? :kind vector?))
+(s/def ::or (s/map-of simple-symbol? any?))
+(s/def ::as ::local-name)
+
+(s/def ::map-special-binding
+  (s/keys :opt-un [::as ::or ::keys ::syms ::strs]))
+
+(s/def ::map-binding (s/tuple ::binding-form any?))
+
+(s/def ::ns-keys
+  (s/tuple
+    (s/and qualified-keyword? #(-> % name #{"keys" "syms"}))
+    (s/coll-of simple-symbol? :kind vector?)))
+
+(s/def ::map-bindings
+  (s/every (s/or :mb ::map-binding
+                 :nsk ::ns-keys
+                 :msb (s/tuple #{:as :or :keys :syms :strs} any?)) :into {}))
+
+(s/def ::map-binding-form (s/merge ::map-bindings ::map-special-binding))
+
+;; bindings
+
+(s/def ::binding (s/cat :binding ::binding-form :init-expr any?))
+(s/def ::bindings (s/and vector? (s/* ::binding)))
+
+;; let, if-let, when-let
+
+(s/fdef clojure.core/let
+  :args (s/cat :bindings ::bindings
+               :body (s/* any?)))
+
+(s/fdef clojure.core/if-let
+  :args (s/cat :bindings (s/and vector? ::binding)
+               :then any?
+               :else (s/? any?)))
+
+(s/fdef clojure.core/when-let
+  :args (s/cat :bindings (s/and vector? ::binding)
+               :body (s/* any?)))

test/clojure/test_clojure/errors.clj

@@ -42,15 +42,10 @@
   (refer 'clojure.core :rename '{with-open renamed-with-open})
 
   ; would have used `are` here, but :line meta on &form doesn't survive successive macroexpansions
-  (doseq [[msg-regex-str form] [["if-let .* in %s:\\d+" '(if-let [a 5
-                                                                 b 6]
-                                                          true nil)]
-                                ["let .* in %s:\\d+" '(let [a])] 
-                                ["let .* in %s:\\d+" '(let (a))]
-                                ["renamed-with-open .* in %s:\\d+" '(renamed-with-open [a])]]]
+  (doseq [[msg-regex-str form] [["renamed-with-open" "(renamed-with-open [a])"]]]
     (is (thrown-with-msg? IllegalArgumentException
                           (re-pattern (format msg-regex-str *ns*))
-                          (macroexpand form)))))
+                          (macroexpand (read-string form))))))
 
 (deftest extract-ex-data
   (try

test/clojure/test_clojure/special.clj

@@ -67,19 +67,19 @@
     (is (= [1 2 3] [b c d]))))
 
 (deftest keywords-not-allowed-in-let-bindings
-  (is (thrown-with-msg? Exception #"Unsupported binding form: :a"
+  (is (thrown-with-msg? Exception #"did not conform to spec"
                         (eval '(let [:a 1] a))))
-  (is (thrown-with-msg? Exception #"Unsupported binding form: :a/b"
+  (is (thrown-with-msg? Exception #"did not conform to spec"
                         (eval '(let [:a/b 1] b))))
-  (is (thrown-with-msg? Exception #"Unsupported binding form: :a"
+  (is (thrown-with-msg? Exception #"did not conform to spec"
                         (eval '(let [[:a] [1]] a))))
-  (is (thrown-with-msg? Exception #"Unsupported binding form: :a/b"
+  (is (thrown-with-msg? Exception #"did not conform to spec"
                         (eval '(let [[:a/b] [1]] b)))))
 
 (deftest namespaced-syms-only-allowed-in-map-destructuring
-  (is (thrown-with-msg? Exception #"Can't let qualified name: a/x"
+  (is (thrown-with-msg? Exception #"did not conform to spec"
                         (eval '(let [a/x 1, [y] [1]] x))))
-  (is (thrown-with-msg? Exception #"Can't let qualified name: a/x"
+  (is (thrown-with-msg? Exception #"did not conform to spec"
                         (eval '(let [[a/x] [1]] x)))))
 
 (deftest or-doesnt-create-bindings