Permalink
Browse files

Checking invariants on the invariants of defconstrainedrecord. meta-i…

…nvariants FTW!
  • Loading branch information...
fogus committed Mar 30, 2012
1 parent 99b62ac commit cf0a118d02e5ca34a183ac772e642609bd9eeac6
Showing with 22 additions and 4 deletions.
  1. +18 −2 src/trammel/core.clj
  2. +2 −0 test/fogus/me/invariant_tests.clj
  3. +2 −2 watching.rb
View
@@ -249,7 +249,14 @@
~@body)))
(defmacro defconstrainedrecord
- [name slots invariants & etc]
+ [name slots inv-description invariants & etc]
+ (assert (and inv-description (string? inv-description))
+ (str "Expecting a invariant description for record type " name))
+ (assert (and invariants (or (map? invariants) (vector? invariants)))
+ (str "Expecting record invariants of the form "
+ "[pre-conditions => post-conditions] or "
+ "{:pre [pre-conditions]}"
+ "for record type " name))
(let [fields (->> slots (partition 2) (map first) vec)
defaults (->> slots (partition 2) (map second))
ctor-name (symbol (str name \.))
@@ -260,7 +267,7 @@
(= t# (type r#))))
(let [chk# (contract ~(symbol (str "chk-" name))
- ~(str "Invariant contract for " name)
+ ~inv-description
[{:keys ~fields :as m#}] ~invariants)]
(defconstrainedfn ~factory-name
([] [] (with-meta
@@ -347,5 +354,14 @@
(sqr 0)
(sqr -1)
+
+ (defconstrainedrecord Foo [a 1 b 2]
+ "Foo record fields are expected to hold only numbers."
+ [(every? number? [a b])]
+ Object
+ (toString [this] (str "record Foo has " a " and " b)))
+
+ (assoc (->Foo) :a "foo")
+
)
@@ -17,6 +17,7 @@
(defconstrainedrecord Foo [a 1 b 2]
+ "Foo record fields are expected to hold only numbers."
[(every? number? [a b])]
Object
(toString [this] (str "record Foo has " a " and " b)))
@@ -45,6 +46,7 @@
;; testing default clojure pre/post maps
(defconstrainedrecord Bar [a 1 b 2]
+ "Foo record fields are expected to hold only numbers."
{:pre [(every? number? [a b])]}
Object
(toString [this] (str "record Bar has " a " and " b)))
View
@@ -1,5 +1,5 @@
require 'watchr'
-watch('test/(.*)\.clj') {|t| system "lein multi test"}
-watch('src/(.*)\.clj') {|t| system "lein multi test"}
+watch('test/(.*)\.clj') {|t| system "lein test"}
+watch('src/(.*)\.clj') {|t| system "lein test"}
watch('src/(.*)\.clj') {|t| system "lein marg"}

0 comments on commit cf0a118

Please sign in to comment.