some read and edn/read tests

Signed-off-by: Stuart Halloway <stu@thinkrelevance.com>

test/clojure/test_clojure/edn.clj

@@ -0,0 +1,38 @@
+;   Copyright (c) Rich Hickey. All rights reserved.
+;   The use and distribution terms for this software are covered by the
+;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
+;   which can be found in the file epl-v10.html at the root of this distribution.
+;   By using this software in any fashion, you are agreeing to be bound by
+;   the terms of this license.
+;   You must not remove this notice, or any other, from this software.
+
+; Author: Stuart Halloway
+
+
+(ns clojure.test-clojure.edn
+  (:require [clojure.test.generative :refer (defspec)]
+            [clojure.test-clojure.generators :as cgen]
+            [clojure.edn :as edn]))
+
+(defn roundtrip
+  "Print an object and read it back as edn. Returns rather than throws
+   any exceptions."
+  [o]
+  (binding [*print-length* nil
+            *print-dup* nil
+            *print-level* nil]
+    (try
+     (-> o pr-str edn/read-string)
+     (catch Throwable t t))))
+
+(defspec types-that-should-roundtrip
+  roundtrip
+  [^{:tag cgen/ednable} o]
+  (when-not (= o %)
+    (throw (ex-info "Value cannot roundtrip, see ex-data" {:printed o :read %}))))
+
+(defspec types-that-should-not-roundtrip
+  roundtrip
+  [^{:tag cgen/non-ednable} o]
+  (when-not (instance? Throwable %)
+    (throw (ex-info "edn/read should have thrown, see ex-data" {:printed o :read %}))))

test/clojure/test_clojure/generators.clj

@@ -0,0 +1,114 @@
+(ns clojure.test-clojure.generators
+  (:require [clojure.data.generators :as gen])
+  (:refer-clojure :exclude [namespace]))
+
+(defn var-value-source
+  "Generates a scalar suitable for an initial var value."
+  []
+  (let [v (gen/scalar)]
+    (if (symbol? v)
+      `(quote ~v)
+      v)))
+
+(defn var-source
+  [n]
+  `(def ~(symbol (str "var" n))
+     ~(var-value-source)))
+
+(defn record-source
+  [n]
+  (let [rname (str "ExampleRecord" "-" n)
+        fldct (gen/geometric 0.1)]
+    `(defrecord ~(symbol rname) ~(vec (map #(symbol (str "f" %)) (range fldct))))))
+
+(defn generate-namespaces
+  "Returns a map with :nses, :vars, :records"
+  [{:keys [nses vars-per-ns records-per-ns]}]
+  (let [nses (mapv #(create-ns (symbol (str "clojure.generated.ns" %)))
+                   (range nses))
+        _ (doseq [ns nses] (binding [*ns* ns] (refer 'clojure.core)))
+        make-in-ns (fn [ns src] (binding [*ns* ns] (eval src)))
+        vars (->> (mapcat
+                   (fn [ns]
+                     (map
+                      #(make-in-ns ns (var-source %))
+                      (range vars-per-ns)))
+                   nses)
+                  (into []))
+        records (->> (mapcat
+                      (fn [ns]
+                        (map
+                         #(make-in-ns ns (record-source %))
+                         (range records-per-ns)))
+                      nses)
+                     (into []))]
+    {:nses nses
+     :vars vars
+     :records records}))
+
+(def shared-generation
+  (delay (generate-namespaces {:nses 5 :vars-per-ns 5 :records-per-ns 5})))
+
+(defn namespace
+  []
+  (gen/rand-nth (:nses @shared-generation)))
+
+(defn var
+  []
+  (gen/rand-nth (:vars @shared-generation)))
+
+(defn record
+  []
+  (gen/rand-nth (:records @shared-generation)))
+
+(def ednable-scalars
+  [(constantly nil)
+   gen/byte
+   gen/long
+   gen/boolean
+   #_gen/printable-ascii-char  ;; waiting on character reader fix
+   gen/string
+   gen/symbol
+   gen/keyword
+   gen/uuid
+   gen/date
+   gen/ratio
+   gen/bigint
+   gen/bigdec])
+
+(defn- call-through
+  "Recursively call x until it doesn't return a function."
+  [x]
+  (if (fn? x)
+    (recur (x))
+    x))
+
+(defn ednable-scalar
+  []
+  (call-through (rand-nth ednable-scalars)))
+
+(def ednable-collections
+  [[gen/vec [ednable-scalars]]
+   [gen/set [ednable-scalars]]
+   [gen/hash-map [ednable-scalars ednable-scalars]]])
+
+(defn ednable-collection
+  []
+  (let [[coll args] (rand-nth ednable-collections)]
+    (apply coll (map rand-nth args))))
+
+(defn ednable
+  []
+  (gen/one-of ednable-scalar ednable-collection))
+
+(defn non-ednable
+  "Generate something that can be printed with *print-dup*, but
+   cannot be read back via edn/read."
+  []
+  (gen/one-of namespace var))
+
+(defn dup-readable
+  "Generate something that requires print-dup to be printed in
+   a roundtrippable way."
+  []
+  (gen/one-of namespace var))

test/clojure/test_clojure/reader.clj

@@ -21,7 +21,9 @@
   (:use [clojure.instant :only [read-instant-date
                                 read-instant-calendar
                                 read-instant-timestamp]])
-  (:require clojure.walk)
+  (:require clojure.walk
+            [clojure.test.generative :refer (defspec)]
+            [clojure.test-clojure.generators :as cgen])
   (:import [clojure.lang BigInt Ratio]
            java.io.File
            java.util.TimeZone))
@@ -571,3 +573,38 @@
            Exception #"No reader function for tag foo" "#foo [1 2]"
            Exception #"No reader function for tag bar/foo" "#bar/foo [1 2]"
            Exception #"No reader function for tag bar.baz/foo" "#bar.baz/foo [1 2]"))))
+
+
+(defn roundtrip
+  "Print an object and read it back. Returns rather than throws
+   any exceptions."
+  [o]
+  (binding [*print-length* nil
+            *print-dup* nil
+            *print-level* nil]
+    (try
+     (-> o pr-str read-string)
+     (catch Throwable t t))))
+
+(defn roundtrip-dup
+  "Print an object with print-dup and read it back.
+   Returns rather than throws any exceptions."
+  [o]
+  (binding [*print-length* nil
+            *print-dup* true
+            *print-level* nil]
+    (try
+     (-> o pr-str read-string)
+     (catch Throwable t t))))
+
+(defspec types-that-should-roundtrip
+  roundtrip
+  [^anything o]
+  (when-not (= o %)
+    (throw (ex-info "Value cannot roundtrip, see ex-data" {:printed o :read %}))))
+
+(defspec types-that-need-dup-to-roundtrip
+  roundtrip-dup
+  [^{:tag cgen/dup-readable} o]
+  (when-not (= o %)
+    (throw (ex-info "Value cannot roundtrip, see ex-data" {:printed o :read %}))))