diff options
Diffstat (limited to 'src/clojure/contrib/test_contrib')
23 files changed, 0 insertions, 2515 deletions
diff --git a/src/clojure/contrib/test_contrib/complex_numbers.clj b/src/clojure/contrib/test_contrib/complex_numbers.clj deleted file mode 100644 index 7498e897..00000000 --- a/src/clojure/contrib/test_contrib/complex_numbers.clj +++ /dev/null @@ -1,313 +0,0 @@ -;; Test routines for complex-numbers.clj - -;; by Konrad Hinsen -;; last updated April 2, 2009 - -;; Copyright (c) Konrad Hinsen, 2008. 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. - -(ns clojure.contrib.test-contrib.complex-numbers - (:refer-clojure :exclude [+ - * / = < > <= >=]) - (:use [clojure.test - :only (deftest is are run-tests)] - [clojure.contrib.generic.arithmetic - :only (+ - * /)] - [clojure.contrib.generic.comparison - :only (= < > <= >=)] - [clojure.contrib.generic.math-functions - :only (abs approx= conjugate exp sqr sqrt)] - [clojure.contrib.complex-numbers - :only (complex imaginary real imag)])) - -(deftest complex-addition - (is (= (+ (complex 1 2) (complex 1 2)) (complex 2 4))) - (is (= (+ (complex 1 2) (complex -3 -7)) (complex -2 -5))) - (is (= (+ (complex -3 -7) (complex 1 2)) (complex -2 -5))) - (is (= (+ (complex 1 2) 3) (complex 4 2))) - (is (= (+ 3 (complex 1 2)) (complex 4 2))) - (is (= (+ (complex 1 2) -1) (imaginary 2))) - (is (= (+ -1 (complex 1 2)) (imaginary 2))) - (is (= (+ (complex 1 2) (imaginary -2)) 1)) - (is (= (+ (imaginary -2) (complex 1 2)) 1)) - (is (= (+ (complex 1 2) (imaginary 5)) (complex 1 7))) - (is (= (+ (imaginary 5) (complex 1 2)) (complex 1 7))) - (is (= (+ (complex -3 -7) (complex 1 2)) (complex -2 -5))) - (is (= (+ (complex 1 2) (complex -3 -7)) (complex -2 -5))) - (is (= (+ (complex -3 -7) (complex -3 -7)) (complex -6 -14))) - (is (= (+ (complex -3 -7) 3) (imaginary -7))) - (is (= (+ 3 (complex -3 -7)) (imaginary -7))) - (is (= (+ (complex -3 -7) -1) (complex -4 -7))) - (is (= (+ -1 (complex -3 -7)) (complex -4 -7))) - (is (= (+ (complex -3 -7) (imaginary -2)) (complex -3 -9))) - (is (= (+ (imaginary -2) (complex -3 -7)) (complex -3 -9))) - (is (= (+ (complex -3 -7) (imaginary 5)) (complex -3 -2))) - (is (= (+ (imaginary 5) (complex -3 -7)) (complex -3 -2))) - (is (= (+ 3 (complex 1 2)) (complex 4 2))) - (is (= (+ (complex 1 2) 3) (complex 4 2))) - (is (= (+ 3 (complex -3 -7)) (imaginary -7))) - (is (= (+ (complex -3 -7) 3) (imaginary -7))) - (is (= (+ 3 (imaginary -2)) (complex 3 -2))) - (is (= (+ (imaginary -2) 3) (complex 3 -2))) - (is (= (+ 3 (imaginary 5)) (complex 3 5))) - (is (= (+ (imaginary 5) 3) (complex 3 5))) - (is (= (+ -1 (complex 1 2)) (imaginary 2))) - (is (= (+ (complex 1 2) -1) (imaginary 2))) - (is (= (+ -1 (complex -3 -7)) (complex -4 -7))) - (is (= (+ (complex -3 -7) -1) (complex -4 -7))) - (is (= (+ -1 (imaginary -2)) (complex -1 -2))) - (is (= (+ (imaginary -2) -1) (complex -1 -2))) - (is (= (+ -1 (imaginary 5)) (complex -1 5))) - (is (= (+ (imaginary 5) -1) (complex -1 5))) - (is (= (+ (imaginary -2) (complex 1 2)) 1)) - (is (= (+ (complex 1 2) (imaginary -2)) 1)) - (is (= (+ (imaginary -2) (complex -3 -7)) (complex -3 -9))) - (is (= (+ (complex -3 -7) (imaginary -2)) (complex -3 -9))) - (is (= (+ (imaginary -2) 3) (complex 3 -2))) - (is (= (+ 3 (imaginary -2)) (complex 3 -2))) - (is (= (+ (imaginary -2) -1) (complex -1 -2))) - (is (= (+ -1 (imaginary -2)) (complex -1 -2))) - (is (= (+ (imaginary -2) (imaginary -2)) (imaginary -4))) - (is (= (+ (imaginary -2) (imaginary 5)) (imaginary 3))) - (is (= (+ (imaginary 5) (imaginary -2)) (imaginary 3))) - (is (= (+ (imaginary 5) (complex 1 2)) (complex 1 7))) - (is (= (+ (complex 1 2) (imaginary 5)) (complex 1 7))) - (is (= (+ (imaginary 5) (complex -3 -7)) (complex -3 -2))) - (is (= (+ (complex -3 -7) (imaginary 5)) (complex -3 -2))) - (is (= (+ (imaginary 5) 3) (complex 3 5))) - (is (= (+ 3 (imaginary 5)) (complex 3 5))) - (is (= (+ (imaginary 5) -1) (complex -1 5))) - (is (= (+ -1 (imaginary 5)) (complex -1 5))) - (is (= (+ (imaginary 5) (imaginary -2)) (imaginary 3))) - (is (= (+ (imaginary -2) (imaginary 5)) (imaginary 3))) - (is (= (+ (imaginary 5) (imaginary 5)) (imaginary 10)))) - -(deftest complex-subtraction - (is (= (- (complex 1 2) (complex 1 2)) 0)) - (is (= (- (complex 1 2) (complex -3 -7)) (complex 4 9))) - (is (= (- (complex -3 -7) (complex 1 2)) (complex -4 -9))) - (is (= (- (complex 1 2) 3) (complex -2 2))) - (is (= (- 3 (complex 1 2)) (complex 2 -2))) - (is (= (- (complex 1 2) -1) (complex 2 2))) - (is (= (- -1 (complex 1 2)) (complex -2 -2))) - (is (= (- (complex 1 2) (imaginary -2)) (complex 1 4))) - (is (= (- (imaginary -2) (complex 1 2)) (complex -1 -4))) - (is (= (- (complex 1 2) (imaginary 5)) (complex 1 -3))) - (is (= (- (imaginary 5) (complex 1 2)) (complex -1 3))) - (is (= (- (complex -3 -7) (complex 1 2)) (complex -4 -9))) - (is (= (- (complex 1 2) (complex -3 -7)) (complex 4 9))) - (is (= (- (complex -3 -7) (complex -3 -7)) 0)) - (is (= (- (complex -3 -7) 3) (complex -6 -7))) - (is (= (- 3 (complex -3 -7)) (complex 6 7))) - (is (= (- (complex -3 -7) -1) (complex -2 -7))) - (is (= (- -1 (complex -3 -7)) (complex 2 7))) - (is (= (- (complex -3 -7) (imaginary -2)) (complex -3 -5))) - (is (= (- (imaginary -2) (complex -3 -7)) (complex 3 5))) - (is (= (- (complex -3 -7) (imaginary 5)) (complex -3 -12))) - (is (= (- (imaginary 5) (complex -3 -7)) (complex 3 12))) - (is (= (- 3 (complex 1 2)) (complex 2 -2))) - (is (= (- (complex 1 2) 3) (complex -2 2))) - (is (= (- 3 (complex -3 -7)) (complex 6 7))) - (is (= (- (complex -3 -7) 3) (complex -6 -7))) - (is (= (- 3 (imaginary -2)) (complex 3 2))) - (is (= (- (imaginary -2) 3) (complex -3 -2))) - (is (= (- 3 (imaginary 5)) (complex 3 -5))) - (is (= (- (imaginary 5) 3) (complex -3 5))) - (is (= (- -1 (complex 1 2)) (complex -2 -2))) - (is (= (- (complex 1 2) -1) (complex 2 2))) - (is (= (- -1 (complex -3 -7)) (complex 2 7))) - (is (= (- (complex -3 -7) -1) (complex -2 -7))) - (is (= (- -1 (imaginary -2)) (complex -1 2))) - (is (= (- (imaginary -2) -1) (complex 1 -2))) - (is (= (- -1 (imaginary 5)) (complex -1 -5))) - (is (= (- (imaginary 5) -1) (complex 1 5))) - (is (= (- (imaginary -2) (complex 1 2)) (complex -1 -4))) - (is (= (- (complex 1 2) (imaginary -2)) (complex 1 4))) - (is (= (- (imaginary -2) (complex -3 -7)) (complex 3 5))) - (is (= (- (complex -3 -7) (imaginary -2)) (complex -3 -5))) - (is (= (- (imaginary -2) 3) (complex -3 -2))) - (is (= (- 3 (imaginary -2)) (complex 3 2))) - (is (= (- (imaginary -2) -1) (complex 1 -2))) - (is (= (- -1 (imaginary -2)) (complex -1 2))) - (is (= (- (imaginary -2) (imaginary -2)) 0)) - (is (= (- (imaginary -2) (imaginary 5)) (imaginary -7))) - (is (= (- (imaginary 5) (imaginary -2)) (imaginary 7))) - (is (= (- (imaginary 5) (complex 1 2)) (complex -1 3))) - (is (= (- (complex 1 2) (imaginary 5)) (complex 1 -3))) - (is (= (- (imaginary 5) (complex -3 -7)) (complex 3 12))) - (is (= (- (complex -3 -7) (imaginary 5)) (complex -3 -12))) - (is (= (- (imaginary 5) 3) (complex -3 5))) - (is (= (- 3 (imaginary 5)) (complex 3 -5))) - (is (= (- (imaginary 5) -1) (complex 1 5))) - (is (= (- -1 (imaginary 5)) (complex -1 -5))) - (is (= (- (imaginary 5) (imaginary -2)) (imaginary 7))) - (is (= (- (imaginary -2) (imaginary 5)) (imaginary -7))) - (is (= (- (imaginary 5) (imaginary 5)) 0))) - -(deftest complex-multiplication - (is (= (* (complex 1 2) (complex 1 2)) (complex -3 4))) - (is (= (* (complex 1 2) (complex -3 -7)) (complex 11 -13))) - (is (= (* (complex -3 -7) (complex 1 2)) (complex 11 -13))) - (is (= (* (complex 1 2) 3) (complex 3 6))) - (is (= (* 3 (complex 1 2)) (complex 3 6))) - (is (= (* (complex 1 2) -1) (complex -1 -2))) - (is (= (* -1 (complex 1 2)) (complex -1 -2))) - (is (= (* (complex 1 2) (imaginary -2)) (complex 4 -2))) - (is (= (* (imaginary -2) (complex 1 2)) (complex 4 -2))) - (is (= (* (complex 1 2) (imaginary 5)) (complex -10 5))) - (is (= (* (imaginary 5) (complex 1 2)) (complex -10 5))) - (is (= (* (complex -3 -7) (complex 1 2)) (complex 11 -13))) - (is (= (* (complex 1 2) (complex -3 -7)) (complex 11 -13))) - (is (= (* (complex -3 -7) (complex -3 -7)) (complex -40 42))) - (is (= (* (complex -3 -7) 3) (complex -9 -21))) - (is (= (* 3 (complex -3 -7)) (complex -9 -21))) - (is (= (* (complex -3 -7) -1) (complex 3 7))) - (is (= (* -1 (complex -3 -7)) (complex 3 7))) - (is (= (* (complex -3 -7) (imaginary -2)) (complex -14 6))) - (is (= (* (imaginary -2) (complex -3 -7)) (complex -14 6))) - (is (= (* (complex -3 -7) (imaginary 5)) (complex 35 -15))) - (is (= (* (imaginary 5) (complex -3 -7)) (complex 35 -15))) - (is (= (* 3 (complex 1 2)) (complex 3 6))) - (is (= (* (complex 1 2) 3) (complex 3 6))) - (is (= (* 3 (complex -3 -7)) (complex -9 -21))) - (is (= (* (complex -3 -7) 3) (complex -9 -21))) - (is (= (* 3 (imaginary -2)) (imaginary -6))) - (is (= (* (imaginary -2) 3) (imaginary -6))) - (is (= (* 3 (imaginary 5)) (imaginary 15))) - (is (= (* (imaginary 5) 3) (imaginary 15))) - (is (= (* -1 (complex 1 2)) (complex -1 -2))) - (is (= (* (complex 1 2) -1) (complex -1 -2))) - (is (= (* -1 (complex -3 -7)) (complex 3 7))) - (is (= (* (complex -3 -7) -1) (complex 3 7))) - (is (= (* -1 (imaginary -2)) (imaginary 2))) - (is (= (* (imaginary -2) -1) (imaginary 2))) - (is (= (* -1 (imaginary 5)) (imaginary -5))) - (is (= (* (imaginary 5) -1) (imaginary -5))) - (is (= (* (imaginary -2) (complex 1 2)) (complex 4 -2))) - (is (= (* (complex 1 2) (imaginary -2)) (complex 4 -2))) - (is (= (* (imaginary -2) (complex -3 -7)) (complex -14 6))) - (is (= (* (complex -3 -7) (imaginary -2)) (complex -14 6))) - (is (= (* (imaginary -2) 3) (imaginary -6))) - (is (= (* 3 (imaginary -2)) (imaginary -6))) - (is (= (* (imaginary -2) -1) (imaginary 2))) - (is (= (* -1 (imaginary -2)) (imaginary 2))) - (is (= (* (imaginary -2) (imaginary -2)) -4)) - (is (= (* (imaginary -2) (imaginary 5)) 10)) - (is (= (* (imaginary 5) (imaginary -2)) 10)) - (is (= (* (imaginary 5) (complex 1 2)) (complex -10 5))) - (is (= (* (complex 1 2) (imaginary 5)) (complex -10 5))) - (is (= (* (imaginary 5) (complex -3 -7)) (complex 35 -15))) - (is (= (* (complex -3 -7) (imaginary 5)) (complex 35 -15))) - (is (= (* (imaginary 5) 3) (imaginary 15))) - (is (= (* 3 (imaginary 5)) (imaginary 15))) - (is (= (* (imaginary 5) -1) (imaginary -5))) - (is (= (* -1 (imaginary 5)) (imaginary -5))) - (is (= (* (imaginary 5) (imaginary -2)) 10)) - (is (= (* (imaginary -2) (imaginary 5)) 10)) - (is (= (* (imaginary 5) (imaginary 5)) -25))) - -(deftest complex-division - (is (= (/ (complex 1 2) (complex 1 2)) 1)) - (is (= (/ (complex 1 2) (complex -3 -7)) (complex -17/58 1/58))) - (is (= (/ (complex -3 -7) (complex 1 2)) (complex -17/5 -1/5))) - (is (= (/ (complex 1 2) 3) (complex 1/3 2/3))) - (is (= (/ 3 (complex 1 2)) (complex 3/5 -6/5))) - (is (= (/ (complex 1 2) -1) (complex -1 -2))) - (is (= (/ -1 (complex 1 2)) (complex -1/5 2/5))) - (is (= (/ (complex 1 2) (imaginary -2)) (complex -1 1/2))) - (is (= (/ (imaginary -2) (complex 1 2)) (complex -4/5 -2/5))) - (is (= (/ (complex 1 2) (imaginary 5)) (complex 2/5 -1/5))) - (is (= (/ (imaginary 5) (complex 1 2)) (complex 2 1))) - (is (= (/ (complex -3 -7) (complex 1 2)) (complex -17/5 -1/5))) - (is (= (/ (complex 1 2) (complex -3 -7)) (complex -17/58 1/58))) - (is (= (/ (complex -3 -7) (complex -3 -7)) 1)) - (is (= (/ (complex -3 -7) 3) (complex -1 -7/3))) - (is (= (/ 3 (complex -3 -7)) (complex -9/58 21/58))) - (is (= (/ (complex -3 -7) -1) (complex 3 7))) - (is (= (/ -1 (complex -3 -7)) (complex 3/58 -7/58))) - (is (= (/ (complex -3 -7) (imaginary -2)) (complex 7/2 -3/2))) - (is (= (/ (imaginary -2) (complex -3 -7)) (complex 7/29 3/29))) - (is (= (/ (complex -3 -7) (imaginary 5)) (complex -7/5 3/5))) - (is (= (/ (imaginary 5) (complex -3 -7)) (complex -35/58 -15/58))) - (is (= (/ 3 (complex 1 2)) (complex 3/5 -6/5))) - (is (= (/ (complex 1 2) 3) (complex 1/3 2/3))) - (is (= (/ 3 (complex -3 -7)) (complex -9/58 21/58))) - (is (= (/ (complex -3 -7) 3) (complex -1 -7/3))) - (is (= (/ 3 (imaginary -2)) (imaginary 1.5))) - (is (= (/ (imaginary -2) 3) (imaginary -2/3))) - (is (= (/ 3 (imaginary 5)) (imaginary -3/5))) - (is (= (/ (imaginary 5) 3) (imaginary 5/3))) - (is (= (/ -1 (complex 1 2)) (complex -1/5 2/5))) - (is (= (/ (complex 1 2) -1) (complex -1 -2))) - (is (= (/ -1 (complex -3 -7)) (complex 3/58 -7/58))) - (is (= (/ (complex -3 -7) -1) (complex 3 7))) - (is (= (/ -1 (imaginary -2)) (imaginary -1/2))) - (is (= (/ (imaginary -2) -1) (imaginary 2))) - (is (= (/ -1 (imaginary 5)) (imaginary 1/5))) - (is (= (/ (imaginary 5) -1) (imaginary -5))) - (is (= (/ (imaginary -2) (complex 1 2)) (complex -4/5 -2/5))) - (is (= (/ (complex 1 2) (imaginary -2)) (complex -1 1/2))) - (is (= (/ (imaginary -2) (complex -3 -7)) (complex 7/29 3/29))) - (is (= (/ (complex -3 -7) (imaginary -2)) (complex 7/2 -3/2))) - (is (= (/ (imaginary -2) 3) (imaginary -2/3))) - (is (= (/ 3 (imaginary -2)) (imaginary 3/2))) - (is (= (/ (imaginary -2) -1) (imaginary 2))) - (is (= (/ -1 (imaginary -2)) (imaginary -1/2))) - (is (= (/ (imaginary -2) (imaginary -2)) 1)) - (is (= (/ (imaginary -2) (imaginary 5)) -2/5)) - (is (= (/ (imaginary 5) (imaginary -2)) -5/2)) - (is (= (/ (imaginary 5) (complex 1 2)) (complex 2 1))) - (is (= (/ (complex 1 2) (imaginary 5)) (complex 2/5 -1/5))) - (is (= (/ (imaginary 5) (complex -3 -7)) (complex -35/58 -15/58))) - (is (= (/ (complex -3 -7) (imaginary 5)) (complex -7/5 3/5))) - (is (= (/ (imaginary 5) 3) (imaginary 5/3))) - (is (= (/ 3 (imaginary 5)) (imaginary -3/5))) - (is (= (/ (imaginary 5) -1) (imaginary -5))) - (is (= (/ -1 (imaginary 5)) (imaginary 1/5))) - (is (= (/ (imaginary 5) (imaginary -2)) -5/2)) - (is (= (/ (imaginary -2) (imaginary 5)) -2/5)) - (is (= (/ (imaginary 5) (imaginary 5)) 1))) - -(deftest complex-conjugate - (is (= (conjugate (complex 1 2)) (complex 1 -2))) - (is (= (conjugate (complex -3 -7)) (complex -3 7))) - (is (= (conjugate (imaginary -2)) (imaginary 2))) - (is (= (conjugate (imaginary 5)) (imaginary -5)))) - -(deftest complex-abs - (doseq [c [(complex 1 2) (complex -2 3) (complex 4 -2) - (complex -3 -7) (imaginary -2) (imaginary 5)]] - (is (approx= (* c (conjugate c)) - (sqr (abs c)) - 1e-14)))) - -(deftest complex-sqrt - (doseq [c [(complex 1 2) (complex -2 3) (complex 4 -2) - (complex -3 -7) (imaginary -2) (imaginary 5)]] - (let [r (sqrt c)] - (is (approx= c (sqr r) 1e-14)) - (is (>= (real r) 0))))) - -(deftest complex-exp - (is (approx= (exp (complex 1 2)) - (complex -1.1312043837568135 2.4717266720048188) - 1e-14)) - (is (approx= (exp (complex 2 3)) - (complex -7.3151100949011028 1.0427436562359045) - 1e-14)) - (is (approx= (exp (complex 4 -2)) - (complex -22.720847417619233 -49.645957334580565) - 1e-14)) - (is (approx= (exp (complex 3 -7)) - (complex 15.142531566086868 -13.195928586605717) - 1e-14)) - (is (approx= (exp (imaginary -2)) - (complex -0.41614683654714241 -0.90929742682568171) - 1e-14)) - (is (approx= (exp (imaginary 5)) - (complex 0.2836621854632263 -0.95892427466313845) - 1e-14))) diff --git a/src/clojure/contrib/test_contrib/fnmap.clj b/src/clojure/contrib/test_contrib/fnmap.clj deleted file mode 100644 index 7fe87cc3..00000000 --- a/src/clojure/contrib/test_contrib/fnmap.clj +++ /dev/null @@ -1,39 +0,0 @@ -(ns clojure.contrib.test-contrib.fnmap - (:use clojure.contrib.fnmap - clojure.test)) - -(deftest acts-like-map - (let [m1 (fnmap get assoc :key1 1 :key2 2)] - (are [k v] (= v (get m1 k)) - :key1 1 - :key2 2 - :nonexistent-key nil) - (are [k v] (= v (k m1)) - :key1 1 - :key2 2 - :nonexistent-key nil) - (let [m2 (assoc m1 :key3 3 :key4 4)] - (are [k v] (= v (get m2 k)) - :key1 1 - :key2 2 - :key3 3 - :key4 4 - :nonexistent-key nil)))) - -(defn assoc-validate [m key value] - (if (integer? value) - (assoc m key value) - (throw (Exception. "Only integers allowed in this map!")))) - -(deftest validators - (let [m (fnmap get assoc-validate)] - (is (= 2 (:key2 (assoc m :key2 2)))) - (is (thrown? Exception (assoc m :key3 3.14))))) - -(defn get-transform [m key] - (when-let [value (m key)] - (- value))) - -(deftest transforms - (let [m (fnmap get-transform assoc)] - (is (= -2 (:key2 (assoc m :key2 2)))))) diff --git a/src/clojure/contrib/test_contrib/greatest_least.clj b/src/clojure/contrib/test_contrib/greatest_least.clj deleted file mode 100644 index f273aaf2..00000000 --- a/src/clojure/contrib/test_contrib/greatest_least.clj +++ /dev/null @@ -1,65 +0,0 @@ -(ns clojure.contrib.test-contrib.greatest-least - (:use clojure.contrib.greatest-least - [clojure.test :only (is deftest run-tests)])) - -(deftest test-greatest - (is (nil? (greatest)) "greatest with no arguments is nil") - (is (= 1 (greatest 1))) - (is (= 2 (greatest 1 2))) - (is (= 2 (greatest 2 1))) - (is (= "b" (greatest "aa" "b")))) - -(deftest test-greatest-by - (is (nil? (greatest-by identity)) "greatest-by with no arguments is nil") - (is (= "" (greatest-by count ""))) - (is (= "a" (greatest-by count "a" ""))) - (is (= "a" (greatest-by count "" "a"))) - (is (= "aa" (greatest-by count "aa" "b")))) - -(deftest test-least - (is (nil? (least)) "least with no arguments is nil") - (is (= 1 (least 1))) - (is (= 1 (least 1 2))) - (is (= 1 (least 2 1))) - (is (= "aa" (least "aa" "b")))) - -(deftest test-least-by - (is (nil? (least-by identity)) "least-by with no arguments is nil") - (is (= "" (least-by count ""))) - (is (= "" (least-by count "a" ""))) - (is (= "" (least-by count "" "a"))) - (is (= "b" (least-by count "aa" "b")))) - -(deftest test-all-greatest - (is (nil? (all-greatest)) "all-greatest with no arguments is nil") - (is (= (list 1) (all-greatest 1))) - (is (= (list 1 1) (all-greatest 1 1))) - (is (= (list 2) (all-greatest 2 1 1))) - (is (= (list 2) (all-greatest 1 2 1))) - (is (= (list 2) (all-greatest 1 1 2))) - (is (= (list :c) (all-greatest :b :c :a)))) - -(deftest test-all-greatest-by - (is (nil? (all-greatest-by identity)) "all-greatest-by with no arguments is nil") - (is (= (list "a")) (all-greatest-by count "a")) - (is (= (list "a" "a")) (all-greatest-by count "a" "a")) - (is (= (list "aa")) (all-greatest-by count "aa" "b")) - (is (= (list "aa")) (all-greatest-by count "b" "aa" "c")) - (is (= (list "cc" "aa")) (all-greatest-by count "aa" "b" "cc"))) - -(deftest test-all-least - (is (nil? (all-least)) "all-least with no arguments is nil") - (is (= (list 1) (all-least 1))) - (is (= (list 1 1) (all-least 1 1))) - (is (= (list 1 1) (all-least 2 1 1))) - (is (= (list 1 1) (all-least 1 2 1))) - (is (= (list 1 1) (all-least 1 1 2))) - (is (= (list :a) (all-least :b :c :a)))) - -(deftest test-all-least-by - (is (nil? (all-least-by identity)) "all-least-by with no arguments is nil") - (is (= (list "a")) (all-least-by count "a")) - (is (= (list "a" "a")) (all-least-by count "a" "a")) - (is (= (list "b")) (all-least-by count "aa" "b")) - (is (= (list "c" "b")) (all-least-by count "b" "aa" "c")) - (is (= (list "b")) (all-least-by count "aa" "b" "cc"))) diff --git a/src/clojure/contrib/test_contrib/java_utils.clj b/src/clojure/contrib/test_contrib/java_utils.clj deleted file mode 100644 index 44901ad1..00000000 --- a/src/clojure/contrib/test_contrib/java_utils.clj +++ /dev/null @@ -1,10 +0,0 @@ -(ns clojure.contrib.test-contrib.java-utils - (:use clojure.test clojure.contrib.java-utils)) - -(deftest t-as-str - (is (= "foo" (as-str "foo"))) - (is (= "foo" (as-str 'foo))) - (is (= "foo" (as-str :foo))) - (is (= "[1 2 3]" (as-str [1 2 3]))) - (is (= "Hello, World!" (as-str "Hello, " :World \!))) - (is (= (str {:foo :bar}) (as-str {:foo :bar})))) diff --git a/src/clojure/contrib/test_contrib/macro_utils.clj b/src/clojure/contrib/test_contrib/macro_utils.clj deleted file mode 100644 index ac1ced06..00000000 --- a/src/clojure/contrib/test_contrib/macro_utils.clj +++ /dev/null @@ -1,67 +0,0 @@ -;; Test routines for macro_utils.clj - -;; by Konrad Hinsen -;; last updated May 6, 2009 - -;; Copyright (c) Konrad Hinsen, 2008. 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. - -(ns clojure.contrib.test-contrib.macro-utils - (:use [clojure.test :only (deftest is are run-tests use-fixtures)] - [clojure.contrib.macro-utils - :only (macrolet symbol-macrolet defsymbolmacro with-symbol-macros - mexpand-1 mexpand mexpand-all)] - [clojure.contrib.monads - :only (with-monad domonad)])) - -(use-fixtures :each - (fn [f] (binding [*ns* (the-ns 'clojure.contrib.test-contrib.macro-utils)] - (f)))) - -(deftest macrolet-test - (is (= (macroexpand-1 - '(macrolet [(foo [form] `(~form ~form))] (foo x))) - '(do (x x))))) - -(deftest symbol-macrolet-test - (is (= (macroexpand-1 - '(symbol-macrolet [x xx y yy] - (exp [a y] (x y)))) - '(do (exp [a yy] (xx yy))))) - (is (= (macroexpand-1 - '(symbol-macrolet [def foo] - (def def def))) - '(do (def def foo)))) - (is (= (macroexpand-1 - '(symbol-macrolet [x foo z bar] - (let [a x b y x b] [a b x z]))) - '(do (let* [a foo b y x b] [a b x bar])))) - (is (= (macroexpand-1 - '(symbol-macrolet [x foo z bar] - (fn ([x y] [x y z]) ([x y z] [x y z])))) - '(do (fn* ([x y] [x y bar]) ([x y z] [x y z]))))) - (is (= (macroexpand-1 - '(symbol-macrolet [x foo z bar] - (fn f ([x y] [x y z]) ([x y z] [x y z])))) - '(do (fn* f ([x y] [x y bar]) ([x y z] [x y z]))))) - (is (= (nth (second (macroexpand-1 - '(symbol-macrolet [x xx y yy z zz] - (domonad m [a x b y x z] [a b x z])))) 2) - '(do (m-bind xx (fn* ([a] - (m-bind yy (fn* ([b] - (m-bind zz (fn* ([x] - (m-result [a b x zz])))))))))))))) - -(deftest symbol-test - (defsymbolmacro sum-2-3 (plus 2 3)) - (is (= (macroexpand '(with-symbol-macros (+ 1 sum-2-3))) - '(do (+ 1 (plus 2 3))))) - (is (= (macroexpand '(macrolet [(plus [a b] `(+ ~a ~b))] (+ 1 sum-2-3))) - '(do (+ 1 (clojure.core/+ 2 3))))) - (ns-unmap *ns* 'sum-2-3)) - diff --git a/src/clojure/contrib/test_contrib/mock_test.clj b/src/clojure/contrib/test_contrib/mock_test.clj deleted file mode 100644 index 1737305e..00000000 --- a/src/clojure/contrib/test_contrib/mock_test.clj +++ /dev/null @@ -1,131 +0,0 @@ -(ns clojure.contrib.test-contrib.mock-test - (:use clojure.test) - (:require [clojure.contrib.mock :as mock])) - -; Used as dummy dependency functions -(defn fn1 {:dynamic true} [x] :ignore) -(defn fn2 {:dynamic true} [x y] :ignore) -(defn fn3 {:dynamic true} ([x] :ignore) - ([x y z] :ignore)) -(defn fn4 {:dynamic true} [x y & r] :ignore) - -;functions created using fn directly lack the argslist meta data -(def #^{:dynamic true} deffed-differently (fn [x] :ignore)) - -(defmacro assert-called [fn-name called? & body] - `(let [called-status?# (atom false)] - (binding [~fn-name (fn [& args#] (reset! called-status?# true))] ~@body) - (is (= ~called? @called-status?#)))) - -(deftest test-convenience - (testing "once" - (is (false? (mock/once 0))) - (is (false? (mock/once 123))) - (is (true? (mock/once 1)))) - - (testing "never" - (is (false? (mock/never 4))) - (is (true? (mock/never 0)))) - - (testing "more-than" - (is (false? ((mock/more-than 5) 3))) - (is (true? ((mock/more-than 5) 9)))) - - (testing "less-than" - (is (true? ((mock/less-than 5) 3))) - (is (false? ((mock/less-than 5) 9)))) - - (testing "between" - (is (true? ((mock/between 5 8) 6))) - (is (false? ((mock/between 5 8) 5))))) - - -(deftest test-returns - (is (= {:returns 5} (mock/returns 5))) - (is (= {:other-key "test" :returns nil} (mock/returns nil {:other-key "test"})))) - - -(deftest test-has-args - (let [ex (:has-args (mock/has-args [1]))] - (is (fn? ex)) - (is (ex 'fn1 1)) - (is (ex 'fn1 1 5 6)) - (assert-called mock/unexpected-args true (ex 'fn1 5))) - (is (contains? (mock/has-args [] {:pre-existing-key "test"}) :pre-existing-key)) - (is (true? (((mock/has-args [5]) :has-args)'fn1 5)))) - - -(deftest test-has-matching-signature - (assert-called mock/no-matching-function-signature true - (mock/has-matching-signature? 'clojure.contrib.test-contrib.mock-test/fn2 [1])) - (assert-called mock/no-matching-function-signature true - (mock/has-matching-signature? 'clojure.contrib.test-contrib.mock-test/fn3 [1 3])) - (assert-called mock/no-matching-function-signature false - (mock/has-matching-signature? 'clojure.contrib.test-contrib.mock-test/fn3 [1 3 5])) - (assert-called mock/no-matching-function-signature false - (mock/has-matching-signature? 'clojure.contrib.test-contrib.mock-test/fn4 [1 3 5 7 9])) - (assert-called mock/no-matching-function-signature false - (mock/has-matching-signature? 'clojure.contrib.test-contrib.mock-test/fn4 [1 3])) - (assert-called mock/no-matching-function-signature true - (mock/has-matching-signature? 'clojure.contrib.test-contrib.mock-test/fn4 [1])) - (assert-called mock/no-matching-function-signature false - (mock/has-matching-signature? 'clojure.contrib.test-contrib.mock-test/deffed-differently [1]))) - - -(deftest test-times - (is (fn? ((mock/times #(= 1 %)) :times))) - (is (contains? (mock/times #(= 1 %) {:existing-key "test"}) :existing-key))) - -(deftest test-make-mock - (testing "invalid arguments" - (is (thrown? IllegalArgumentException (mock/make-mock [5])))) - - (testing "valid counter and unevaluated returns" - (let [[mock counter count-checker] (mock/make-mock 'fn1 (mock/returns 5 (mock/times 1)))] - (is (fn? mock)) - (is (= 0 @counter)) - (is (= 5 (mock :ignore-me))) - (is (= 1 @counter)))) - - (testing "returns as expected" - (let [[mock] (mock/make-mock 'fn1 (mock/returns 5))] - (is (= 5 (mock :ignore)))) - (let [[mock] (mock/make-mock 'fn1 (mock/returns #(* 2 %)))] - (is (= 10 ((mock :ignore) 5)) ":returns a function should not automatically - evaluate it."))) - - (testing "calls replacement-fn and returns the result" - (let [[mock] (mock/make-mock 'fn1 (mock/calls #(* 3 %)))] - (is (= 15 (mock 5)))) - (let [[mock] (mock/make-mock 'fn1 (mock/calls #(* 2 %) (mock/returns 3)))] - (is (= 10 (mock 5))))) - - (testing "argument validation" - (let [[mock] (mock/make-mock 'fn1 (mock/has-args [#(= 5 %)]))] - (assert-called mock/unexpected-args true (mock "test")) - (is (nil? (mock 5)))))) - - -(deftest test-make-count-checker - (let [checker (mock/make-count-checker 5 5)] - (assert-called mock/incorrect-invocation-count false (checker 'fn1 5)) - (assert-called mock/incorrect-invocation-count true (checker 'fn1 3)))) - - -(deftest test-validate-counts - (assert-called mock/incorrect-invocation-count false - (mock/validate-counts (list [(fn []) (atom 0) (mock/make-count-checker #(< % 6) '#(< % 6)) 'fn1]))) - (assert-called mock/incorrect-invocation-count true - (mock/validate-counts (list [(fn []) (atom 0) (mock/make-count-checker 4 4) 'fn1])))) - - -(deftest test-expect-macro - (let [under-test (fn [x] (fn1 x))] - (is (true? (mock/expect [fn1 (mock/times 1 (mock/has-args [#(= 3 %)]))] - (under-test 3)))) - (assert-called mock/unexpected-args true (mock/expect [fn1 (mock/times 1 (mock/has-args [#(= 4 %)]))] - (under-test 3)))) - (let [under-test (fn [] (fn2 (fn1 1) 3))] - (is (true? (mock/expect [fn1 (mock/times 1 (mock/has-args [#(= 1 %)] (mock/returns 2))) - fn2 (mock/times 1 (mock/has-args [#(= 2 %) #(= 3 %)] (mock/returns 5)))] - (under-test))))))
\ No newline at end of file diff --git a/src/clojure/contrib/test_contrib/mock_test/test_adapter_test.clj b/src/clojure/contrib/test_contrib/mock_test/test_adapter_test.clj deleted file mode 100644 index 5f21ce11..00000000 --- a/src/clojure/contrib/test_contrib/mock_test/test_adapter_test.clj +++ /dev/null @@ -1,18 +0,0 @@ -(ns clojure.contrib.test-contrib.mock-test.test-adapter-test - (:use clojure.contrib.mock.test-adapter - [clojure.contrib.test-contrib.mock-test :only (assert-called)] - clojure.test)) - -(deftest test-report-problem-called - (def #^{:private true :dynamic true} fn1 (fn [x] "dummy code")) - (def #^{:private true :dynamic true} fn2 (fn [x y] "dummy code2")) - (let [under-test (fn [x] (fn1 x))] - (assert-called clojure.contrib.mock.test-adapter/report-problem - true (expect [fn1 (times 5)] (under-test "hi"))))) - -(deftest test-is-report-called - (assert-called clojure.test/report true - (clojure.contrib.mock.test-adapter/report-problem - 'fn-name 5 6 "fake problem"))) - - diff --git a/src/clojure/contrib/test_contrib/monads.clj b/src/clojure/contrib/test_contrib/monads.clj deleted file mode 100644 index f523f0ec..00000000 --- a/src/clojure/contrib/test_contrib/monads.clj +++ /dev/null @@ -1,78 +0,0 @@ -;; Test routines for monads.clj - -;; by Konrad Hinsen -;; last updated March 28, 2009 - -;; Copyright (c) Konrad Hinsen, 2008. 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. - -(ns clojure.contrib.test-contrib.monads - (:use [clojure.test :only (deftest is are run-tests)] - [clojure.contrib.monads - :only (with-monad domonad m-lift m-seq m-chain - sequence-m maybe-m state-m maybe-t sequence-t)])) - -(deftest sequence-monad - (with-monad sequence-m - (are [a b] (= a b) - (domonad [x (range 3) y (range 2)] (+ x y)) - '(0 1 1 2 2 3) - (domonad [x (range 5) y (range (+ 1 x)) :when (= (+ x y) 2)] (list x y)) - '((1 1) (2 0)) - ((m-lift 2 #(list %1 %2)) (range 3) (range 2)) - '((0 0) (0 1) (1 0) (1 1) (2 0) (2 1)) - (m-seq (replicate 3 (range 2))) - '((0 0 0) (0 0 1) (0 1 0) (0 1 1) (1 0 0) (1 0 1) (1 1 0) (1 1 1)) - ((m-chain (replicate 3 range)) 5) - '(0 0 0 1 0 0 1 0 1 2) - (m-plus (range 3) (range 2)) - '(0 1 2 0 1)))) - -(deftest maybe-monad - (with-monad maybe-m - (let [m+ (m-lift 2 +) - mdiv (fn [x y] (domonad [a x b y :when (not (zero? b))] (/ a b)))] - (are [a b] (= a b) - (m+ (m-result 1) (m-result 3)) - (m-result 4) - (mdiv (m-result 1) (m-result 3)) - (m-result (/ 1 3)) - (m+ 1 (mdiv (m-result 1) (m-result 0))) - m-zero - (m-plus m-zero (m-result 1) m-zero (m-result 2)) - (m-result 1))))) - -(deftest seq-maybe-monad - (with-monad (maybe-t sequence-m) - (letfn [(pairs [xs] ((m-lift 2 #(list %1 %2)) xs xs))] - (are [a b] (= a b) - ((m-lift 1 inc) (for [n (range 10)] (when (odd? n) n))) - '(nil 2 nil 4 nil 6 nil 8 nil 10) - (pairs (for [n (range 5)] (when (odd? n) n))) - '(nil nil (1 1) nil (1 3) nil nil nil (3 1) nil (3 3) nil nil))))) - -(deftest state-maybe-monad - (with-monad (maybe-t state-m) - (is (= (for [[a b c d] (list [1 2 3 4] [nil 2 3 4] [ 1 nil 3 4] - [nil nil 3 4] [1 2 nil nil])] - (let [f (domonad - [x (m-plus (m-result a) (m-result b)) - y (m-plus (m-result c) (m-result d))] - (+ x y))] - (f :state))) - (list [4 :state] [5 :state] [4 :state] [nil :state] [nil :state]))))) - -(deftest state-seq-monad - (with-monad (sequence-t state-m) - (is (= (let [[a b c d] [1 2 10 20] - f (domonad - [x (m-plus (m-result a) (m-result b)) - y (m-plus (m-result c) (m-result d))] - (+ x y))] - (f :state))) - (list [(list 11 21 12 22) :state])))) diff --git a/src/clojure/contrib/test_contrib/pprint/cl_format.clj b/src/clojure/contrib/test_contrib/pprint/cl_format.clj deleted file mode 100644 index 6c73e63f..00000000 --- a/src/clojure/contrib/test_contrib/pprint/cl_format.clj +++ /dev/null @@ -1,670 +0,0 @@ -;;; cl_format.clj -- part of the pretty printer for Clojure - -;; by Tom Faulhaber -;; April 3, 2009 - -; Copyright (c) Tom Faulhaber, Dec 2008. 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. - -;; This test set tests the basic cl-format functionality - -(ns clojure.contrib.test-contrib.pprint.cl-format - (:refer-clojure :exclude [format]) - (:use [clojure.test :only (deftest are run-tests)] - clojure.contrib.test-contrib.pprint.helper - clojure.contrib.pprint)) - -(def format cl-format) - -;; TODO tests for ~A, ~D, etc. -;; TODO add tests for ~F, etc.: 0.0, 9.9999 with rounding, 9.9999E99 with rounding - -(simple-tests d-tests - (cl-format nil "~D" 0) "0" - (cl-format nil "~D" 2e6) "2000000" - (cl-format nil "~D" 2000000) "2000000" - (cl-format nil "~:D" 2000000) "2,000,000" - (cl-format nil "~D" 1/2) "1/2" - (cl-format nil "~D" 'fred) "fred" -) - -(simple-tests base-tests - (cl-format nil "~{~2r~^ ~}~%" (range 10)) - "0 1 10 11 100 101 110 111 1000 1001\n" - (with-out-str - (dotimes [i 35] - (binding [*print-base* (+ i 2)] ;print the decimal number 40 - (write 40) ;in each base from 2 to 36 - (if (zero? (mod i 10)) (prn) (cl-format true " "))))) - "101000 -1111 220 130 104 55 50 44 40 37 34 -31 2c 2a 28 26 24 22 20 1j 1i -1h 1g 1f 1e 1d 1c 1b 1a 19 18 -17 16 15 14 " - (with-out-str - (doseq [pb [2 3 8 10 16]] - (binding [*print-radix* true ;print the integer 10 and - *print-base* pb] ;the ratio 1/10 in bases 2, - (cl-format true "~&~S ~S~%" 10 1/10)))) ;3, 8, 10, 16 - "#b1010 #b1/1010 -#3r101 #3r1/101 -#o12 #o1/12 -10. #10r1/10 -#xa #x1/a -") - - - -(simple-tests cardinal-tests - (cl-format nil "~R" 0) "zero" - (cl-format nil "~R" 4) "four" - (cl-format nil "~R" 15) "fifteen" - (cl-format nil "~R" -15) "minus fifteen" - (cl-format nil "~R" 25) "twenty-five" - (cl-format nil "~R" 20) "twenty" - (cl-format nil "~R" 200) "two hundred" - (cl-format nil "~R" 203) "two hundred three" - - (cl-format nil "~R" 44879032) - "forty-four million, eight hundred seventy-nine thousand, thirty-two" - - (cl-format nil "~R" -44879032) - "minus forty-four million, eight hundred seventy-nine thousand, thirty-two" - - (cl-format nil "~R = ~:*~:D" 44000032) - "forty-four million, thirty-two = 44,000,032" - - (cl-format nil "~R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094) - "four hundred forty-eight septendecillion, seven hundred ninety sexdecillion, three hundred twenty-nine quindecillion, four hundred eighty quattuordecillion, nine hundred forty-eight tredecillion, two hundred nine duodecillion, three hundred eighty-four undecillion, three hundred eighty-nine decillion, four hundred twenty-nine nonillion, three hundred eighty-four octillion, twenty-nine septillion, three hundred eighty-four sextillion, twenty-nine quintillion, eight hundred forty-two quadrillion, ninety-eight trillion, four hundred twenty billion, nine hundred eighty-nine million, eight hundred forty-two thousand, ninety-four = 448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094" - - (cl-format nil "~R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094490320942058747587584758375847593475) - "448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,475 = 448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,475" - - (cl-format nil "~R = ~:*~:D" 2e6) - "two million = 2,000,000" - - (cl-format nil "~R = ~:*~:D" 200000200000) - "two hundred billion, two hundred thousand = 200,000,200,000") - -(simple-tests ordinal-tests - (cl-format nil "~:R" 0) "zeroth" - (cl-format nil "~:R" 4) "fourth" - (cl-format nil "~:R" 15) "fifteenth" - (cl-format nil "~:R" -15) "minus fifteenth" - (cl-format nil "~:R" 25) "twenty-fifth" - (cl-format nil "~:R" 20) "twentieth" - (cl-format nil "~:R" 200) "two hundredth" - (cl-format nil "~:R" 203) "two hundred third" - - (cl-format nil "~:R" 44879032) - "forty-four million, eight hundred seventy-nine thousand, thirty-second" - - (cl-format nil "~:R" -44879032) - "minus forty-four million, eight hundred seventy-nine thousand, thirty-second" - - (cl-format nil "~:R = ~:*~:D" 44000032) - "forty-four million, thirty-second = 44,000,032" - - (cl-format nil "~:R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094) - "four hundred forty-eight septendecillion, seven hundred ninety sexdecillion, three hundred twenty-nine quindecillion, four hundred eighty quattuordecillion, nine hundred forty-eight tredecillion, two hundred nine duodecillion, three hundred eighty-four undecillion, three hundred eighty-nine decillion, four hundred twenty-nine nonillion, three hundred eighty-four octillion, twenty-nine septillion, three hundred eighty-four sextillion, twenty-nine quintillion, eight hundred forty-two quadrillion, ninety-eight trillion, four hundred twenty billion, nine hundred eighty-nine million, eight hundred forty-two thousand, ninety-fourth = 448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094" - (cl-format nil "~:R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094490320942058747587584758375847593475) - "448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,475th = 448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,475" - (cl-format nil "~:R = ~:*~:D" 448790329480948209384389429384029384029842098420989842094490320942058747587584758375847593471) - "448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,471st = 448,790,329,480,948,209,384,389,429,384,029,384,029,842,098,420,989,842,094,490,320,942,058,747,587,584,758,375,847,593,471" - (cl-format nil "~:R = ~:*~:D" 2e6) - "two millionth = 2,000,000") - -(simple-tests ordinal1-tests - (cl-format nil "~:R" 1) "first" - (cl-format nil "~:R" 11) "eleventh" - (cl-format nil "~:R" 21) "twenty-first" - (cl-format nil "~:R" 20) "twentieth" - (cl-format nil "~:R" 220) "two hundred twentieth" - (cl-format nil "~:R" 200) "two hundredth" - (cl-format nil "~:R" 999) "nine hundred ninety-ninth" - ) - -(simple-tests roman-tests - (cl-format nil "~@R" 3) "III" - (cl-format nil "~@R" 4) "IV" - (cl-format nil "~@R" 9) "IX" - (cl-format nil "~@R" 29) "XXIX" - (cl-format nil "~@R" 429) "CDXXIX" - (cl-format nil "~@:R" 429) "CCCCXXVIIII" - (cl-format nil "~@:R" 3429) "MMMCCCCXXVIIII" - (cl-format nil "~@R" 3429) "MMMCDXXIX" - (cl-format nil "~@R" 3479) "MMMCDLXXIX" - (cl-format nil "~@R" 3409) "MMMCDIX" - (cl-format nil "~@R" 300) "CCC" - (cl-format nil "~@R ~D" 300 20) "CCC 20" - (cl-format nil "~@R" 5000) "5,000" - (cl-format nil "~@R ~D" 5000 20) "5,000 20" - (cl-format nil "~@R" "the quick") "the quick") - -(simple-tests c-tests - (cl-format nil "~{~c~^, ~}~%" "hello") "h, e, l, l, o\n" - (cl-format nil "~{~:c~^, ~}~%" "hello") "h, e, l, l, o\n" - (cl-format nil "~@C~%" \m) "\\m\n" - (cl-format nil "~@C~%" (char 222)) "\\Þ\n" - (cl-format nil "~@C~%" (char 8)) "\\backspace\n" - (cl-format nil "~@C~%" (char 3)) "\\\n") - -(simple-tests e-tests - (cl-format nil "*~E*" 0.0) "*0.0E+0*" - (cl-format nil "*~6E*" 0.0) "*0.0E+0*" - (cl-format nil "*~6,0E*" 0.0) "* 0.E+0*" - (cl-format nil "*~7,2E*" 0.0) "*0.00E+0*" - (cl-format nil "*~5E*" 0.0) "*0.E+0*" - (cl-format nil "*~10,2,2,,'?E*" 2.8E120) "*??????????*" - (cl-format nil "*~10,2E*" 9.99999) "* 1.00E+1*" - (cl-format nil "*~10,2E*" 9.99999E99) "* 1.00E+100*" - (cl-format nil "*~10,2,2E*" 9.99999E99) "* 1.00E+100*" - (cl-format nil "*~10,2,2,,'?E*" 9.99999E99) "*??????????*" - ) - -(simple-tests $-tests - (cl-format nil "~$" 22.3) "22.30" - (cl-format nil "~$" 22.375) "22.38" - (cl-format nil "~3,5$" 22.375) "00022.375" - (cl-format nil "~3,5,8$" 22.375) "00022.375" - (cl-format nil "~3,5,10$" 22.375) " 00022.375" - (cl-format nil "~3,5,14@$" 22.375) " +00022.375" - (cl-format nil "~3,5,14@$" 22.375) " +00022.375" - (cl-format nil "~3,5,14@:$" 22.375) "+ 00022.375" - (cl-format nil "~3,,14@:$" 0.375) "+ 0.375" - (cl-format nil "~1,1$" -12.0) "-12.0" - (cl-format nil "~1,1$" 12.0) "12.0" - (cl-format nil "~1,1$" 12.0) "12.0" - (cl-format nil "~1,1@$" 12.0) "+12.0" - (cl-format nil "~1,1,8,' @:$" 12.0) "+ 12.0" - (cl-format nil "~1,1,8,' @$" 12.0) " +12.0" - (cl-format nil "~1,1,8,' :$" 12.0) " 12.0" - (cl-format nil "~1,1,8,' $" 12.0) " 12.0" - (cl-format nil "~1,1,8,' @:$" -12.0) "- 12.0" - (cl-format nil "~1,1,8,' @$" -12.0) " -12.0" - (cl-format nil "~1,1,8,' :$" -12.0) "- 12.0" - (cl-format nil "~1,1,8,' $" -12.0) " -12.0" - (cl-format nil "~1,1$" 0.001) "0.0" - (cl-format nil "~2,1$" 0.001) "0.00" - (cl-format nil "~1,1,6$" 0.001) " 0.0" - (cl-format nil "~1,1,6$" 0.0015) " 0.0" - (cl-format nil "~2,1,6$" 0.005) " 0.01" - (cl-format nil "~2,1,6$" 0.01) " 0.01") - -(simple-tests f-tests - (cl-format nil "~,1f" -12.0) "-12.0") - -(simple-tests ampersand-tests - (cl-format nil "The quick brown ~a jumped over ~d lazy dogs" 'elephant 5) - "The quick brown elephant jumped over 5 lazy dogs" - (cl-format nil "The quick brown ~&~a jumped over ~d lazy dogs" 'elephant 5) - "The quick brown \nelephant jumped over 5 lazy dogs" - (cl-format nil "The quick brown ~&~a jumped\n~& over ~d lazy dogs" 'elephant 5) - "The quick brown \nelephant jumped\n over 5 lazy dogs" - (cl-format nil "~&The quick brown ~&~a jumped\n~& over ~d lazy dogs" 'elephant 5) - "The quick brown \nelephant jumped\n over 5 lazy dogs" - (cl-format nil "~3&The quick brown ~&~a jumped\n~& over ~d lazy dogs" 'elephant 5) - "\n\nThe quick brown \nelephant jumped\n over 5 lazy dogs" - (cl-format nil "~@{~&The quick brown ~a jumped over ~d lazy dogs~}" 'elephant 5 'fox 10) - "The quick brown elephant jumped over 5 lazy dogs\nThe quick brown fox jumped over 10 lazy dogs" - (cl-format nil "I ~[don't ~:;d~&o ~]have one~%" 0) "I don't have one\n" - (cl-format nil "I ~[don't ~:;d~&o ~]have one~%" 1) "I d\no have one\n") - -(simple-tests t-tests - (cl-format nil "~@{~&~A~8,4T~:*~A~}" - 'a 'aa 'aaa 'aaaa 'aaaaa 'aaaaaa 'aaaaaaa 'aaaaaaaa 'aaaaaaaaa 'aaaaaaaaaa) - "a a\naa aa\naaa aaa\naaaa aaaa\naaaaa aaaaa\naaaaaa aaaaaa\naaaaaaa aaaaaaa\naaaaaaaa aaaaaaaa\naaaaaaaaa aaaaaaaaa\naaaaaaaaaa aaaaaaaaaa" - (cl-format nil "~@{~&~A~,4T~:*~A~}" - 'a 'aa 'aaa 'aaaa 'aaaaa 'aaaaaa 'aaaaaaa 'aaaaaaaa 'aaaaaaaaa 'aaaaaaaaaa) - "a a\naa aa\naaa aaa\naaaa aaaa\naaaaa aaaaa\naaaaaa aaaaaa\naaaaaaa aaaaaaa\naaaaaaaa aaaaaaaa\naaaaaaaaa aaaaaaaaa\naaaaaaaaaa aaaaaaaaaa" - (cl-format nil "~@{~&~A~2,6@T~:*~A~}" 'a 'aa 'aaa 'aaaa 'aaaaa 'aaaaaa 'aaaaaaa 'aaaaaaaa 'aaaaaaaaa 'aaaaaaaaaa) - "a a\naa aa\naaa aaa\naaaa aaaa\naaaaa aaaaa\naaaaaa aaaaaa\naaaaaaa aaaaaaa\naaaaaaaa aaaaaaaa\naaaaaaaaa aaaaaaaaa\naaaaaaaaaa aaaaaaaaaa" -) - -(simple-tests paren-tests - (cl-format nil "~(PLEASE SPEAK QUIETLY IN HERE~)") "please speak quietly in here" - (cl-format nil "~@(PLEASE SPEAK QUIETLY IN HERE~)") "Please speak quietly in here" - (cl-format nil "~@:(but this Is imporTant~)") "BUT THIS IS IMPORTANT" - (cl-format nil "~:(the greAt gatsby~)!") "The Great Gatsby!" - ;; Test cases from CLtL 18.3 - string-upcase, et al. - (cl-format nil "~@:(~A~)" "Dr. Livingstone, I presume?") "DR. LIVINGSTONE, I PRESUME?" - (cl-format nil "~(~A~)" "Dr. Livingstone, I presume?") "dr. livingstone, i presume?" - (cl-format nil "~:(~A~)" " hello ") " Hello " - (cl-format nil "~:(~A~)" "occlUDeD cASEmenTs FOreSTAll iNADVertent DEFenestraTION") - "Occluded Casements Forestall Inadvertent Defenestration" - (cl-format nil "~:(~A~)" 'kludgy-hash-search) "Kludgy-Hash-Search" - (cl-format nil "~:(~A~)" "DON'T!") "Don'T!" ;not "Don't!" - (cl-format nil "~:(~A~)" "pipe 13a, foo16c") "Pipe 13a, Foo16c" -) - -(simple-tests square-bracket-tests - ;; Tests for format without modifiers - (cl-format nil "I ~[don't ~]have one~%" 0) "I don't have one\n" - (cl-format nil "I ~[don't ~]have one~%" 1) "I have one\n" - (cl-format nil "I ~[don't ~;do ~]have one~%" 0) "I don't have one\n" - (cl-format nil "I ~[don't ~;do ~]have one~%" 1) "I do have one\n" - (cl-format nil "I ~[don't ~;do ~]have one~%" 2) "I have one\n" - (cl-format nil "I ~[don't ~:;do ~]have one~%" 0) "I don't have one\n" - (cl-format nil "I ~[don't ~:;do ~]have one~%" 1) "I do have one\n" - (cl-format nil "I ~[don't ~:;do ~]have one~%" 2) "I do have one\n" - (cl-format nil "I ~[don't ~:;do ~]have one~%" 700) "I do have one\n" - - ;; Tests for format with a colon - (cl-format nil "I ~:[don't ~;do ~]have one~%" true) "I do have one\n" - (cl-format nil "I ~:[don't ~;do ~]have one~%" 700) "I do have one\n" - (cl-format nil "I ~:[don't ~;do ~]have one~%" '(a b)) "I do have one\n" - (cl-format nil "I ~:[don't ~;do ~]have one~%" nil) "I don't have one\n" - (cl-format nil "I ~:[don't ~;do ~]have one~%" false) "I don't have one\n" - - ;; Tests for format with an at sign - (cl-format nil "We had ~D wins~@[ (out of ~D tries)~].~%" 15 nil) "We had 15 wins.\n" - (cl-format nil "We had ~D wins~@[ (out of ~D tries)~].~%" 15 17) - "We had 15 wins (out of 17 tries).\n" - - ;; Format tests with directives - (cl-format nil "Max ~D: ~[Blue team ~D~;Red team ~D~:;No team ~A~].~%" 15, 0, 7) - "Max 15: Blue team 7.\n" - (cl-format nil "Max ~D: ~[Blue team ~D~;Red team ~D~:;No team ~A~].~%" 15, 1, 12) - "Max 15: Red team 12.\n" - (cl-format nil "Max ~D: ~[Blue team ~D~;Red team ~D~:;No team ~A~].~%" - 15, -1, "(system failure)") - "Max 15: No team (system failure).\n" - - ;; Nested format tests - (cl-format nil "Max ~D: ~[Blue team ~D~:[~; (complete success)~]~;Red team ~D~:;No team ~].~%" - 15, 0, 7, true) - "Max 15: Blue team 7 (complete success).\n" - (cl-format nil "Max ~D: ~[Blue team ~D~:[~; (complete success)~]~;Red team ~D~:;No team ~].~%" - 15, 0, 7, false) - "Max 15: Blue team 7.\n" - - ;; Test the selector as part of the argument - (cl-format nil "The answer is ~#[nothing~;~D~;~D out of ~D~:;something crazy~].") - "The answer is nothing." - (cl-format nil "The answer is ~#[nothing~;~D~;~D out of ~D~:;something crazy~]." 4) - "The answer is 4." - (cl-format nil "The answer is ~#[nothing~;~D~;~D out of ~D~:;something crazy~]." 7 22) - "The answer is 7 out of 22." - (cl-format nil "The answer is ~#[nothing~;~D~;~D out of ~D~:;something crazy~]." 1 2 3 4) - "The answer is something crazy." -) - -(simple-tests curly-brace-plain-tests - ;; Iteration from sublist - (cl-format nil "Coordinates are~{ [~D,~D]~}~%" [ 0, 1, 1, 0, 3, 5, 2, 1 ]) - "Coordinates are [0,1] [1,0] [3,5] [2,1]\n" - - (cl-format nil "Coordinates are~2{ [~D,~D]~}~%" [ 0, 1, 1, 0, 3, 5, 2, 1 ]) - "Coordinates are [0,1] [1,0]\n" - - (cl-format nil "Coordinates are~{ ~#[none~;<~D>~:;[~D,~D]~]~}~%" [ ]) - "Coordinates are\n" - - (cl-format nil "Coordinates are~{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [ ]) - "Coordinates are none\n" - - (cl-format nil "Coordinates are~{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [2 3 1]) - "Coordinates are [2,3] <1>\n" - - (cl-format nil "Coordinates are~{~:}~%" "" []) - "Coordinates are\n" - - (cl-format nil "Coordinates are~{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [2 3 1]) - "Coordinates are [2,3] <1>\n" - - (cl-format nil "Coordinates are~{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [ ]) - "Coordinates are none\n" -) - - -(simple-tests curly-brace-colon-tests - ;; Iteration from list of sublists - (cl-format nil "Coordinates are~:{ [~D,~D]~}~%" [ [0, 1], [1, 0], [3, 5], [2, 1] ]) - "Coordinates are [0,1] [1,0] [3,5] [2,1]\n" - - (cl-format nil "Coordinates are~:{ [~D,~D]~}~%" [ [0, 1, 0], [1, 0, 12], [3, 5], [2, 1] ]) - "Coordinates are [0,1] [1,0] [3,5] [2,1]\n" - - (cl-format nil "Coordinates are~2:{ [~D,~D]~}~%" [ [0, 1], [1, 0], [3, 5], [2, 1] ]) - "Coordinates are [0,1] [1,0]\n" - - (cl-format nil "Coordinates are~:{ ~#[none~;<~D>~:;[~D,~D]~]~}~%" [ ]) - "Coordinates are\n" - - (cl-format nil "Coordinates are~:{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [ ]) - "Coordinates are none\n" - - (cl-format nil "Coordinates are~:{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [[2 3] [1]]) - "Coordinates are [2,3] <1>\n" - - (cl-format nil "Coordinates are~:{~:}~%" "" []) - "Coordinates are\n" - - (cl-format nil "Coordinates are~:{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [[2 3] [1]]) - "Coordinates are [2,3] <1>\n" - - (cl-format nil "Coordinates are~:{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [ ]) - "Coordinates are none\n" -) - -(simple-tests curly-brace-at-tests - ;; Iteration from main list - (cl-format nil "Coordinates are~@{ [~D,~D]~}~%" 0, 1, 1, 0, 3, 5, 2, 1) - "Coordinates are [0,1] [1,0] [3,5] [2,1]\n" - - (cl-format nil "Coordinates are~2@{ [~D,~D]~}~%" 0, 1, 1, 0, 3, 5, 2, 1) - "Coordinates are [0,1] [1,0]\n" - - (cl-format nil "Coordinates are~@{ ~#[none~;<~D>~:;[~D,~D]~]~}~%") - "Coordinates are\n" - - (cl-format nil "Coordinates are~@{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%") - "Coordinates are none\n" - - (cl-format nil "Coordinates are~@{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" 2 3 1) - "Coordinates are [2,3] <1>\n" - - (cl-format nil "Coordinates are~@{~:}~%" "") - "Coordinates are\n" - - (cl-format nil "Coordinates are~@{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" 2 3 1) - "Coordinates are [2,3] <1>\n" - - (cl-format nil "Coordinates are~@{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]") - "Coordinates are none\n" -) - -(simple-tests curly-brace-colon-at-tests - ;; Iteration from sublists on the main arg list - (cl-format nil "Coordinates are~@:{ [~D,~D]~}~%" [0, 1], [1, 0], [3, 5], [2, 1] ) - "Coordinates are [0,1] [1,0] [3,5] [2,1]\n" - - (cl-format nil "Coordinates are~@:{ [~D,~D]~}~%" [0, 1, 0], [1, 0, 12], [3, 5], [2, 1] ) - "Coordinates are [0,1] [1,0] [3,5] [2,1]\n" - - (cl-format nil "Coordinates are~2@:{ [~D,~D]~}~%" [0, 1], [1, 0], [3, 5], [2, 1]) - "Coordinates are [0,1] [1,0]\n" - - (cl-format nil "Coordinates are~@:{ ~#[none~;<~D>~:;[~D,~D]~]~}~%") - "Coordinates are\n" - - (cl-format nil "Coordinates are~@:{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%") - "Coordinates are none\n" - - (cl-format nil "Coordinates are~@:{ ~#[none~;<~D>~:;[~D,~D]~]~:}~%" [2 3] [1]) - "Coordinates are [2,3] <1>\n" - - (cl-format nil "Coordinates are~@:{~:}~%" "") - "Coordinates are\n" - - (cl-format nil "Coordinates are~@:{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]" [2 3] [1]) - "Coordinates are [2,3] <1>\n" - - (cl-format nil "Coordinates are~@:{~:}~%" " ~#[none~;<~D>~:;[~D,~D]~]") - "Coordinates are none\n" -) - -;; TODO tests for ~^ in ~[ constructs and other brackets -;; TODO test ~:^ generates an error when used improperly -;; TODO test ~:^ works in ~@:{...~} -(let [aseq '(a quick brown fox jumped over the lazy dog) - lseq (mapcat identity (for [x aseq] [x (.length (name x))]))] - (simple-tests up-tests - (cl-format nil "~{~a~^, ~}" aseq) "a, quick, brown, fox, jumped, over, the, lazy, dog" - (cl-format nil "~{~a~0^, ~}" aseq) "a" - (cl-format nil "~{~a~#,3^, ~}" aseq) "a, quick, brown, fox, jumped, over" - (cl-format nil "~{~a~v,3^, ~}" lseq) "a, quick, brown, fox" - (cl-format nil "~{~a~3,v,4^, ~}" lseq) "a, quick, brown, fox" -)) - -(simple-tests angle-bracket-tests - (cl-format nil "~<foo~;bar~;baz~>") "foobarbaz" - (cl-format nil "~20<foo~;bar~;baz~>") "foo bar baz" - (cl-format nil "~,,2<foo~;bar~;baz~>") "foo bar baz" - (cl-format nil "~20<~A~;~A~;~A~>" "foo" "bar" "baz") "foo bar baz" - (cl-format nil "~20:<~A~;~A~;~A~>" "foo" "bar" "baz") " foo bar baz" - (cl-format nil "~20@<~A~;~A~;~A~>" "foo" "bar" "baz") "foo bar baz " - (cl-format nil "~20@:<~A~;~A~;~A~>" "foo" "bar" "baz") " foo bar baz " - (cl-format nil "~10,,2<~A~;~A~;~A~>" "foo" "bar" "baz") "foo bar baz" - (cl-format nil "~10,10,2<~A~;~A~;~A~>" "foo" "bar" "baz") "foo bar baz" - (cl-format nil "~10,10<~A~;~A~;~A~>" "foo" "bar" "baz") "foo barbaz" - (cl-format nil "~20<~A~;~^~A~;~^~A~>" "foo" "bar" "baz") "foo bar baz" - (cl-format nil "~20<~A~;~^~A~;~^~A~>" "foo" "bar") "foo bar" - (cl-format nil "~20@<~A~;~^~A~;~^~A~>" "foo") "foo " - (cl-format nil "~20:<~A~;~^~A~;~^~A~>" "foo") " foo" -) - -(simple-tests angle-bracket-max-column-tests - (cl-format nil "~%;; ~{~<~%;; ~1,50:; ~A~>~}.~%" (into [] (.split "This function computes the circular thermodynamic coefficient of the thrombulator angle for use in determining the reaction distance" "\\s"))) - "\n;; This function computes the circular\n;; thermodynamic coefficient of the thrombulator\n;; angle for use in determining the reaction\n;; distance.\n" -(cl-format true "~%;; ~{~<~%;; ~:; ~A~>~}.~%" (into [] (.split "This function computes the circular thermodynamic coefficient of the thrombulator angle for use in determining the reaction distance." "\\s")))) - -(defn list-to-table [aseq column-width] - (let [stream (pretty-writer (java.io.StringWriter.))] - (binding [*out* stream] - (doseq [row aseq] - (doseq [col row] - (cl-format true "~4D~7,vT" col column-width)) - (prn))) - (.flush stream) - (.toString (.getWriter stream)))) - -(simple-tests column-writer-test - (list-to-table (map #(vector % (* % %) (* % % %)) (range 1 21)) 8) - " 1 1 1 \n 2 4 8 \n 3 9 27 \n 4 16 64 \n 5 25 125 \n 6 36 216 \n 7 49 343 \n 8 64 512 \n 9 81 729 \n 10 100 1000 \n 11 121 1331 \n 12 144 1728 \n 13 169 2197 \n 14 196 2744 \n 15 225 3375 \n 16 256 4096 \n 17 289 4913 \n 18 324 5832 \n 19 361 6859 \n 20 400 8000 \n") -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; The following tests are the various examples from the format -;; documentation in Common Lisp, the Language, 2nd edition, Chapter 22.3 -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(defn expt [base pow] (reduce * (repeat pow base))) - -(let [x 5, y "elephant", n 3] - (simple-tests cltl-intro-tests - (format nil "foo") "foo" - (format nil "The answer is ~D." x) "The answer is 5." - (format nil "The answer is ~3D." x) "The answer is 5." - (format nil "The answer is ~3,'0D." x) "The answer is 005." - (format nil "The answer is ~:D." (expt 47 x)) "The answer is 229,345,007." - (format nil "Look at the ~A!" y) "Look at the elephant!" - (format nil "Type ~:C to ~A." (char 4) "delete all your files") - "Type Control-D to delete all your files." - (format nil "~D item~:P found." n) "3 items found." - (format nil "~R dog~:[s are~; is~] here." n (= n 1)) "three dogs are here." - (format nil "~R dog~:*~[s are~; is~:;s are~] here." n) "three dogs are here." - (format nil "Here ~[are~;is~:;are~] ~:*~R pupp~:@P." n) "Here are three puppies.")) - -(simple-tests cltl-B-tests - ;; CLtL didn't have the colons here, but the spec requires them - (format nil "~,,' ,4:B" 0xFACE) "1111 1010 1100 1110" - (format nil "~,,' ,4:B" 0x1CE) "1 1100 1110" - (format nil "~19,,' ,4:B" 0xFACE) "1111 1010 1100 1110" - ;; This one was a nice idea, but nothing in the spec supports it working this way - ;; (and SBCL doesn't work this way either) - ;(format nil "~19,,' ,4:B" 0x1CE) "0000 0001 1100 1110") - ) - -(simple-tests cltl-P-tests - (format nil "~D tr~:@P/~D win~:P" 7 1) "7 tries/1 win" - (format nil "~D tr~:@P/~D win~:P" 1 0) "1 try/0 wins" - (format nil "~D tr~:@P/~D win~:P" 1 3) "1 try/3 wins") - -(defn foo [x] - (format nil "~6,2F|~6,2,1,'*F|~6,2,,'?F|~6F|~,2F|~F" - x x x x x x)) - -(simple-tests cltl-F-tests - (foo 3.14159) " 3.14| 31.42| 3.14|3.1416|3.14|3.14159" - (foo -3.14159) " -3.14|-31.42| -3.14|-3.142|-3.14|-3.14159" - (foo 100.0) "100.00|******|100.00| 100.0|100.00|100.0" - (foo 1234.0) "1234.00|******|??????|1234.0|1234.00|1234.0" - (foo 0.006) " 0.01| 0.06| 0.01| 0.006|0.01|0.006") - -(defn foo-e [x] - (format nil - "~9,2,1,,'*E|~10,3,2,2,'?,,'$E|~9,3,2,-2,'%@E|~9,2E" - x x x x)) - -;; Clojure doesn't support float/double differences in representation -(simple-tests cltl-E-tests - (foo-e 0.0314159) " 3.14E-2| 31.42$-03|+.003E+01| 3.14E-2" ; Added this one - (foo-e 3.14159) " 3.14E+0| 31.42$-01|+.003E+03| 3.14E+0" - (foo-e -3.14159) " -3.14E+0|-31.42$-01|-.003E+03| -3.14E+0" - (foo-e 1100.0) " 1.10E+3| 11.00$+02|+.001E+06| 1.10E+3" -; In Clojure, this is identical to the above -; (foo-e 1100.0L0) " 1.10L+3| 11.00$+02|+.001L+06| 1.10L+3" - (foo-e 1.1E13) "*********| 11.00$+12|+.001E+16| 1.10E+13" - (foo-e 1.1E120) "*********|??????????|%%%%%%%%%|1.10E+120" -; Clojure doesn't support real numbers this large -; (foo-e 1.1L1200) "*********|??????????|%%%%%%%%%|1.10L+1200" -) - -(simple-tests cltl-E-scale-tests - (map - (fn [k] (format nil "Scale factor ~2D~:*: |~13,6,2,VE|" - (- k 5) 3.14159)) ;Prints 13 lines - (range 13)) - '("Scale factor -5: | 0.000003E+06|" - "Scale factor -4: | 0.000031E+05|" - "Scale factor -3: | 0.000314E+04|" - "Scale factor -2: | 0.003142E+03|" - "Scale factor -1: | 0.031416E+02|" - "Scale factor 0: | 0.314159E+01|" - "Scale factor 1: | 3.141590E+00|" - "Scale factor 2: | 31.41590E-01|" - "Scale factor 3: | 314.1590E-02|" - "Scale factor 4: | 3141.590E-03|" - "Scale factor 5: | 31415.90E-04|" - "Scale factor 6: | 314159.0E-05|" - "Scale factor 7: | 3141590.E-06|")) - -(defn foo-g [x] - (format nil - "~9,2,1,,'*G|~9,3,2,3,'?,,'$G|~9,3,2,0,'%G|~9,2G" - x x x x)) - -;; Clojure doesn't support float/double differences in representation -(simple-tests cltl-G-tests - (foo-g 0.0314159) " 3.14E-2|314.2$-04|0.314E-01| 3.14E-2" - (foo-g 0.314159) " 0.31 |0.314 |0.314 | 0.31 " - (foo-g 3.14159) " 3.1 | 3.14 | 3.14 | 3.1 " - (foo-g 31.4159) " 31. | 31.4 | 31.4 | 31. " - (foo-g 314.159) " 3.14E+2| 314. | 314. | 3.14E+2" - (foo-g 3141.59) " 3.14E+3|314.2$+01|0.314E+04| 3.14E+3" -; In Clojure, this is identical to the above -; (foo-g 3141.59L0) " 3.14L+3|314.2$+01|0.314L+04| 3.14L+3" - (foo-g 3.14E12) "*********|314.0$+10|0.314E+13| 3.14E+12" - (foo-g 3.14E120) "*********|?????????|%%%%%%%%%|3.14E+120" -; Clojure doesn't support real numbers this large -; (foo-g 3.14L1200) "*********|?????????|%%%%%%%%%|3.14L+1200" -) - -(defn type-clash-error [fun nargs argnum right-type wrong-type] - (format nil ;; CLtL has this format string slightly wrong - "~&Function ~S requires its ~:[~:R ~;~*~]~ - argument to be of type ~S,~%but it was called ~ - with an argument of type ~S.~%" - fun (= nargs 1) argnum right-type wrong-type)) - -(simple-tests cltl-Newline-tests - (type-clash-error 'aref nil 2 'integer 'vector) -"Function aref requires its second argument to be of type integer, -but it was called with an argument of type vector.\n" - (type-clash-error 'car 1 1 'list 'short-float) -"Function car requires its argument to be of type list, -but it was called with an argument of type short-float.\n") - -(simple-tests cltl-?-tests - (format nil "~? ~D" "<~A ~D>" '("Foo" 5) 7) "<Foo 5> 7" - (format nil "~? ~D" "<~A ~D>" '("Foo" 5 14) 7) "<Foo 5> 7" - (format nil "~@? ~D" "<~A ~D>" "Foo" 5 7) "<Foo 5> 7" - (format nil "~@? ~D" "<~A ~D>" "Foo" 5 14 7) "<Foo 5> 14") - -(defn f [n] (format nil "~@(~R~) error~:P detected." n)) - -(simple-tests cltl-paren-tests - (format nil "~@R ~(~@R~)" 14 14) "XIV xiv" - (f 0) "Zero errors detected." - (f 1) "One error detected." - (f 23) "Twenty-three errors detected.") - -(let [*print-level* nil *print-length* 5] - (simple-tests cltl-bracket-tests - (format nil "~@[ print level = ~D~]~@[ print length = ~D~]" - *print-level* *print-length*) - " print length = 5")) - -(let [foo "Items:~#[ none~; ~S~; ~S and ~S~ - ~:;~@{~#[~; and~] ~ - ~S~^,~}~]."] - (simple-tests cltl-bracket1-tests - (format nil foo) "Items: none." - (format nil foo 'foo) "Items: foo." - (format nil foo 'foo 'bar) "Items: foo and bar." - (format nil foo 'foo 'bar 'baz) "Items: foo, bar, and baz." - (format nil foo 'foo 'bar 'baz 'quux) "Items: foo, bar, baz, and quux.")) - -(simple-tests cltl-curly-bracket-tests - (format nil - "The winners are:~{ ~S~}." - '(fred harry jill)) - "The winners are: fred harry jill." - - (format nil "Pairs:~{ <~S,~S>~}." '(a 1 b 2 c 3)) - "Pairs: <a,1> <b,2> <c,3>." - - (format nil "Pairs:~:{ <~S,~S>~}." '((a 1) (b 2) (c 3))) - "Pairs: <a,1> <b,2> <c,3>." - - (format nil "Pairs:~@{ <~S,~S>~}." 'a 1 'b 2 'c 3) - "Pairs: <a,1> <b,2> <c,3>." - - (format nil "Pairs:~:@{ <~S,~S>~}." '(a 1) '(b 2) '(c 3)) - "Pairs: <a,1> <b,2> <c,3>.") - -(simple-tests cltl-angle-bracket-tests - (format nil "~10<foo~;bar~>") "foo bar" - (format nil "~10:<foo~;bar~>") " foo bar" - (format nil "~10:@<foo~;bar~>") " foo bar " - (format nil "~10<foobar~>") " foobar" - (format nil "~10:<foobar~>") " foobar" - (format nil "~10@<foobar~>") "foobar " - (format nil "~10:@<foobar~>") " foobar ") - -(let [donestr "Done.~^ ~D warning~:P.~^ ~D error~:P." - tellstr "~@{~@(~@[~R~^ ~]~A~)~}."] ;; The CLtL example is a little wrong here - - (simple-tests cltl-up-tests - (format nil donestr) "Done." - (format nil donestr 3) "Done. 3 warnings." - (format nil donestr 1 5) "Done. 1 warning. 5 errors." - (format nil tellstr 23) "Twenty-three." - (format nil tellstr nil "losers") "Losers." - (format nil tellstr 23 "losers") "Twenty-three losers." - (format nil "~15<~S~;~^~S~;~^~S~>" 'foo) - " foo" - (format nil "~15<~S~;~^~S~;~^~S~>" 'foo 'bar) - "foo bar" - (format nil "~15<~S~;~^~S~;~^~S~>" 'foo 'bar 'baz) - "foo bar baz")) - -(simple-tests cltl-up-x3j13-tests - (format nil - "~:{/~S~^ ...~}" - '((hot dog) (hamburger) (ice cream) (french fries))) - "/hot .../hamburger/ice .../french ..." - (format nil - "~:{/~S~:^ ...~}" - '((hot dog) (hamburger) (ice cream) (french fries))) - "/hot .../hamburger .../ice .../french" - - (format nil - "~:{/~S~#:^ ...~}" ;; This is wrong in CLtL - '((hot dog) (hamburger) (ice cream) (french fries))) - "/hot .../hamburger") - diff --git a/src/clojure/contrib/test_contrib/pprint/helper.clj b/src/clojure/contrib/test_contrib/pprint/helper.clj deleted file mode 100644 index bf25ca61..00000000 --- a/src/clojure/contrib/test_contrib/pprint/helper.clj +++ /dev/null @@ -1,21 +0,0 @@ -;;; helper.clj -- part of the pretty printer for Clojure - -;; by Tom Faulhaber -;; April 3, 2009 - -; Copyright (c) Tom Faulhaber, April 2009. 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. - -;; This is just a macro to make my tests a little cleaner - -(ns clojure.contrib.test-contrib.pprint.helper - (:use [clojure.test :only (deftest are run-tests)])) - -(defmacro simple-tests [name & test-pairs] - `(deftest ~name (are [x y] (= x y) ~@test-pairs))) - diff --git a/src/clojure/contrib/test_contrib/pprint/pretty.clj b/src/clojure/contrib/test_contrib/pprint/pretty.clj deleted file mode 100644 index 01e7c87e..00000000 --- a/src/clojure/contrib/test_contrib/pprint/pretty.clj +++ /dev/null @@ -1,127 +0,0 @@ -;;; pretty.clj -- part of the pretty printer for Clojure - -;; by Tom Faulhaber -;; April 3, 2009 - -; Copyright (c) Tom Faulhaber, Feb 2009. 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. - -(ns clojure.contrib.test-contrib.pprint.pretty - (:use [clojure.test :only (deftest are run-tests)] - clojure.contrib.test-contrib.pprint.helper - clojure.contrib.pprint)) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; -;;; Unit tests for the pretty printer -;;; -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - -(simple-tests xp-fill-test - (binding [*print-pprint-dispatch* *simple-dispatch* - *print-right-margin* 38 - *print-miser-width* nil] - (cl-format nil "(let ~:<~@{~:<~w ~_~w~:>~^ ~:_~}~:>~_ ...)~%" - '((x 4) (*print-length* nil) (z 2) (list nil)))) - "(let ((x 4) (*print-length* nil)\n (z 2) (list nil))\n ...)\n" - - (binding [*print-pprint-dispatch* *simple-dispatch* - *print-right-margin* 22] - (cl-format nil "(let ~:<~@{~:<~w ~_~w~:>~^ ~:_~}~:>~_ ...)~%" - '((x 4) (*print-length* nil) (z 2) (list nil)))) - "(let ((x 4)\n (*print-length*\n nil)\n (z 2)\n (list nil))\n ...)\n") - -(simple-tests xp-miser-test - (binding [*print-pprint-dispatch* *simple-dispatch* - *print-right-margin* 10, *print-miser-width* 9] - (cl-format nil "~:<LIST ~@_~W ~@_~W ~@_~W~:>" '(first second third))) - "(LIST\n first\n second\n third)" - - (binding [*print-pprint-dispatch* *simple-dispatch* - *print-right-margin* 10, *print-miser-width* 8] - (cl-format nil "~:<LIST ~@_~W ~@_~W ~@_~W~:>" '(first second third))) - "(LIST first second third)") - -(simple-tests mandatory-fill-test - (cl-format nil - "<pre>~%~<Usage: ~:I~@{*~a*~^~:@_~}~:>~%</pre>~%" - [ "hello" "gooodbye" ]) - "<pre> -Usage: *hello* - *gooodbye* -</pre> -") - -(simple-tests prefix-suffix-test - (binding [*print-pprint-dispatch* *simple-dispatch* - *print-right-margin* 10, *print-miser-width* 10] - (cl-format nil "~<{~;LIST ~@_~W ~@_~W ~@_~W~;}~:>" '(first second third))) - "{LIST\n first\n second\n third}") - -(simple-tests pprint-test - (binding [*print-pprint-dispatch* *simple-dispatch*] - (write '(defn foo [x y] - (let [result (* x y)] - (if (> result 400) - (cl-format true "That number is too big") - (cl-format true "The result of ~d x ~d is ~d" x y result)))) - :stream nil)) - "(defn - foo - [x y] - (let - [result (* x y)] - (if - (> result 400) - (cl-format true \"That number is too big\") - (cl-format true \"The result of ~d x ~d is ~d\" x y result))))" - - (with-pprint-dispatch *code-dispatch* - (write '(defn foo [x y] - (let [result (* x y)] - (if (> result 400) - (cl-format true "That number is too big") - (cl-format true "The result of ~d x ~d is ~d" x y result)))) - :stream nil)) - "(defn foo [x y] - (let [result (* x y)] - (if (> result 400) - (cl-format true \"That number is too big\") - (cl-format true \"The result of ~d x ~d is ~d\" x y result))))" - - (binding [*print-pprint-dispatch* *simple-dispatch* - *print-right-margin* 15] - (write '(fn (cons (car x) (cdr y))) :stream nil)) - "(fn\n (cons\n (car x)\n (cdr y)))" - - (with-pprint-dispatch *code-dispatch* - (binding [*print-right-margin* 52] - (write - '(add-to-buffer this (make-buffer-blob (str (char c)) nil)) - :stream nil))) - "(add-to-buffer\n this\n (make-buffer-blob (str (char c)) nil))" - ) - - - -(simple-tests pprint-reader-macro-test - (with-pprint-dispatch *code-dispatch* - (write (read-string "(map #(first %) [[1 2 3] [4 5 6] [7]])") - :stream nil)) - "(map #(first %) [[1 2 3] [4 5 6] [7]])" - - (with-pprint-dispatch *code-dispatch* - (write (read-string "@@(ref (ref 1))") - :stream nil)) - "@@(ref (ref 1))" - - (with-pprint-dispatch *code-dispatch* - (write (read-string "'foo") - :stream nil)) - "'foo" -) diff --git a/src/clojure/contrib/test_contrib/seq_utils_test.clj b/src/clojure/contrib/test_contrib/seq_utils_test.clj deleted file mode 100644 index 0958fc65..00000000 --- a/src/clojure/contrib/test_contrib/seq_utils_test.clj +++ /dev/null @@ -1,127 +0,0 @@ -(ns clojure.contrib.test-contrib.seq-utils-test - (:use clojure.test - clojure.contrib.seq-utils)) - - -(deftest test-positions - (are [expected pred coll] (= expected (positions pred coll)) - [2] string? [:a :b "c"] - () :d [:a :b :c] - [0 2] #{:d} [:d :a :d :a])) - -;Upon further inspection, flatten behaves... wierd. -;These tests are what passes on August 7, 2009 -(deftest test-flatten-present - (are [expected nested-val] (= (flatten nested-val) expected) - ;simple literals - [] nil - [] 1 - [] 'test - [] :keyword - [] 1/2 - [] #"[\r\n]" - [] true - [] false - ;vectors - [1 2 3 4 5] [[1 2] [3 4 [5]]] - [1 2 3 4 5] [1 2 3 4 5] - [#{1 2} 3 4 5] [#{1 2} 3 4 5] - ;sets - [] #{} - [] #{#{1 2} 3 4 5} - [] #{1 2 3 4 5} - [] #{#{1 2} 3 4 5} - ;lists - [] '() - [1 2 3 4 5] `(1 2 3 4 5) - ;maps - [] {:a 1 :b 2} - [:a 1 :b 2] (seq {:a 1 :b 2}) - [] {[:a :b] 1 :c 2} - [:a :b 1 :c 2] (seq {[:a :b] 1 :c 2}) - [:a 1 2 :b 3] (seq {:a [1 2] :b 3}) - ;Strings - [] "12345" - [\1 \2 \3 \4 \5] (seq "12345") - ;fns - [] count - [count even? odd?] [count even? odd?])) - -(deftest test-separate - (are [test-seq] (= (separate even? test-seq) [[2 4] [1 3 5]]) - [1 2 3 4 5] - #{1 2 3 4 5} - '(1 2 3 4 5))) - -(deftest test-includes? - (is (includes? [1 2 3 4 5] 5)) - (is (not (includes? [1 2 3 4 5] 6)))) - -;Note - this does not make sense for maps and sets, because order is expected -(deftest test-indexed - (are [expected test-seq] (= (indexed test-seq) expected) - [[0 :a] [1 :b] [2 :c] [3 :d]] [:a :b :c :d] - [[0 :a] [1 :b] [2 :c] [3 :d]] '(:a :b :c :d) - [[0 \1] [1 \2] [2 \3] [3 \4]] "1234")) - -(deftest test-group-by - (is (= (group-by even? [1 2 3 4 5]) - {false [1 3 5], true [2 4]}))) - -;Note - this does not make sense for maps and sets, because order is expected -(deftest test-partition-by - (are [test-seq] (= (partition-by (comp even? count) test-seq) - [["a"] ["bb" "cccc" "dd"] ["eee" "f"] ["" "hh"]]) - ["a" "bb" "cccc" "dd" "eee" "f" "" "hh"] - '("a" "bb" "cccc" "dd" "eee" "f" "" "hh")) - (is (=(partition-by #{\a \e \i \o \u} "abcdefghijklm") - [[\a] [\b \c \d] [\e] [\f \g \h] [\i] [\j \k \l \m]]))) - -(deftest test-frequencies - (are [expected test-seq] (= (frequencies test-seq) expected) - {\p 2, \s 4, \i 4, \m 1} "mississippi" - {1 4 2 2 3 1} [1 1 1 1 2 2 3] - {1 4 2 2 3 1} '(1 1 1 1 2 2 3))) - -;Note - this does not make sense for maps and sets, because order is expected -;This is a key differnce between reductions and reduce. -(deftest test-reductions - (is (= (reductions + [1 2 3 4 5]) - [1 3 6 10 15])) - (is (= (reductions + 10 [1 2 3 4 5]) - [10 11 13 16 20 25]))) - -;Note - this does not make sense for maps and sets, because order is expected -(deftest test-rotations - (is (= (rotations [1 2 3 4]) - [[1 2 3 4] - [2 3 4 1] - [3 4 1 2] - [4 1 2 3]]))) - -;Note - this does not make sense for maps and sets, because order is expected -(deftest test-partition-all - (is (= (partition-all 4 [1 2 3 4 5 6 7 8 9]) - [[1 2 3 4] [5 6 7 8] [9]])) - (is (= (partition-all 4 2 [1 2 3 4 5 6 7 8 9]) - [[1 2 3 4] [3 4 5 6] [5 6 7 8] [7 8 9] [9]]))) - -;Thanks to Andy Fingerhut for the idea of testing invariants -(deftest test-shuffle-invariants - (is (= (count (shuffle [1 2 3 4])) 4)) - (let [shuffled-seq (shuffle [1 2 3 4])] - (is (every? #{1 2 3 4} shuffled-seq)))) - -(deftest test-shuffle-distributions - (let [a-statistician-needed-to-do-this? true] - (is a-statistician-needed-to-do-this?))) - -;Thanks to Andy Fingerhut for the idea of testing invariants -(deftest test-rand-elt-invariants - (let [elt (rand-elt [:a :b :c :d])] - (is (#{:a :b :c :d} elt)))) - -;Note - this does not make sense for maps and sets, because order is expected -(deftest test-find-first - (is (= (find-first even? [1 2 3 4 5]) 2)) - (is (= (find-first even? '(1 2 3 4 5)) 2))) diff --git a/src/clojure/contrib/test_contrib/shell_out.clj b/src/clojure/contrib/test_contrib/shell_out.clj deleted file mode 100644 index c5447099..00000000 --- a/src/clojure/contrib/test_contrib/shell_out.clj +++ /dev/null @@ -1,41 +0,0 @@ -(ns clojure.contrib.test-contrib.shell-out - (:use clojure.test - clojure.contrib.shell-out) - (:import (java.io File))) - -; workaroung to access private parse-args. Better way? -(def parse-args ((ns-interns 'clojure.contrib.shell-out) 'parse-args)) -(def as-file ((ns-interns 'clojure.contrib.shell-out) 'as-file)) -(def as-env-string ((ns-interns 'clojure.contrib.shell-out) 'as-env-string)) - -(deftest test-parse-args - (are [x y] (= x y) - {:cmd [nil] :out "UTF-8" :dir nil :env nil} (parse-args []) - {:cmd ["ls"] :out "UTF-8" :dir nil :env nil} (parse-args ["ls"]) - {:cmd ["ls" "-l"] :out "UTF-8" :dir nil :env nil} (parse-args ["ls" "-l"]) - {:cmd ["ls"] :out "ISO-8859-1" :dir nil :env nil} (parse-args ["ls" :out "ISO-8859-1"]) -)) - -(deftest test-with-sh-dir - (are [x y] (= x y) - nil *sh-dir* - "foo" (with-sh-dir "foo" *sh-dir*))) - -(deftest test-with-sh-env - (are [x y] (= x y) - nil *sh-env* - {:KEY "VAL"} (with-sh-env {:KEY "VAL"} *sh-env*))) - -(deftest test-as-env-string - (are [x y] (= x y) - nil (as-env-string nil) - ["FOO=BAR"] (seq (as-env-string {"FOO" "BAR"})) - ["FOO_SYMBOL=BAR"] (seq (as-env-string {'FOO_SYMBOL "BAR"})) - ["FOO_KEYWORD=BAR"] (seq (as-env-string {:FOO_KEYWORD "BAR"})))) - - -(deftest test-as-file - (are [x y] (= x y) - (File. "foo") (as-file "foo") - nil (as-file nil) - (File. "bar") (as-file (File. "bar"))))
\ No newline at end of file diff --git a/src/clojure/contrib/test_contrib/str_utils.clj b/src/clojure/contrib/test_contrib/str_utils.clj deleted file mode 100644 index 815525bb..00000000 --- a/src/clojure/contrib/test_contrib/str_utils.clj +++ /dev/null @@ -1,33 +0,0 @@ -(ns clojure.contrib.test-contrib.str-utils - (:use clojure.test - clojure.contrib.str-utils)) - - -(deftest test-re-gsub - (let [re #"\%([0-9a-fA-F]{2})" - replacement (fn [match] - (char (Integer/parseInt - (match 1) 16)))] - (is (= (re-gsub re replacement "") "")) - (is (= (re-gsub re replacement "%20") " ")) - (is (= (re-gsub re replacement "x%20") "x ")) - (is (= (re-gsub re replacement "x%20%0a") "x \n")) - (is (= (re-gsub re replacement "x%20y") "x y")) - (is (= (re-gsub re "?" "") "")) - (is (= (re-gsub re "?" "%21") "?")) - (is (= (re-gsub re "?" "x%22") "x?")) - (is (= (re-gsub re "?" "x%23y") "x?y")))) - -(deftest test-re-sub - (let [re #"\%([0-9a-fA-F]{2})" - replacement (fn [match] - (char (Integer/parseInt - (match 1) 16)))] - (is (= (re-sub re replacement "") "")) - (is (= (re-sub re replacement "%20") " ")) - (is (= (re-sub re replacement "x%20%20") "x %20")) - (is (= (re-sub re replacement "x%20y") "x y")) - (is (= (re-sub re "?" "") "")) - (is (= (re-sub re "?" "%21") "?")) - (is (= (re-sub re "?" "x%22%25") "x?%25")) - (is (= (re-gsub re "?" "x%23y") "x?y")))) diff --git a/src/clojure/contrib/test_contrib/str_utils2.clj b/src/clojure/contrib/test_contrib/str_utils2.clj deleted file mode 100644 index ee6aa68e..00000000 --- a/src/clojure/contrib/test_contrib/str_utils2.clj +++ /dev/null @@ -1,119 +0,0 @@ -(ns clojure.contrib.test-contrib.str-utils2 - (:require [clojure.contrib.str-utils2 :as s]) - (:use clojure.test)) - -(deftest t-codepoints - (is (= (list 102 111 111 65536 98 97 114) - (s/codepoints "foo\uD800\uDC00bar")) - "Handles Unicode supplementary characters")) - -(deftest t-escape - (is (= "<foo&bar>" - (s/escape "<foo&bar>" {\& "&" \< "<" \> ">"}))) - (is (= " \\\"foo\\\" " - (s/escape " \"foo\" " {\" "\\\""}))) - (is (= "faabor" (s/escape "foobar" {\a \o, \o \a})))) - -(deftest t-blank - (is (s/blank? nil)) - (is (s/blank? "")) - (is (s/blank? " ")) - (is (s/blank? " \t \n \r ")) - (is (not (s/blank? " foo ")))) - -(deftest t-take - (is (= "foo" (s/take "foobar" 3))) - (is (= "foobar" (s/take "foobar" 7))) - (is (= "" (s/take "foo" 0)))) - -(deftest t-drop - (is (= "bar" (s/drop "foobar" 3))) - (is (= "" (s/drop "foobar" 9))) - (is (= "foobar" (s/drop "foobar" 0)))) - -(deftest t-butlast - (is (= "foob" (s/butlast "foobar" 2))) - (is (= "" (s/butlast "foobar" 9))) - (is (= "foobar" (s/butlast "foobar" 0)))) - -(deftest t-tail - (is (= "ar" (s/tail "foobar" 2))) - (is (= "foobar" (s/tail "foobar" 9))) - (is (= "" (s/tail "foobar" 0)))) - -(deftest t-repeat - (is (= "foofoofoo" (s/repeat "foo" 3)))) - -(deftest t-reverse - (is (= "tab" (s/reverse "bat")))) - -(deftest t-replace - (is (= "faabar" (s/replace "foobar" \o \a))) - (is (= "barbarbar" (s/replace "foobarfoo" "foo" "bar"))) - (is (= "FOObarFOO" (s/replace "foobarfoo" #"foo" s/upper-case)))) - -(deftest t-replace-first - (is (= "barbarfoo" (s/replace-first "foobarfoo" #"foo" "bar"))) - (is (= "FOObarfoo" (s/replace-first "foobarfoo" #"foo" s/upper-case)))) - -(deftest t-partition - (is (= (list "" "abc" "123" "def") - (s/partition "abc123def" #"[a-z]+")))) - -(deftest t-join - (is (= "1,2,3" (s/join \, [1 2 3]))) - (is (= "" (s/join \, []))) - (is (= "1 and-a 2 and-a 3" (s/join " and-a " [1 2 3])))) - -(deftest t-chop - (is (= "fo" (s/chop "foo"))) - (is (= "") (s/chop "f")) - (is (= "") (s/chop ""))) - -(deftest t-chomp - (is (= "foo" (s/chomp "foo\n"))) - (is (= "foo" (s/chomp "foo\r\n"))) - (is (= "foo" (s/chomp "foo"))) - (is (= "" (s/chomp "")))) - -(deftest t-swap-case - (is (= "fOO!bAR" (s/swap-case "Foo!Bar"))) - (is (= "" (s/swap-case "")))) - -(deftest t-capitalize - (is (= "Foobar" (s/capitalize "foobar"))) - (is (= "Foobar" (s/capitalize "FOOBAR")))) - -(deftest t-ltrim - (is (= "foo " (s/ltrim " foo "))) - (is (= "" (s/ltrim " ")))) - -(deftest t-rtrim - (is (= " foo" (s/rtrim " foo "))) - (is (= "" (s/rtrim " ")))) - -(deftest t-split-lines - (is (= (list "one" "two" "three") - (s/split-lines "one\ntwo\r\nthree"))) - (is (= (list "foo") (s/split-lines "foo")))) - -(deftest t-upper-case - (is (= "FOOBAR" (s/upper-case "Foobar")))) - -(deftest t-lower-case - (is (= "foobar" (s/lower-case "FooBar")))) - -(deftest t-trim - (is (= "foo" (s/trim " foo \r\n")))) - -(deftest t-contains - (is (s/contains? "foobar" "foo")) - (is (not (s/contains? "foobar" "baz")))) - -(deftest t-get - (is (= \o (s/get "foo" 1)))) - -(deftest t-partial - (is (= "bar" ((s/partial s/drop 3) "foobar"))) - (is (= "ooba" ((comp (s/partial s/take 4) - (s/partial s/drop 1)) "foobar")))) diff --git a/src/clojure/contrib/test_contrib/test_dataflow.clj b/src/clojure/contrib/test_contrib/test_dataflow.clj deleted file mode 100644 index 8b934dc3..00000000 --- a/src/clojure/contrib/test_contrib/test_dataflow.clj +++ /dev/null @@ -1,90 +0,0 @@ -;; Copyright (c) Jeffrey Straszheim. 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. -;; -;; test-dataflow -;; -;; A Library to Support a Dataflow Model of State - Tests -;; -;; straszheimjeffrey (gmail) -;; Created 11 March 2009 - - -(ns clojure.contrib.test-contrib.test-dataflow - (:use clojure.test) - (:use clojure.contrib.dataflow)) - -(def df-1 - (build-dataflow - [(cell :source base 0) - (cell :source items ()) - (cell product (* ?base (apply + ?items))) - (cell :validator (when (number? ?-product) - (assert (>= ?product ?-product))))])) - -(deftest test-df-1 - (is (= (get-value df-1 'product) 0)) - (is (do (update-values df-1 {'items [4 5]}) - (= (get-value df-1 'product) 0))) - (is (do (update-values df-1 {'base 2}) - (= (get-value df-1 'product) 18))) - (is (thrown? AssertionError (update-values df-1 {'base 0}))) - (is (= (get-value df-1 'product) 18))) - -(def df-2 - (build-dataflow - [(cell :source strength 10) - (cell :source agility 10) - (cell :source magic 10) - - (cell total-cost (apply + ?*cost)) - - (cell cost (- ?strength 10)) - (cell cost (- ?agility 10)) - (cell cost (- ?magic 10)) - - (cell combat (+ ?strength ?agility ?combat-mod)) - (cell speed (+ ?agility (/ ?strength 10.0) ?speed-mod)) - (cell casting (+ ?agility ?magic ?magic-mod)) - - (cell combat-mod (apply + ?*combat-mods)) - (cell speed-mod (apply + ?*speed-mods)) - (cell magic-mod (apply + ?*magic-mods))])) - -(def magic-skill - [(cell cost 5) - (cell speed-mods 1) - (cell magic-mods 2)]) - -(defn gv [n] (get-value df-2 n)) - -(deftest test-df-2 - (is (and (= (gv 'total-cost) 0) - (= (gv 'strength) 10) - (= (gv 'casting) 20))) - (is (do (update-values df-2 {'magic 12}) - (and (= (gv 'total-cost) 2) - (= (gv 'casting) 22)))) - (is (do (add-cells df-2 magic-skill) - (and (= (gv 'total-cost) 7) - (= (gv 'casting) 24)))) - (is (do (remove-cells df-2 magic-skill) - (and (= (gv 'total-cost) 2) - (= (gv 'casting) 22))))) - - -(comment - (run-tests) - - (use :reload 'clojure.contrib.dataflow) - (use 'clojure.contrib.stacktrace) (e) - (use 'clojure.contrib.trace) - -) - - -;; End of file diff --git a/src/clojure/contrib/test_contrib/test_graph.clj b/src/clojure/contrib/test_contrib/test_graph.clj deleted file mode 100644 index ed03b9ae..00000000 --- a/src/clojure/contrib/test_contrib/test_graph.clj +++ /dev/null @@ -1,187 +0,0 @@ -;; Copyright (c) Jeffrey Straszheim. 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. -;; -;; test-graph -;; -;; Basic Graph Theory Algorithms Tests -;; -;; straszheimjeffrey (gmail) -;; Created 23 June 2009 - -(ns clojure.contrib.test-contrib.test-graph - (use clojure.test - clojure.contrib.graph)) - - -(def empty-graph (struct directed-graph #{} {})) - -(def test-graph-1 - (struct directed-graph - #{:a :b :c :d :e} - {:a #{:b :c} - :b #{:a :c} - :c #{:d :e} - :d #{:a :b} - :e #{:d}})) - -(deftest test-reverse-graph - (is (= (reverse-graph test-graph-1) - (struct directed-graph - #{:a :b :c :d :e} - {:c #{:b :a} - :e #{:c} - :d #{:c :e} - :b #{:d :a} - :a #{:d :b}}))) - (is (= (reverse-graph (reverse-graph test-graph-1)) - test-graph-1)) - (is (= (reverse-graph empty-graph) empty-graph))) - -(deftest test-add-loops - (let [tg1 (add-loops test-graph-1)] - (is (every? (fn [n] (contains? (get-neighbors tg1 n) n)) (:nodes tg1)))) - (is (= (add-loops empty-graph) empty-graph))) - -(deftest test-remove-loops - (let [tg1 (remove-loops (add-loops test-graph-1))] - (is (not-any? (fn [n] (contains? (get-neighbors tg1 n) n)) (:nodes tg1)))) - (is (= (remove-loops empty-graph) empty-graph))) - - -(def test-graph-2 - (struct directed-graph - #{:a :b :c :d :e :f :g :h :i :j} - {:a #{:b :c} - :b #{:a :c} - :c #{:d :e} - :d #{:a :b} - :e #{:d} - :f #{:f} - :g #{:a :f} - :h #{} - :i #{:j} - :j #{:i}})) - - -(deftest test-lazy-walk - (is (= (lazy-walk test-graph-2 :h) [:h])) - (is (= (lazy-walk test-graph-2 :j) [:j :i]))) - -(deftest test-transitive-closure - (let [tc-1 (transitive-closure test-graph-1) - tc-2 (transitive-closure test-graph-2) - get (fn [n] (set (get-neighbors tc-2 n)))] - (is (every? #(= #{:a :b :c :d :e} (set %)) - (map (partial get-neighbors tc-1) (:nodes tc-1)))) - (is (= (get :a) #{:a :b :c :d :e})) - (is (= (get :h) #{})) - (is (= (get :j) #{:i :j})) - (is (= (get :g) #{:a :b :c :d :e :f})))) - - -(deftest test-post-ordered-nodes - (is (= (set (post-ordered-nodes test-graph-2)) - #{:a :b :c :d :e :f :g :h :i :j})) - (is (empty? (post-ordered-nodes empty-graph)))) - - -(deftest test-scc - (is (= (set (scc test-graph-2)) - #{#{:h} #{:g} #{:i :j} #{:b :c :a :d :e} #{:f}})) - (is (empty? (scc empty-graph)))) - -(deftest test-component-graph - (let [cg (component-graph test-graph-2) - ecg (component-graph empty-graph)] - (is (= (:nodes cg) (set (scc test-graph-2)))) - (is (= (get-neighbors cg #{:a :b :c :d :e}) - #{#{:a :b :c :d :e}})) - (is (= (get-neighbors cg #{:g}) - #{#{:a :b :c :d :e} #{:f}})) - (is (= (get-neighbors cg #{:i :j}) - #{#{:i :j}})) - (is (= (get-neighbors cg #{:h}) - #{})) - (is (= (apply max (map count (self-recursive-sets cg))) 1)) - (is (= ecg empty-graph)))) - - -(deftest test-recursive-component? - (let [sccs (scc test-graph-2)] - (is (= (set (filter (partial recursive-component? test-graph-2) sccs)) - #{#{:i :j} #{:b :c :a :d :e} #{:f}})))) - - -(deftest test-self-recursive-sets - (is (= (set (self-recursive-sets test-graph-2)) - (set (filter - (partial recursive-component? test-graph-2) - (scc test-graph-2))))) - (is (empty? (self-recursive-sets empty-graph)))) - - -(def test-graph-3 - (struct directed-graph - #{:a :b :c :d :e :f} - {:a #{:b} - :b #{:c} - :c #{:d} - :d #{:e} - :e #{:f} - :f #{}})) - -(def test-graph-4 - (struct directed-graph - #{:a :b :c :d :e :f :g :h} - {:a #{} - :b #{:a} - :c #{:a} - :d #{:a :b} - :e #{:d :c} - :f #{:e} - :g #{:d} - :h #{:f}})) - -(def test-graph-5 - (struct directed-graph - #{:a :b :c :d :e :f :g :h} - {:a #{} - :b #{} - :c #{:b} - :d #{} - :e #{} - :f #{} - :g #{:f} - :h #{}})) - -(deftest test-dependency-list - (is (thrown-with-msg? Exception #".*Fixed point overflow.*" - (dependency-list test-graph-2))) - (is (= (dependency-list test-graph-3) - [#{:f} #{:e} #{:d} #{:c} #{:b} #{:a}])) - (is (= (dependency-list test-graph-4) - [#{:a} #{:b :c} #{:d} #{:g :e} #{:f} #{:h}])) - (is (= (dependency-list test-graph-5) - [#{:f :b :a :d :h :e} #{:g :c}])) - (is (= (dependency-list empty-graph) - [#{}]))) - -(deftest test-stratification-list - (is (thrown-with-msg? Exception #".*Fixed point overflow.*" - (stratification-list test-graph-2 test-graph-2))) - (is (= (stratification-list test-graph-4 test-graph-5) - [#{:a} #{:b :c} #{:d} #{:e} #{:f :g} #{:h}])) - (is (= (stratification-list empty-graph empty-graph) - [#{}]))) - -(comment - (run-tests) -) - - -;; End of file diff --git a/src/clojure/contrib/test_contrib/test_java_utils.clj b/src/clojure/contrib/test_contrib/test_java_utils.clj deleted file mode 100644 index 8e0f67c4..00000000 --- a/src/clojure/contrib/test_contrib/test_java_utils.clj +++ /dev/null @@ -1,123 +0,0 @@ -(ns clojure.contrib.test-contrib.test-java-utils - (:use clojure.test - [clojure.contrib.duck-streams :only (spit)] - clojure.contrib.java-utils) - (:import [java.io File] - [java.net URL URI] - [java.util Properties])) - -(deftest test-relative-path-string - (testing "strings" - (is (= "foo" (relative-path-string "foo")))) - (testing "absolute path strings are forbidden" - (is (thrown? IllegalArgumentException (relative-path-string "/baz")))) - (testing "relative File paths" - (is (= "bar" (relative-path-string (File. "bar"))))) - (testing "absolute File paths are forbidden" - (is (thrown? IllegalArgumentException (relative-path-string (File. "/quux"))))) -) - -(deftest test-as-file - (testing "strings" - (is (= (File. "foo") (as-file "foo")))) - (testing "Files" - (is (= (File. "bar") (as-file (File. "bar"))))) -) - -(deftest test-as-url - (are [result expr] (= result expr) - (URL. "http://foo") (as-url (URL. "http://foo")) - (URL. "http://foo") (as-url "http://foo") - (URL. "http://foo") (as-url (URI. "http://foo")) - (URL. "file:/foo") (as-url (File. "/foo")))) - -(deftest test-file - (testing "single argument" - (is (= (File. "foo") (file "foo")))) - (testing "two arguments" - (is (= (File. "foo/bar") (file "foo" "bar")))) - (testing "N arguments" - (is (= (File. "foo/bar/baz/quux") (file "foo" "bar" "baz" "quux")))) - (testing "no sneaking in absolute paths!" - (is (thrown? IllegalArgumentException (file "foo" "bar" "/boom" "baz" "quux")))) -) - -(deftest test-as-str - (testing "keyword to string" - (is (= "foo") (as-str :foo))) - (testing "symbol to string" - (is (= "foo") (as-str 'foo))) - (testing "string to string" - (is (= "foo") (as-str "foo"))) - (testing "stringifying non-namish things" - (is (= "42") (as-str 42))) -) - -(deftest test-get-system-property - (testing "works the same with keywords, symbols, and strings" - (is (= (get-system-property "java.home") (get-system-property 'java.home))) - (is (= (get-system-property "java.home") (get-system-property :java.home)))) - (testing "treats second arg as default" - (is (= "default" (get-system-property "testing.test-system-property" "default")))) - (testing "returns nil for missing properties" - (is (nil? (get-system-property "testing.test-system-property")))) -) - -(deftest test-set-system-properties - (testing "set and then unset a property using keywords" - (let [propname :clojure.contrib.java-utils.test-set-system-properties] - (is (nil? (get-system-property propname))) - (set-system-properties {propname :foo}) - (is (= "foo") (get-system-property propname)) - (set-system-properties {propname nil}) - (is (nil? (get-system-property propname))))) -) - -(deftest test-with-system-properties - (let [propname :clojure.contrib.java-utils.test-with-system-properties] - (testing "sets a property only for the duration of a block" - (is (= "foo" - (with-system-properties {propname "foo"} - (get-system-property propname)))) - (is (nil? (get-system-property propname))))) - (testing "leaves other properties alone" - ; TODO: write this test better, using a properties -> map function - (let [propname :clojure.contrib.java-utils.test-with-system-properties - propcount (count (System/getProperties))] - (with-system-properties {propname "foo"} - (is (= (inc propcount) (count (System/getProperties))))) - (is (= propcount (count (System/getProperties)))))) -) - -(deftest test-as-properties - (let [expected (doto (Properties.) - (.setProperty "a" "b") - (.setProperty "c" "d"))] - (testing "with a map" - (is (= expected - (as-properties {:a "b" :c "d"})))) - (testing "with a sequence of pairs" - (is (= expected - (as-properties [[:a :b] [:c :d]])))))) - -(deftest test-read-properties - (let [f (File/createTempFile "test" "properties")] - (spit f "a=b\nc=d") - (is (= {"a" "b" "c" "d"} - (read-properties f))))) - -(deftest test-write-properties - (let [f (File/createTempFile "test" "properties")] - (write-properties [['a 'b] ['c 'd]] f) - (is (= {"a" "b" "c" "d"} - (read-properties f))))) - - -(deftest test-delete-file - (let [file (File/createTempFile "test" "deletion") - not-file (File. (str (java.util.UUID/randomUUID)))] - (delete-file (.getAbsolutePath file)) - (is (not (.exists file))) - (is (thrown? ArithmeticException (/ 1 0))) - (is (thrown? java.io.IOException (delete-file not-file))) - (is (delete-file not-file :silently)))) diff --git a/src/clojure/contrib/test_contrib/test_jmx.clj b/src/clojure/contrib/test_contrib/test_jmx.clj deleted file mode 100644 index f75c76bf..00000000 --- a/src/clojure/contrib/test_contrib/test_jmx.clj +++ /dev/null @@ -1,166 +0,0 @@ -;; Tests for JMX support for Clojure (see also clojure/contrib/jmx.clj) - -;; by Stuart Halloway - -;; Copyright (c) Stuart Halloway, 2009. 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. - -(ns clojure.contrib.test-contrib.test-jmx - (:import javax.management.openmbean.CompositeDataSupport - [javax.management MBeanAttributeInfo AttributeList] - [java.util.logging LogManager Logger] - clojure.contrib.jmx.Bean) - (:use clojure.test) - (:require [clojure.contrib [jmx :as jmx]])) - - -(defn =set [a b] - (= (set a) (set b))) - -(deftest finding-mbeans - (testing "as-object-name" - (are [cname object-name] - (= cname (.getCanonicalName object-name)) - "java.lang:type=Memory" (jmx/as-object-name "java.lang:type=Memory"))) - (testing "mbean-names" - (are [cnames object-name] - (= cnames (map #(.getCanonicalName %) object-name)) - ["java.lang:type=Memory"] (jmx/mbean-names "java.lang:type=Memory")))) - -; don't know which attributes are common on all JVM platforms. May -; need to change expectations. -(deftest reflecting-on-capabilities - (are [attr-list mbean-name] - (= (set attr-list) (set (jmx/attribute-names mbean-name))) - [:Verbose :ObjectPendingFinalizationCount :HeapMemoryUsage :NonHeapMemoryUsage] "java.lang:type=Memory") - (are [a b] - (= (set a) (set b)) - [:gc] (jmx/operation-names "java.lang:type=Memory"))) - -(deftest raw-reading-attributes - (let [mem "java.lang:type=Memory" - log "java.util.logging:type=Logging"] - (testing "simple scalar attributes" - (are [a b] (= a b) - false (jmx/raw-read mem :Verbose)) - (are [type attr] (instance? type attr) - Integer (jmx/raw-read mem :ObjectPendingFinalizationCount))))) - -(deftest reading-attributes - (testing "simple scalar attributes" - (are [type attr] (instance? type attr) - Integer (jmx/read "java.lang:type=Memory" :ObjectPendingFinalizationCount))) - (testing "composite attributes" - (are [ks attr] (=set ks (keys attr)) - [:used :max :init :committed] (jmx/read "java.lang:type=Memory" :HeapMemoryUsage))) - (testing "tabular attributes" - (is (map? (jmx/read "java.lang:type=Runtime" :SystemProperties))))) - -(deftest mbean-from-oname - (are [oname key-names] - (= (set key-names) (set (keys (jmx/mbean oname)))) - "java.lang:type=Memory" [:Verbose :ObjectPendingFinalizationCount :HeapMemoryUsage :NonHeapMemoryUsage])) - -(deftest writing-attributes - (let [mem "java.lang:type=Memory"] - (jmx/write! mem :Verbose true) - (is (true? (jmx/raw-read mem :Verbose))) - (jmx/write! mem :Verbose false))) - -(deftest test-invoke-operations - (testing "without arguments" - (jmx/invoke "java.lang:type=Memory" :gc)) - (testing "with arguments" - (.addLogger (LogManager/getLogManager) (Logger/getLogger "clojure.contrib.test_contrib.test_jmx")) - (jmx/invoke "java.util.logging:type=Logging" :setLoggerLevel "clojure.contrib.test_contrib.test_jmx" "WARNING"))) - -(deftest test-jmx->clj - (testing "it works recursively on maps" - (let [some-map {:foo (jmx/raw-read "java.lang:type=Memory" :HeapMemoryUsage)}] - (is (map? (:foo (jmx/jmx->clj some-map)))))) - (testing "it leaves everything else untouched" - (is (= "foo" (jmx/jmx->clj "foo"))))) - - -(deftest test-composite-data->map - (let [data (jmx/raw-read "java.lang:type=Memory" :HeapMemoryUsage) - prox (jmx/composite-data->map data)] - (testing "returns a map with keyword keys" - (is (= (set [:committed :init :max :used]) (set (keys prox))))))) - -(deftest test-tabular-data->map - (let [raw-props (jmx/raw-read "java.lang:type=Runtime" :SystemProperties) - props (jmx/tabular-data->map raw-props)] - (are [k] (contains? props k) - :java.class.path - :path.separator))) - -(deftest test-creating-attribute-infos - (let [infos (jmx/map->attribute-infos [[:a 1] [:b 2]]) - info (first infos)] - (testing "generates the right class" - (is (= (class (into-array MBeanAttributeInfo [])) (class infos)))) - (testing "generates the right instance data" - (are [result expr] (= result expr) - "a" (.getName info) - "a" (.getDescription info))))) - -(deftest various-beans-are-readable - (testing "that all java.lang beans can be read without error" - (doseq [mb (jmx/mbean-names "*:*")] - (jmx/mbean mb)))) - -(deftest test-jmx-url - (testing "creates default url" - (is (= "service:jmx:rmi:///jndi/rmi://localhost:3000/jmxrmi" (jmx/jmx-url)))) - (testing "creates custom url" - (is (= "service:jmx:rmi:///jndi/rmi://example.com:4000/jmxrmi" (jmx/jmx-url {:host "example.com" :port 4000}))))) - -;; ---------------------------------------------------------------------- -;; tests for clojure.contrib.jmx.Bean. - -(deftest dynamic-mbean-from-compiled-class - (let [mbean-name "clojure.contrib.test_contrib.test_jmx:name=Foo"] - (jmx/register-mbean - (Bean. - (ref {:string-attribute "a-string"})) - mbean-name) - (are [result expr] (= result expr) - "a-string" (jmx/read mbean-name :string-attribute) - {:string-attribute "a-string"} (jmx/mbean mbean-name) - ))) - -(deftest test-getAttribute - (doseq [reftype [ref atom agent]] - (let [state (reftype {:a 1 :b 2}) - bean (Bean. state)] - (testing (str "accessing values from a " (class state)) - (are [result expr] (= result expr) - 1 (.getAttribute bean "a")))))) - -(deftest test-bean-info - (let [state (ref {:a 1 :b 2}) - bean (Bean. state) - info (.getMBeanInfo bean)] - (testing "accessing info" - (are [result expr] (= result expr) - "clojure.contrib.jmx.Bean" (.getClassName info))))) - -(deftest test-getAttributes - (let [bean (Bean. (ref {:r 5 :d 4})) - atts (.getAttributes bean (into-array ["r" "d"]))] - (are [x y] (= x y) - AttributeList (class atts) - [5 4] (seq atts)))) - -(deftest test-guess-attribute-typename - (are [x y] (= x (jmx/guess-attribute-typename y)) - "int" 10 - "boolean" false - "java.lang.String" "foo" - "long" (long 10)))
\ No newline at end of file diff --git a/src/clojure/contrib/test_contrib/test_lazy_seqs.clj b/src/clojure/contrib/test_contrib/test_lazy_seqs.clj deleted file mode 100644 index 33bbcae1..00000000 --- a/src/clojure/contrib/test_contrib/test_lazy_seqs.clj +++ /dev/null @@ -1,21 +0,0 @@ -(ns clojure.contrib.test-contrib.test-lazy-seqs - (:use clojure.test - clojure.contrib.lazy-seqs)) - -(deftest test-fibs - (is (= [0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 6765 10946 - 17711 28657 46368 75025 121393 196418 317811 514229 832040 1346269 2178309 - 3524578 5702887 9227465 14930352 24157817 39088169 63245986 102334155 - 165580141 267914296 433494437 701408733 1134903170 1836311903 2971215073 - 4807526976 7778742049] - (take 50 (fibs))))) - -(deftest test-powers-of-2 - (is (= [1 2 4 8 16 32 64 128 256 512] - (take 10 (powers-of-2))))) - -(deftest test-primes - (is (= [2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 101 - 103 107 109 113 127 131 137 139 149 151 157 163 167 173 179 181 191 193 197 - 199 211 223 227 229] - (take 50 primes)))) diff --git a/src/clojure/contrib/test_contrib/test_trace.clj b/src/clojure/contrib/test_contrib/test_trace.clj deleted file mode 100644 index 32c2ccbe..00000000 --- a/src/clojure/contrib/test_contrib/test_trace.clj +++ /dev/null @@ -1,16 +0,0 @@ -(ns clojure.contrib.test-contrib.test-trace - (:use clojure.test - [clojure.contrib trace str-utils])) - -(deftrace call-myself [n] - (when-not (< n 1) - (call-myself (dec n)))) - -(deftest test-tracing-a-function-that-calls-itself - (let [output (with-out-str (call-myself 1))] - (is (re-find #"^TRACE t\d+: (call-myself 1)\nTRACE t\d+: | (call-myself 0)\nTRACE t\d+: | => nil\nTRACE t\d+: => nil$" - output)))) - -;(deftest dotrace-on-core -; (let [output (with-out-str (dotrace [mod] (mod 11 5)))] -; (is (re-find #"\(mod 11 5\)" output)))) diff --git a/src/clojure/contrib/test_contrib/walk.clj b/src/clojure/contrib/test_contrib/walk.clj deleted file mode 100644 index 9e79f8d6..00000000 --- a/src/clojure/contrib/test_contrib/walk.clj +++ /dev/null @@ -1,34 +0,0 @@ -(ns clojure.contrib.test-contrib.walk - (:require [clojure.contrib.walk :as w]) - (:use clojure.test)) - -(deftest t-prewalk-replace - (is (= (w/prewalk-replace {:a :b} [:a {:a :a} (list 3 :c :a)]) - [:b {:b :b} (list 3 :c :b)]))) - -(deftest t-postwalk-replace - (is (= (w/postwalk-replace {:a :b} [:a {:a :a} (list 3 :c :a)]) - [:b {:b :b} (list 3 :c :b)]))) - -(deftest t-stringify-keys - (is (= (w/stringify-keys {:a 1, nil {:b 2 :c 3}, :d 4}) - {"a" 1, nil {"b" 2 "c" 3}, "d" 4}))) - -(deftest t-prewalk-order - (is (= (let [a (atom [])] - (w/prewalk (fn [form] (swap! a conj form) form) - [1 2 {:a 3} (list 4 [5])]) - @a) - [[1 2 {:a 3} (list 4 [5])] - 1 2 {:a 3} [:a 3] :a 3 (list 4 [5]) - 4 [5] 5]))) - -(deftest t-postwalk-order - (is (= (let [a (atom [])] - (w/postwalk (fn [form] (swap! a conj form) form) - [1 2 {:a 3} (list 4 [5])]) - @a) - [1 2 - :a 3 [:a 3] {:a 3} - 4 5 [5] (list 4 [5]) - [1 2 {:a 3} (list 4 [5])]])))
\ No newline at end of file diff --git a/src/clojure/contrib/test_contrib/with_ns_test.clj b/src/clojure/contrib/test_contrib/with_ns_test.clj deleted file mode 100644 index 09137bc0..00000000 --- a/src/clojure/contrib/test_contrib/with_ns_test.clj +++ /dev/null @@ -1,19 +0,0 @@ -(ns clojure.contrib.test-contrib.with-ns-test - (:use clojure.test - clojure.contrib.with-ns - [clojure.contrib.seq-utils :only (includes?)])) - -(deftest test-namespace-gets-removed - (let [all-ns-names (fn [] (map #(.name %) (all-ns)))] - (testing "unexceptional return" - (let [ns-name (with-temp-ns (ns-name *ns*))] - (is (not (includes? (all-ns-names) ns-name))))) - (testing "when an exception is thrown" - (let [ns-name-str - (try - (with-temp-ns - (throw (RuntimeException. (str (ns-name *ns*))))) - (catch clojure.lang.Compiler$CompilerException e - (-> e .getCause .getMessage)))] - (is (re-find #"^sym.*$" ns-name-str)) - (is (not (includes? (all-ns-names) (symbol ns-name-str)))))))) |