Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
My deftype based take on the google group question found here: https://groups.google.com/forum/#!topic/clojure/oe1Ch1oSlLk
(ns spec-test.virtual-time
(:require [clojure.spec :as s]
[clojure.spec.test :as st]
[clojure.spec.gen :as sgen]))
(deftype VirtualTime [time]
Object
(hashCode [_]
(hash time))
(equals [this that]
(or (identical? this that)
(and (instance? VirtualTime that)
(= 0 (.compareTo this that)))))
(toString [_]
(format "#VirtualTime[%s]" time))
clojure.lang.IDeref
(deref [_]
time)
Comparable
(compareTo [this that]
(cond
(= @this @that) 0
(= :positive-infinity @this) 1
(= :positive-infinity @that) -1
(= :negative-infinity @this) -1
(= :negative-infinity @that) 1
(== @this @that) 0
(< @this @that) -1
(> @this @that) 1
:else (throw (ArithmeticException.
(str "Could not compare "
@this " and " @that))))))
(s/def ::time
(s/or
:positive-infinity #{:positive-infinity}
:negative-infinity #{:negative-infinity}
:number number?))
(s/def ::virtual-time
(s/with-gen
#(instance? VirtualTime %)
#(sgen/fmap ->VirtualTime
(s/gen ::time))))
(s/fdef ->VirtualTime
:args (s/cat :time ::time)
:ret ::virtual-time
:fn #(= (second (:time (:args %))) @(:ret %)))
(defn vt-lt [left-vt right-vt]
(if (or (and (number? @left-vt)
(Double/isNaN @left-vt))
(and (number? @right-vt)
(Double/isNaN @right-vt)))
false
(= -1 (compare left-vt right-vt))))
(s/fdef vt-lt
:args (s/cat :left-vt ::virtual-time
:right-vt ::virtual-time)
:ret boolean?
:fn #(let [f @(:left-vt (:args %))
s @(:right-vt (:args %))
ret (:ret %)]
(cond
(and (number? f)
(Double/isNaN f)) (false? ret)
(and (number? s)
(Double/isNaN s)) (false? ret)
(= f s) (false? ret)
(= :positive-infinity f) (false? ret)
(= :positive-infinity s) (true? ret)
(= :negative-infinity f) (true? ret)
(= :negative-infinity s) (false? ret)
(== f s) (false? ret)
(< f s) (true? ret)
(> f s) (false? ret))))
(defn vt-eq [left-vt right-vt]
(if (or (and (number? @left-vt)
(Double/isNaN @left-vt))
(and (number? @right-vt)
(Double/isNaN @right-vt)))
false
(= 0 (compare left-vt right-vt))))
(s/fdef vt-eq
:args (s/cat :left-vt ::virtual-time
:right-vt ::virtual-time)
:ret boolean?)
(defn vt-le [left-vt right-vt]
(or (vt-eq left-vt right-vt)
(vt-lt left-vt right-vt)))
(s/fdef vt-le
:args (s/cat :left-vt ::virtual-time
:right-vt ::virtual-time)
:ret boolean?
:fn #(if (or (vt-eq (:left-vt (:args %)) (:right-vt (:args %)))
(vt-lt (:left-vt (:args %)) (:right-vt (:args %))))
(true? (:ret %))
(false? (:ret %))))
(st/summarize-results (st/check))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.