diff options
author | Stuart Sierra <mail@stuartsierra.com> | 2010-08-10 21:40:47 -0400 |
---|---|---|
committer | Stuart Sierra <mail@stuartsierra.com> | 2010-08-10 21:40:47 -0400 |
commit | 38743f83bdd60d6687dabcea3864b04bbd554a6c (patch) | |
tree | 44b31d4900c2d5720679abe911694d64fc516d0a | |
parent | a6a92b9b3d2bfd9a56e1e5e9cfba706d1aeeaae5 (diff) |
Add test sources to their respective modules
44 files changed, 4280 insertions, 67 deletions
diff --git a/modules/complex-numbers/src/test/clojure/clojure/contrib/test_complex_numbers.clj b/modules/complex-numbers/src/test/clojure/clojure/contrib/test_complex_numbers.clj new file mode 100644 index 00000000..008e6ec7 --- /dev/null +++ b/modules/complex-numbers/src/test/clojure/clojure/contrib/test_complex_numbers.clj @@ -0,0 +1,313 @@ +;; 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-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/modules/core/src/test/clojure/clojure/contrib/test_core.clj b/modules/core/src/test/clojure/clojure/contrib/test_core.clj new file mode 100644 index 00000000..3048778c --- /dev/null +++ b/modules/core/src/test/clojure/clojure/contrib/test_core.clj @@ -0,0 +1,42 @@ +; Copyright (c) Laurent Petit, March 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. + +;; test namespace for clojure.contrib.core + +;; note to other contrib members: feel free to add to this lib + +(ns clojure.contrib.test-core + (:use clojure.test) + (:use clojure.contrib.core)) + +(deftest test-classic-versions + (testing "Classic -> throws NPE if passed nil" + (is (thrown? NullPointerException (-> nil .toString))) + (is (thrown? NullPointerException (-> "foo" seq next next next .toString)))) + (testing "Classic .. throws NPE if one of the intermediate threaded values is nil" + (is (thrown? NullPointerException (.. nil toString))) + (is (thrown? NullPointerException (.. [nil] (get 0) toString))))) + +(deftest test-new-versions + (testing "Version -?>> falls out on nil" + (is (nil? (-?>> nil .toString))) + (is (nil? (-?>> [] seq (map inc)))) + (is (= [] (->> [] seq (map inc))))) + (testing "Version -?>> completes for non-nil" + (is (= [3 4] (-?>> [1 2] (map inc) (map inc))))) + (testing "Version -?> falls out on nil" + (is (nil? (-?> nil .toString))) + (is (nil? (-?> "foo" seq next next next .toString)))) + (testing "Version -?> completes for non-nil" + (is (= [\O \O] (-?> "foo" .toUpperCase rest)))) + (testing "Version .?. returns nil if one of the intermediate threaded values is nil" + (is (nil? (.?. nil toString))) + (is (nil? (.?. [nil] (get 0) toString))))) + diff --git a/modules/dataflow/src/test/clojure/clojure/contrib/test_dataflow.clj b/modules/dataflow/src/test/clojure/clojure/contrib/test_dataflow.clj new file mode 100644 index 00000000..55e9592b --- /dev/null +++ b/modules/dataflow/src/test/clojure/clojure/contrib/test_dataflow.clj @@ -0,0 +1,90 @@ +;; 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-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/modules/datalog/pom.xml b/modules/datalog/pom.xml index 4a1bdf3b..90d5fbf7 100644 --- a/modules/datalog/pom.xml +++ b/modules/datalog/pom.xml @@ -17,5 +17,25 @@ <artifactId>except</artifactId> <version>1.3.0-SNAPSHOT</version> </dependency> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>seq</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>def</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>set</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> + <dependency> + <groupId>org.clojure.contrib</groupId> + <artifactId>graph</artifactId> + <version>1.3.0-SNAPSHOT</version> + </dependency> </dependencies> </project>
\ No newline at end of file diff --git a/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test.clj b/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test.clj new file mode 100644 index 00000000..121d264e --- /dev/null +++ b/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test.clj @@ -0,0 +1,45 @@ +;; 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.clj +;; +;; A Clojure implementation of Datalog -- Tests +;; +;; straszheimjeffrey (gmail) +;; Created 11 Feburary 2009 + +(ns clojure.contrib.datalog.tests.test + (:use [clojure.test :only (run-tests)]) + (:gen-class)) + +(def test-names [:test-util + :test-database + :test-literals + :test-rules + :test-magic + :test-softstrat]) + +(def test-namespaces + (map #(symbol (str "clojure.contrib.datalog.tests." (name %))) + test-names)) + +(defn run + "Runs all defined tests" + [] + (println "Loading tests...") + (apply require :reload-all test-namespaces) + (apply run-tests test-namespaces)) + +(defn -main + "Run all defined tests from the command line" + [& args] + (run) + (System/exit 0)) + + +;; End of file diff --git a/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test_database.clj b/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test_database.clj new file mode 100644 index 00000000..77719008 --- /dev/null +++ b/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test_database.clj @@ -0,0 +1,153 @@ +;; 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-database.clj +;; +;; A Clojure implementation of Datalog -- Database +;; +;; straszheimjeffrey (gmail) +;; Created 12 Feburary 2009 + + +(ns clojure.contrib.datalog.tests.test-database + (:use clojure.test + clojure.contrib.datalog.database)) + + +(def test-db + (make-database + (relation :fred [:mary :sue]) + (index :fred :mary) + (relation :sally [:jen :becky :joan]) + (index :sally :jen) + (index :sally :becky))) + +(deftest test-make-database + (is (= test-db + (datalog-database + {:sally (datalog-relation + #{:jen :joan :becky} + #{} + {:becky {} + :jen {}}) + :fred (datalog-relation + #{:sue :mary} + #{} + {:mary {}})})))) + + +(deftest test-ensure-relation + (is (contains? (ensure-relation test-db :bob [:sam :george] [:sam]) :bob)) + (is (contains? (ensure-relation test-db :fred [:mary :sue] [:mary]) :fred)) + (is (thrown? AssertionError (ensure-relation test-db :fred [:bob :joe] [])))) + +(deftest test-add-tuple + (let [new-db (add-tuple test-db :fred {:mary 1 :sue 2})] + (is (= (select new-db :fred {:mary 1}) [{:mary 1 :sue 2}]))) + (is (thrown? AssertionError (add-tuple test-db :fred {:mary 1})))) + +(def test-db-1 + (add-tuples test-db + [:fred :mary 1 :sue 2] + [:fred :mary 2 :sue 3] + [:sally :jen 1 :becky 2 :joan 0] + [:sally :jen 1 :becky 4 :joan 3] + [:sally :jen 1 :becky 3 :joan 0] + [:sally :jen 1 :becky 2 :joan 3] + [:fred :mary 1 :sue 1] + [:fred :mary 3 :sue 1])) + +(deftest test-add-tuples + (is (= test-db-1 + (datalog-database + {:sally (datalog-relation + #{:jen :joan :becky} + #{{:jen 1, :joan 0, :becky 3} + {:jen 1, :joan 0, :becky 2} + {:jen 1, :joan 3, :becky 2} + {:jen 1, :joan 3, :becky 4}} + {:becky {3 + #{{:jen 1, :joan 0, :becky 3}} + 4 + #{{:jen 1, :joan 3, :becky 4}} + 2 + #{{:jen 1, :joan 0, :becky 2} + {:jen 1, :joan 3, :becky 2}}} + :jen {1 + #{{:jen 1, :joan 0, :becky 3} + {:jen 1, :joan 0, :becky 2} + {:jen 1, :joan 3, :becky 2} + {:jen 1, :joan 3, :becky 4}}}}) + :fred (datalog-relation + #{:sue :mary} + #{{:sue 2, :mary 1} + {:sue 1, :mary 1} + {:sue 3, :mary 2} + {:sue 1, :mary 3}} + {:mary {3 + #{{:sue 1, :mary 3}} + 2 + #{{:sue 3, :mary 2}} + 1 + #{{:sue 2, :mary 1} + {:sue 1, :mary 1}}}})})))) + +(deftest test-remove-tuples + (let [db (reduce #(apply remove-tuple %1 (first %2) (next %2)) + test-db-1 + [[:fred {:mary 1 :sue 1}] + [:fred {:mary 3 :sue 1}] + [:sally {:jen 1 :becky 2 :joan 0}] + [:sally {:jen 1 :becky 4 :joan 3}]])] + (is (= db + (datalog-database + {:sally (datalog-relation + #{:jen :joan :becky} + #{{:jen 1, :joan 0, :becky 3} + {:jen 1, :joan 3, :becky 2}} + {:becky + {3 + #{{:jen 1, :joan 0, :becky 3}} + 2 + #{{:jen 1, :joan 3, :becky 2}}} + :jen + {1 + #{{:jen 1, :joan 0, :becky 3} + {:jen 1, :joan 3, :becky 2}}}}) + :fred (datalog-relation + #{:sue :mary} + #{{:sue 2, :mary 1} + {:sue 3, :mary 2}} + {:mary + {2 + #{{:sue 3, :mary 2}} + 1 + #{{:sue 2, :mary 1}}}})}))))) + + + +(deftest test-select + (is (= (set (select test-db-1 :sally {:jen 1 :becky 2})) + #{{:jen 1 :joan 0 :becky 2} {:jen 1 :joan 3 :becky 2}})) + (is (= (set (select test-db-1 :fred {:sue 1}))) + #{{:mary 3 :sue 1} {:mary 1 :sue 1}}) + (is (empty? (select test-db-1 :sally {:joan 5 :jen 1})))) + +(deftest test-any-match? + (is (any-match? test-db-1 :fred {:mary 3})) + (is (any-match? test-db-1 :sally {:jen 1 :becky 2 :joan 3})) + (is (not (any-match? test-db-1 :sally {:jen 5}))) + (is (not (any-match? test-db-1 :fred {:mary 1 :sue 5})))) + + +(comment + (run-tests) +) + +;; End of file + diff --git a/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test_literals.clj b/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test_literals.clj new file mode 100644 index 00000000..36ee5147 --- /dev/null +++ b/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test_literals.clj @@ -0,0 +1,187 @@ +;; 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-literals.clj +;; +;; A Clojure implementation of Datalog -- Literals tests +;; +;; straszheimjeffrey (gmail) +;; Created 25 Feburary 2009 + + +(ns clojure.contrib.datalog.tests.test-literals + (:use clojure.test) + (:use clojure.contrib.datalog.literals + clojure.contrib.datalog.database)) + + +(def pl (eval (build-literal '(:fred :x ?x :y ?y :z 3)))) +(def nl (eval (build-literal '(not! :fred :x ?x :y ?y :z 3)))) +(def cl (eval (build-literal '(if > ?x 3)))) + +(def bl (eval (build-literal '(:fred)))) + +(def bns {:x '?x :y '?y :z 3}) + +(deftest test-build-literal + (is (= (:predicate pl) :fred)) + (is (= (:term-bindings pl) bns)) + (is (= (:predicate nl) :fred)) + (is (= (:term-bindings nl) bns)) + (is (= (:symbol cl) '>)) + (is (= (:terms cl) '(?x 3))) + (is ((:fun cl) [4 3])) + (is (not ((:fun cl) [2 4]))) + (is (= (:predicate bl) :fred))) + +(deftest test-literal-predicate + (is (= (literal-predicate pl) :fred)) + (is (= (literal-predicate nl) :fred)) + (is (nil? (literal-predicate cl))) + (is (= (literal-predicate bl) :fred))) + +(deftest test-literal-columns + (is (= (literal-columns pl) #{:x :y :z})) + (is (= (literal-columns nl) #{:x :y :z})) + (is (nil? (literal-columns cl))) + (is (empty? (literal-columns bl)))) + +(deftest test-literal-vars + (is (= (literal-vars pl) #{'?x '?y})) + (is (= (literal-vars nl) #{'?x '?y})) + (is (= (literal-vars cl) #{'?x})) + (is (empty? (literal-vars bl)))) + +(deftest test-positive-vars + (is (= (positive-vars pl) (literal-vars pl))) + (is (nil? (positive-vars nl))) + (is (nil? (positive-vars cl))) + (is (empty? (positive-vars bl)))) + +(deftest test-negative-vars + (is (nil? (negative-vars pl))) + (is (= (negative-vars nl) (literal-vars nl))) + (is (= (negative-vars cl) (literal-vars cl))) + (is (empty? (negative-vars bl)))) + +(deftest test-negated? + (is (not (negated? pl))) + (is (negated? nl)) + (is (not (negated? cl)))) + +(deftest test-vs-from-cs + (is (= (get-vs-from-cs pl #{:x}) #{'?x})) + (is (empty? (get-vs-from-cs pl #{:z}))) + (is (= (get-vs-from-cs pl #{:x :r}) #{'?x})) + (is (empty? (get-vs-from-cs pl #{})))) + +(deftest test-cs-from-vs + (is (= (get-cs-from-vs pl #{'?x}) #{:x})) + (is (= (get-cs-from-vs pl #{'?x '?r}) #{:x})) + (is (empty? (get-cs-from-vs pl #{})))) + +(deftest test-literal-appropriate? + (is (not (literal-appropriate? #{} pl))) + (is (literal-appropriate? #{'?x} pl)) + (is (not (literal-appropriate? #{'?x} nl))) + (is (literal-appropriate? #{'?x '?y} nl)) + (is (not (literal-appropriate? #{'?z} cl))) + (is (literal-appropriate? #{'?x} cl))) + +(deftest test-adorned-literal + (is (= (literal-predicate (adorned-literal pl #{:x})) + {:pred :fred :bound #{:x}})) + (is (= (literal-predicate (adorned-literal nl #{:x :y :q})) + {:pred :fred :bound #{:x :y}})) + (is (= (:term-bindings (adorned-literal nl #{:x})) + {:x '?x :y '?y :z 3})) + (is (= (adorned-literal cl #{}) + cl))) + +(deftest test-get-adorned-bindings + (is (= (get-adorned-bindings (literal-predicate (adorned-literal pl #{:x}))) + #{:x})) + (is (= (get-adorned-bindings (literal-predicate pl)) + nil))) + +(deftest test-get-base-predicate + (is (= (get-base-predicate (literal-predicate (adorned-literal pl #{:x}))) + :fred)) + (is (= (get-base-predicate (literal-predicate pl)) + :fred))) + +(deftest test-magic-literal + (is (= (magic-literal pl) + {:predicate {:pred :fred :magic true}, :term-bindings {}, :literal-type :clojure.contrib.datalog.literals/literal})) + (is (= (magic-literal (adorned-literal pl #{:x})) + {:predicate {:pred :fred :magic true :bound #{:x}}, + :term-bindings {:x '?x}, + :literal-type :clojure.contrib.datalog.literals/literal}))) + +(comment + (use 'clojure.contrib.stacktrace) (e) + (use :reload 'clojure.contrib.datalog.literals) +) + + +(def db1 (make-database + (relation :fred [:x :y]) + (index :fred :x) + (relation :sally [:x]))) + +(def db2 (add-tuples db1 + [:fred :x 1 :y :mary] + [:fred :x 1 :y :becky] + [:fred :x 3 :y :sally] + [:fred :x 4 :y :joe] + [:sally :x 1] + [:sally :x 2])) + +(def lit1 (eval (build-literal '(:fred :x ?x :y ?y)))) +(def lit2 (eval (build-literal '(not! :fred :x ?x)))) +(def lit3 (eval (build-literal '(if > ?x ?y)))) +(def lit4 (adorned-literal (eval (build-literal '(:joan :x ?x :y ?y))) #{:x})) + +(deftest test-join-literal + (is (= (set (join-literal db2 lit1 [{'?x 1} {'?x 2} {'?x 3}])) + #{{'?x 1, '?y :mary} {'?x 1, '?y :becky} {'?x 3, '?y :sally}})) + (is (= (join-literal db2 lit2 [{'?x 1} {'?x 2} {'?x 3}]) + [{'?x 2}])) + (is (= (join-literal db2 lit3 [{'?x 1 '?y 2} {'?x 3 '?y 1}]) + [{'?x 3 '?y 1}]))) + +(deftest test-project-literal + (is (= ((project-literal db2 lit4 [{'?x 1 '?y 3}{'?x 4 '?y 2}]) {:pred :joan :bound #{:x}}) + (datalog-relation + ;; Schema + #{:y :x} + + ;; Data + #{ + {:x 1, :y 3} + {:x 4, :y 2} + } + + ;; Indexes + { + :x + { + 4 + #{{:x 4, :y 2}} + 1 + #{{:x 1, :y 3}} + } + })))) + + + +(comment + (run-tests) +) + +;; End of file diff --git a/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test_magic.clj b/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test_magic.clj new file mode 100644 index 00000000..7eabae78 --- /dev/null +++ b/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test_magic.clj @@ -0,0 +1,72 @@ +;; 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-magic.clj +;; +;; A Clojure implementation of Datalog -- Magic Tests +;; +;; straszheimjeffrey (gmail) +;; Created 18 Feburary 2009 + +(ns clojure.contrib.datalog.tests.test-magic + (:use clojure.test) + (:use clojure.contrib.datalog.magic + clojure.contrib.datalog.rules)) + + + +(def rs (rules-set + (<- (:p :x ?x :y ?y) (:e :x ?x :y ?y)) + (<- (:p :x ?x :y ?y) (:e :x ?x :y ?z) (:p :x ?z :y ?y)) + (<- (:e :x ?x :y ?y) (:b :x ?x :y ?y)) + (<- (:e :x ?y :y ?y) (:c :x ?x :y ?y)))) + +(def q (adorn-query (?- :p :x 1 :y ?y))) + +(def ars (adorn-rules-set rs q)) + +(deftest test-adorn-rules-set + (is (= ars + (rules-set + (<- ({:pred :p :bound #{:x}} :y ?y :x ?x) ({:pred :e :bound #{:x}} :y ?y :x ?x)) + (<- ({:pred :p :bound #{:x}} :y ?y :x ?x) ({:pred :e :bound #{:x}} :y ?z :x ?x) + ({:pred :p :bound #{:x}} :y ?y :x ?z)) + (<- ({:pred :e :bound #{:x}} :y ?y :x ?y) (:c :y ?y :x ?x)) + (<- ({:pred :e :bound #{:x}} :y ?y :x ?x) (:b :y ?y :x ?x)))))) + + +(def m (magic-transform ars)) + +(deftest test-magic-transform + (is (= m + (rules-set + (<- ({:pred :e :bound #{:x}} :y ?y :x ?y) ({:pred :e :magic true :bound #{:x}} :x ?y) (:c :y ?y :x ?x)) + + (<- ({:pred :e :bound #{:x}} :y ?y :x ?x) ({:pred :e :magic true :bound #{:x}} :x ?x) (:b :y ?y :x ?x)) + + (<- ({:pred :p :magic true :bound #{:x}} :x ?z) ({:pred :p :magic true :bound #{:x}} :x ?x) + ({:pred :e :bound #{:x}} :y ?z :x ?x)) + + (<- ({:pred :p :bound #{:x}} :y ?y :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x) + ({:pred :e :bound #{:x}} :y ?z :x ?x) + ({:pred :p :bound #{:x}} :y ?y :x ?z)) + + (<- ({:pred :e :magic true :bound #{:x}} :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x)) + + (<- ({:pred :p :bound #{:x}} :y ?y :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x) + ({:pred :e :bound #{:x}} :y ?y :x ?x)))))) + + + + +(comment + (run-tests) +) + +;; End of file + diff --git a/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test_rules.clj b/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test_rules.clj new file mode 100644 index 00000000..8b80b770 --- /dev/null +++ b/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test_rules.clj @@ -0,0 +1,130 @@ +;; 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-rules.clj +;; +;; A Clojure implementation of Datalog -- Rule Tests +;; +;; straszheimjeffrey (gmail) +;; Created 12 Feburary 2009 + + +(ns clojure.contrib.datalog.tests.test-rules + (:use clojure.test + clojure.contrib.datalog.rules + clojure.contrib.datalog.literals + clojure.contrib.datalog.database)) + + +(def tr-1 (<- (:fred :x ?x :y ?y) (:mary :x ?x :z ?z) (:sally :z ?z :y ?y))) +(def tr-2 (<- (:fred) (not! :mary :x 3))) +(def tr-3 (<- (:fred :x ?x :y ?y) (if > ?x ?y) (:mary :x ?x) (:sally :y ?y))) + + + +(deftest test-rule-safety + (is (thrown-with-msg? Exception #".*Head vars.*not bound.*" + (<- (:fred :x ?x) (:sally :y ?y)))) + (is (thrown-with-msg? Exception #".*Body vars.*not bound.*negative position.*" + (<- (:fred :x ?x) (:becky :x ?x) (not! :sally :y ?y)))) + (is (thrown-with-msg? Exception #".*Body vars.*not bound.*negative position.*" + (<- (:fred :x ?x) (:becky :x ?x) (if > ?x ?y))))) + + +(deftest test-sip + (is (= (compute-sip #{:x} #{:mary :sally} tr-1) + (<- ({:pred :fred :bound #{:x}} :x ?x :y ?y) + ({:pred :mary :bound #{:x}} :z ?z :x ?x) + ({:pred :sally :bound #{:z}} :y ?y :z ?z)))) + + (is (= (compute-sip #{} #{:mary :sally} tr-1) + (<- (:fred :y ?y :x ?x) (:mary :z ?z :x ?x) ({:pred :sally :bound #{:z}} :y ?y :z ?z)))) + + (is (= (compute-sip #{} #{:mary} tr-2) + (<- (:fred) (not! {:pred :mary :bound #{:x}} :x 3)))) + + (is (= (compute-sip #{} #{} tr-2) + tr-2)) + + (is (= (display-rule (compute-sip #{:x} #{:mary :sally} tr-3)) + (display-rule (<- ({:pred :fred :bound #{:x}} :x ?x :y ?y) + ({:pred :mary :bound #{:x}} :x ?x) + (:sally :y ?y) + (if > ?x ?y)))))) + ; Display rule is used because = does not work on + ; (if > ?x ?y) because it contains a closure + + +(def rs + (rules-set + (<- (:path :a ?x :b ?y) (:edge :a ?x :b ?y)) + (<- (:path :a ?x :b ?y) (:edge :a ?x :b ?z) (:path :a ?z :b ?y)) + (<- (:edge :a ?x :b ?y) (:route :a ?x :b ?y) (if not= ?x ?y)))) + +(deftest test-rules-set + (is (= (count rs) 3)) + (is (contains? rs (<- (:path :a ?x :b ?y) (:edge :a ?x :b ?z) (:path :a ?z :b ?y))))) + +(deftest test-predicate-map + (let [pm (predicate-map rs)] + (is (= (pm :path) + #{(<- (:path :a ?x :b ?y) (:edge :a ?x :b ?y)) + (<- (:path :a ?x :b ?y) (:edge :a ?x :b ?z) (:path :a ?z :b ?y))})) + (is (= (-> :edge pm count) 1)))) + + +(def db1 (make-database + (relation :fred [:x :y]) + (index :fred :x) + (relation :sally [:x]) + (relation :ben [:y]))) + +(def db2 (add-tuples db1 + [:fred :x 1 :y :mary] + [:fred :x 1 :y :becky] + [:fred :x 3 :y :sally] + [:fred :x 4 :y :joe] + [:fred :x 4 :y :bob] + [:sally :x 1] + [:sally :x 2] + [:sally :x 3] + [:sally :x 4] + [:ben :y :bob])) + + +(deftest test-apply-rule + (is (= (apply-rule db2 empty-database (<- (:becky :y ?y) (:sally :x ?x) + (:fred :x ?x :y ?y) + (not! :ben :y ?y) + (if not= ?x 3))) + (datalog-database + { + :becky + (datalog-relation + ;; Schema + #{:y} + ;; Data + #{ + {:y :joe} + {:y :mary} + {:y :becky} + } + ;; Indexes + { + }) + })))) + + + + +(comment + (run-tests) +) + +;; End of file + diff --git a/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test_softstrat.clj b/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test_softstrat.clj new file mode 100644 index 00000000..a33d8c96 --- /dev/null +++ b/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test_softstrat.clj @@ -0,0 +1,233 @@ +;; 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-softstrat.clj +;; +;; A Clojure implementation of Datalog -- Soft Stratification Tests +;; +;; straszheimjeffrey (gmail) +;; Created 28 Feburary 2009 + +(ns clojure.contrib.datalog.tests.test-softstrat + (:use clojure.test) + (:use clojure.contrib.datalog.softstrat + clojure.contrib.datalog.magic + clojure.contrib.datalog.rules + clojure.contrib.datalog.database) + (:use [clojure.contrib.set :only (subset?)])) + + + +(def rs1 (rules-set + (<- (:p :x ?x) (:b :x ?x :y ?y :z ?z) (not! :q :x ?x) (not! :q :x ?y) (not! :q :x ?z)) + (<- (:q :x ?x) (:d :x ?x)))) + +(def q1 (?- :p :x 1)) + +(def ws (build-soft-strat-work-plan rs1 q1)) + +(deftest test-soft-stratification + (let [soft (:stratification ws) + q (:query ws)] + (is (= q (?- {:pred :p :bound #{:x}} :x 1))) + (is (= (count soft) 4)) + (is (subset? (rules-set + (<- ({:pred :q :bound #{:x}} :x ?x) ({:pred :q :magic true :bound #{:x}} :x ?x) + (:d :x ?x)) + + (<- ({:pred :q :magic true :bound #{:x}} :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x) + (:b :z ?z :y ?y :x ?x))) + (nth soft 0))) + (is (= (nth soft 1) + (rules-set + (<- ({:pred :q :magic true :bound #{:x}} :x ?y) ({:pred :p :magic true :bound #{:x}} :x ?x) + (:b :z ?z :y ?y :x ?x) + (not! {:pred :q :bound #{:x}} :x ?x))))) + (is (= (nth soft 2) + (rules-set + (<- ({:pred :q :magic true :bound #{:x}} :x ?z) ({:pred :p :magic true :bound #{:x}} :x ?x) + (:b :z ?z :y ?y :x ?x) + (not! {:pred :q :bound #{:x}} :x ?x) + (not! {:pred :q :bound #{:x}} :x ?y))))) + (is (= (nth soft 3) + (rules-set + (<- ({:pred :p :bound #{:x}} :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x) + (:b :z ?z :y ?y :x ?x) + (not! {:pred :q :bound #{:x}} :x ?x) + (not! {:pred :q :bound #{:x}} :x ?y) + (not! {:pred :q :bound #{:x}} :x ?z))))))) + + +(def tdb-1 + (make-database + (relation :b [:x :y :z]) + (relation :d [:x]))) + +(def tdb-2 + (add-tuples tdb-1 + [:b :x 1 :y 2 :z 3])) + +(deftest test-tdb-2 + (is (= (evaluate-soft-work-set ws tdb-2 {}) + [{:x 1}]))) + + + +(def tdb-3 + (add-tuples tdb-2 + [:d :x 2] + [:d :x 3])) + +(deftest test-tdb-3 + (is (empty? (evaluate-soft-work-set ws tdb-3 {})))) + + + +;;;;;;;;;;; + + + +(def db-base + (make-database + (relation :employee [:id :name :position]) + (index :employee :name) + + (relation :boss [:employee-id :boss-id]) + (index :boss :employee-id) + + (relation :can-do-job [:position :job]) + (index :can-do-job :position) + + (relation :job-replacement [:job :can-be-done-by]) + + (relation :job-exceptions [:id :job]))) + +(def db + (add-tuples db-base + [:employee :id 1 :name "Bob" :position :boss] + [:employee :id 2 :name "Mary" :position :chief-accountant] + [:employee :id 3 :name "John" :position :accountant] + [:employee :id 4 :name "Sameer" :position :chief-programmer] + [:employee :id 5 :name "Lilian" :position :programmer] + [:employee :id 6 :name "Li" :position :technician] + [:employee :id 7 :name "Fred" :position :sales] + [:employee :id 8 :name "Brenda" :position :sales] + [:employee :id 9 :name "Miki" :position :project-management] + [:employee :id 10 :name "Albert" :position :technician] + + [:boss :employee-id 2 :boss-id 1] + [:boss :employee-id 3 :boss-id 2] + [:boss :employee-id 4 :boss-id 1] + [:boss :employee-id 5 :boss-id 4] + [:boss :employee-id 6 :boss-id 4] + [:boss :employee-id 7 :boss-id 1] + [:boss :employee-id 8 :boss-id 7] + [:boss :employee-id 9 :boss-id 1] + [:boss :employee-id 10 :boss-id 6] + + [:can-do-job :position :boss :job :management] + [:can-do-job :position :accountant :job :accounting] + [:can-do-job :position :chief-accountant :job :accounting] + [:can-do-job :position :programmer :job :programming] + [:can-do-job :position :chief-programmer :job :programming] + [:can-do-job :position :technician :job :server-support] + [:can-do-job :position :sales :job :sales] + [:can-do-job :position :project-management :job :project-management] + + [:job-replacement :job :pc-support :can-be-done-by :server-support] + [:job-replacement :job :pc-support :can-be-done-by :programming] + [:job-replacement :job :payroll :can-be-done-by :accounting] + + [:job-exceptions :id 4 :job :pc-support])) + +(def rules + (rules-set + (<- (:works-for :employee ?x :boss ?y) (:boss :employee-id ?e-id :boss-id ?b-id) + (:employee :id ?e-id :name ?x) + (:employee :id ?b-id :name ?y)) + (<- (:works-for :employee ?x :boss ?y) (:works-for :employee ?x :boss ?z) + (:works-for :employee ?z :boss ?y)) + (<- (:employee-job* :employee ?x :job ?y) (:employee :name ?x :position ?pos) + (:can-do-job :position ?pos :job ?y)) + (<- (:employee-job* :employee ?x :job ?y) (:job-replacement :job ?y :can-be-done-by ?z) + (:employee-job* :employee ?x :job ?z)) + (<- (:employee-job* :employee ?x :job ?y) (:can-do-job :job ?y) + (:employee :name ?x :position ?z) + (if = ?z :boss)) + (<- (:employee-job :employee ?x :job ?y) (:employee-job* :employee ?x :job ?y) + (:employee :id ?id :name ?x) + (not! :job-exceptions :id ?id :job ?y)) + (<- (:bj :name ?x :boss ?y) (:works-for :employee ?x :boss ?y) + (not! :employee-job :employee ?y :job :pc-support)))) + + +(def ws-1 (build-soft-strat-work-plan rules (?- :works-for :employee '??name :boss ?x))) +(defn evaluate-1 [name] (set (evaluate-soft-work-set ws-1 db {'??name name}))) + +(deftest test-ws-1 + (is (= (evaluate-1 "Albert") + #{{:employee "Albert", :boss "Li"} + {:employee "Albert", :boss "Sameer"} + {:employee "Albert", :boss "Bob"}})) + (is (empty? (evaluate-1 "Bob"))) + (is (= (evaluate-1 "John") + #{{:employee "John", :boss "Bob"} + {:employee "John", :boss "Mary"}}))) + + +(def ws-2 (build-soft-strat-work-plan rules (?- :employee-job :employee '??name :job ?x))) +(defn evaluate-2 [name] (set (evaluate-soft-work-set ws-2 db {'??name name}))) + +(deftest test-ws-2 + (is (= (evaluate-2 "Albert") + #{{:employee "Albert", :job :pc-support} + {:employee "Albert", :job :server-support}})) + (is (= (evaluate-2 "Sameer") + #{{:employee "Sameer", :job :programming}})) + (is (= (evaluate-2 "Bob") + #{{:employee "Bob", :job :accounting} + {:employee "Bob", :job :management} + {:employee "Bob", :job :payroll} + {:employee "Bob", :job :pc-support} + {:employee "Bob", :job :project-management} + {:employee "Bob", :job :programming} + {:employee "Bob", :job :server-support} + {:employee "Bob", :job :sales}}))) + +(def ws-3 (build-soft-strat-work-plan rules (?- :bj :name '??name :boss ?x))) +(defn evaluate-3 [name] (set (evaluate-soft-work-set ws-3 db {'??name name}))) + +(deftest test-ws-3 + (is (= (evaluate-3 "Albert") + #{{:name "Albert", :boss "Sameer"}}))) + +(def ws-4 (build-soft-strat-work-plan rules (?- :works-for :name ?x :boss ?x))) + +(deftest test-ws-4 + (is (= (set (evaluate-soft-work-set ws-4 db {})) + #{{:employee "Miki", :boss "Bob"} + {:employee "Albert", :boss "Li"} + {:employee "Lilian", :boss "Sameer"} + {:employee "Li", :boss "Bob"} + {:employee "Lilian", :boss "Bob"} + {:employee "Brenda", :boss "Fred"} + {:employee "Fred", :boss "Bob"} + {:employee "John", :boss "Bob"} + {:employee "John", :boss "Mary"} + {:employee "Albert", :boss "Sameer"} + {:employee "Sameer", :boss "Bob"} + {:employee "Albert", :boss "Bob"} + {:employee "Brenda", :boss "Bob"} + {:employee "Mary", :boss "Bob"} + {:employee "Li", :boss "Sameer"}}))) + +(comment + (run-tests) +) + +;; End of file diff --git a/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test_util.clj b/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test_util.clj new file mode 100644 index 00000000..9a5d0460 --- /dev/null +++ b/modules/datalog/src/test/clojure/clojure/contrib/datalog/tests/test_util.clj @@ -0,0 +1,69 @@ +;; 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-util.clj +;; +;; A Clojure implementation of Datalog -- Utilities Tests +;; +;; straszheimjeffrey (gmail) +;; Created 11 Feburary 2009 + +(ns clojure.contrib.datalog.tests.test-util + (:use clojure.test + clojure.contrib.datalog.util) + (:use [clojure.contrib.except :only (throwf)])) + +(deftest test-is-var? + (is (is-var? '?x)) + (is (is-var? '?)) + (is (not (is-var? '??x))) + (is (not (is-var? '??))) + (is (not (is-var? 'x))) + (is (not (is-var? "fred"))) + (is (not (is-var? :q)))) + +(deftest test-map-values + (let [map {:fred 1 :sally 2}] + (is (= (map-values #(* 2 %) map) {:fred 2 :sally 4})) + (is (= (map-values identity {}) {})))) + +(deftest test-keys-to-vals + (let [map {:fred 1 :sally 2 :joey 3}] + (is (= (set (keys-to-vals map [:fred :sally])) #{1 2})) + (is (= (set (keys-to-vals map [:fred :sally :becky])) #{1 2})) + (is (empty? (keys-to-vals map []))) + (is (empty? (keys-to-vals {} [:fred]))))) + +(deftest test-reverse-map + (let [map {:fred 1 :sally 2 :joey 3} + map-1 (assoc map :mary 3)] + (is (= (reverse-map map) {1 :fred 2 :sally 3 :joey})) + (is (or (= (reverse-map map-1) {1 :fred 2 :sally 3 :joey}) + (= (reverse-map map-1) {1 :fred 2 :sally 3 :mary}))))) + +(def some-maps + [ + { :a 1 :b 2 } + { :c 3 :b 3 } + { :d 4 :a 1 } + { :g 4 :b 4 } + { :a 2 :b 1 } + { :e 1 :f 1 } + ]) + +(def reduced (preduce + some-maps)) +(def merged (apply merge-with + some-maps)) + +(deftest test-preduce + (is (= reduced merged))) + +(comment + (run-tests) +) + +; End of file diff --git a/modules/def/src/test/clojure/clojure/contrib/test_def.clj b/modules/def/src/test/clojure/clojure/contrib/test_def.clj new file mode 100644 index 00000000..2e8af137 --- /dev/null +++ b/modules/def/src/test/clojure/clojure/contrib/test_def.clj @@ -0,0 +1,27 @@ +;; Tests for def.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-def + (:use clojure.test) + (:require [clojure.contrib.def :as d])) + +(defn sample-fn "sample-fn docstring" []) +(d/defalias aliased-fn sample-fn) +(defmacro sample-macro "sample-macro-docstring" []) +(d/defalias aliased-macro sample-macro) + +(deftest defalias-preserves-metadata + (let [preserved-meta #(-> % (meta) (select-keys [:doc :arglists :ns :file :macro]))] + (are [x y] (= (preserved-meta (var x)) (preserved-meta (var y))) + aliased-fn sample-fn + aliased-macro sample-macro))) + diff --git a/modules/fnmap/src/test/clojure/clojure/contrib/test_fnmap.clj b/modules/fnmap/src/test/clojure/clojure/contrib/test_fnmap.clj new file mode 100644 index 00000000..04edc1e7 --- /dev/null +++ b/modules/fnmap/src/test/clojure/clojure/contrib/test_fnmap.clj @@ -0,0 +1,39 @@ +(ns clojure.contrib.test-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/modules/graph/src/test/clojure/clojure/contrib/test_graph.clj b/modules/graph/src/test/clojure/clojure/contrib/test_graph.clj new file mode 100644 index 00000000..c27df8bf --- /dev/null +++ b/modules/graph/src/test/clojure/clojure/contrib/test_graph.clj @@ -0,0 +1,187 @@ +;; 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-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/modules/greatest-least/src/test/clojure/clojure/contrib/test_greatest_least.clj b/modules/greatest-least/src/test/clojure/clojure/contrib/test_greatest_least.clj new file mode 100644 index 00000000..20cda34d --- /dev/null +++ b/modules/greatest-least/src/test/clojure/clojure/contrib/test_greatest_least.clj @@ -0,0 +1,65 @@ +(ns clojure.contrib.test-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/modules/io/src/test/clojure/clojure/contrib/test_io.clj b/modules/io/src/test/clojure/clojure/contrib/test_io.clj new file mode 100644 index 00000000..807fc394 --- /dev/null +++ b/modules/io/src/test/clojure/clojure/contrib/test_io.clj @@ -0,0 +1,96 @@ +(ns clojure.contrib.test-io + (:refer-clojure :exclude (spit)) + (:use clojure.test clojure.contrib.io) + (:import (java.io File FileInputStream BufferedInputStream) + (java.net URL URI))) + +(deftest file-str-backslash + (is (= (java.io.File. + (str "C:" java.io.File/separator + "Documents" java.io.File/separator + "file.txt")) + (file-str "C:\\Documents\\file.txt")))) + +(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-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)))) + +(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 (str File/separator "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. (str File/separator "quux"))))))) + +(defn stream-should-have [stream expected-bytes msg] + (let [actual-bytes (byte-array (alength expected-bytes))] + (.read stream actual-bytes) + (is (= -1 (.read stream)) (str msg " : should be end of stream")) + (is (= (seq expected-bytes) (seq actual-bytes)) (str msg " : byte arrays should match")))) + +(deftest test-input-stream + (let [file (File/createTempFile "test-input-stream" "txt") + bytes (.getBytes "foobar")] + (spit file "foobar") + (doseq [[expr msg] + [[file File] + [(FileInputStream. file) FileInputStream] + [(BufferedInputStream. (FileInputStream. file)) BufferedInputStream] + [(.. file toURI) URI] + [(.. file toURI toURL) URL] + [(.. file toURI toURL toString) "URL as String"] + [(.. file toString) "File as String"]]] + (with-open [s (input-stream expr)] + (stream-should-have s bytes msg))))) + +(deftest test-streams-buffering + (let [data (.getBytes "")] + (is (instance? java.io.BufferedReader (reader data))) + (is (instance? java.io.BufferedWriter (writer (java.io.ByteArrayOutputStream.)))) + (is (instance? java.io.BufferedInputStream (input-stream data))) + (is (instance? java.io.BufferedOutputStream (output-stream (java.io.ByteArrayOutputStream.)))))) + +(deftest test-streams-defaults + (let [f (File/createTempFile "clojure.contrib" "test-reader-writer") + content "test\u2099ing"] + (try + (is (thrown? Exception (reader (Object.)))) + (is (thrown? Exception (writer (Object.)))) + + (are [write-to read-from] (= content (do + (spit write-to content) + (slurp* (or read-from write-to)))) + f nil + (.getAbsolutePath f) nil + (.toURL f) nil + (.toURI f) nil + (java.io.FileOutputStream. f) f + (java.io.OutputStreamWriter. (java.io.FileOutputStream. f) "UTF-8") f + f (java.io.FileInputStream. f) + f (java.io.InputStreamReader. (java.io.FileInputStream. f) "UTF-8")) + + (is (= content (slurp* (.getBytes content "UTF-8")))) + (is (= content (slurp* (.toCharArray content)))) + (finally + (.delete f))))) diff --git a/modules/jmx/src/test/clojure/clojure/contrib/test_jmx.clj b/modules/jmx/src/test/clojure/clojure/contrib/test_jmx.clj new file mode 100644 index 00000000..7420316a --- /dev/null +++ b/modules/jmx/src/test/clojure/clojure/contrib/test_jmx.clj @@ -0,0 +1,178 @@ +;; 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-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))) + +(defn seq-contains-all? + "Does container contain every item in containee? + Not fast. Testing use only" + [container containee] + (let [container (set container)] + (every? #(contains? container %) containee))) + +(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")))) + +; These actual beans may differ on different JVM platforms. +; Tested April 2010 to work on Sun and IBM JDKs. +(deftest testing-actual-beans + (testing "reflecting on capabilities" + (are [attr-list mbean-name] + (seq-contains-all? (jmx/attribute-names mbean-name) attr-list) + [:Verbose :ObjectPendingFinalizationCount :HeapMemoryUsage :NonHeapMemoryUsage] "java.lang:type=Memory") + (are [op-list mbean-name] + (seq-contains-all? (jmx/operation-names mbean-name) op-list) + [:gc] "java.lang:type=Memory")) + (testing "mbean-from-oname" + (are [key-names oname] + (seq-contains-all? (keys (jmx/mbean oname)) key-names) + [:Verbose :ObjectPendingFinalizationCount :HeapMemoryUsage :NonHeapMemoryUsage] "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) + Number (jmx/raw-read mem :ObjectPendingFinalizationCount))))) + +(deftest reading-attributes + (testing "simple scalar attributes" + (are [type attr] (instance? type attr) + Number (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 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 "*:*")] + (is (map? (jmx/mbean mb)) 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})))) + (testing "creates custom jndi path" + (is (= "service:jmx:rmi:///jndi/rmi://example.com:4000/jmxconnector" + (jmx/jmx-url {:host "example.com" :port 4000 :jndi-path "jmxconnector"}))))) + +;; ---------------------------------------------------------------------- +;; 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)) +; "long" 10 + "boolean" false + "java.lang.String" "foo" + "long" (Long/valueOf (long 10)))) diff --git a/modules/json/src/test/clojure/clojure/contrib/test_json.clj b/modules/json/src/test/clojure/clojure/contrib/test_json.clj new file mode 100644 index 00000000..e62df3a8 --- /dev/null +++ b/modules/json/src/test/clojure/clojure/contrib/test_json.clj @@ -0,0 +1,186 @@ +(ns clojure.contrib.test-json + (:use clojure.test clojure.contrib.json)) + +(deftest can-read-from-pushback-reader + (let [s (java.io.PushbackReader. (java.io.StringReader. "42"))] + (is (= 42 (read-json s))))) + +(deftest can-read-from-reader + (let [s (java.io.StringReader. "42")] + (is (= 42 (read-json s))))) + +(deftest can-read-numbers + (is (= 42 (read-json "42"))) + (is (= -3 (read-json "-3"))) + (is (= 3.14159 (read-json "3.14159"))) + (is (= 6.022e23 (read-json "6.022e23")))) + +(deftest can-read-null + (is (= nil (read-json "null")))) + +(deftest can-read-strings + (is (= "Hello, World!" (read-json "\"Hello, World!\"")))) + +(deftest handles-escaped-slashes-in-strings + (is (= "/foo/bar" (read-json "\"\\/foo\\/bar\"")))) + +(deftest handles-unicode-escapes + (is (= " \u0beb " (read-json "\" \\u0bEb \"")))) + +(deftest handles-escaped-whitespace + (is (= "foo\nbar" (read-json "\"foo\\nbar\""))) + (is (= "foo\rbar" (read-json "\"foo\\rbar\""))) + (is (= "foo\tbar" (read-json "\"foo\\tbar\"")))) + +(deftest can-read-booleans + (is (= true (read-json "true"))) + (is (= false (read-json "false")))) + +(deftest can-ignore-whitespace + (is (= nil (read-json "\r\n null")))) + +(deftest can-read-arrays + (is (= [1 2 3] (read-json "[1,2,3]"))) + (is (= ["Ole" "Lena"] (read-json "[\"Ole\", \r\n \"Lena\"]")))) + +(deftest can-read-objects + (is (= {:a 1, :b 2} (read-json "{\"a\": 1, \"b\": 2}")))) + +(deftest can-read-nested-structures + (is (= {:a [1 2 {:b [3 "four"]} 5.5]} + (read-json "{\"a\":[1,2,{\"b\":[3,\"four\"]},5.5]}")))) + +(deftest disallows-non-string-keys + (is (thrown? Exception (read-json "{26:\"z\"")))) + +(deftest disallows-barewords + (is (thrown? Exception (read-json " foo ")))) + +(deftest disallows-unclosed-arrays + (is (thrown? Exception (read-json "[1, 2, ")))) + +(deftest disallows-unclosed-objects + (is (thrown? Exception (read-json "{\"a\":1, ")))) + +(deftest can-get-string-keys + (is (= {"a" [1 2 {"b" [3 "four"]} 5.5]} + (read-json "{\"a\":[1,2,{\"b\":[3,\"four\"]},5.5]}" false true nil)))) + +(declare *pass1-string*) + +(deftest pass1-test + (let [input (read-json *pass1-string* false true nil)] + (is (= "JSON Test Pattern pass1" (first input))) + (is (= "array with 1 element" (get-in input [1 "object with 1 member" 0]))) + (is (= 1234567890 (get-in input [8 "integer"]))) + (is (= "rosebud" (last input))))) + +; from http://www.json.org/JSON_checker/test/pass1.json +(def *pass1-string* + "[ + \"JSON Test Pattern pass1\", + {\"object with 1 member\":[\"array with 1 element\"]}, + {}, + [], + -42, + true, + false, + null, + { + \"integer\": 1234567890, + \"real\": -9876.543210, + \"e\": 0.123456789e-12, + \"E\": 1.234567890E+34, + \"\": 23456789012E66, + \"zero\": 0, + \"one\": 1, + \"space\": \" \", + \"quote\": \"\\\"\", + \"backslash\": \"\\\\\", + \"controls\": \"\\b\\f\\n\\r\\t\", + \"slash\": \"/ & \\/\", + \"alpha\": \"abcdefghijklmnopqrstuvwyz\", + \"ALPHA\": \"ABCDEFGHIJKLMNOPQRSTUVWYZ\", + \"digit\": \"0123456789\", + \"0123456789\": \"digit\", + \"special\": \"`1~!@#$%^&*()_+-={':[,]}|;.</>?\", + \"hex\": \"\\u0123\\u4567\\u89AB\\uCDEF\\uabcd\\uef4A\", + \"true\": true, + \"false\": false, + \"null\": null, + \"array\":[ ], + \"object\":{ }, + \"address\": \"50 St. James Street\", + \"url\": \"http://www.JSON.org/\", + \"comment\": \"// /* <!-- --\", + \"# -- --> */\": \" \", + \" s p a c e d \" :[1,2 , 3 + +, + +4 , 5 , 6 ,7 ],\"compact\":[1,2,3,4,5,6,7], + \"jsontext\": \"{\\\"object with 1 member\\\":[\\\"array with 1 element\\\"]}\", + \"quotes\": \"" \\u0022 %22 0x22 034 "\", + \"\\/\\\\\\\"\\uCAFE\\uBABE\\uAB98\\uFCDE\\ubcda\\uef4A\\b\\f\\n\\r\\t`1~!@#$%^&*()_+-=[]{}|;:',./<>?\" +: \"A key can be any string\" + }, + 0.5 ,98.6 +, +99.44 +, + +1066, +1e1, +0.1e1, +1e-1, +1e00,2e+00,2e-00 +,\"rosebud\"]") + + +(deftest can-print-json-strings + (is (= "\"Hello, World!\"" (json-str "Hello, World!"))) + (is (= "\"\\\"Embedded\\\" Quotes\"" (json-str "\"Embedded\" Quotes")))) + +(deftest can-print-unicode + (is (= "\"\\u1234\\u4567\"" (json-str "\u1234\u4567")))) + +(deftest can-print-json-null + (is (= "null" (json-str nil)))) + +(deftest can-print-json-arrays + (is (= "[1,2,3]" (json-str [1 2 3]))) + (is (= "[1,2,3]" (json-str (list 1 2 3)))) + (is (= "[1,2,3]" (json-str (sorted-set 1 2 3)))) + (is (= "[1,2,3]" (json-str (seq [1 2 3]))))) + +(deftest can-print-java-arrays + (is (= "[1,2,3]" (json-str (into-array [1 2 3]))))) + +(deftest can-print-empty-arrays + (is (= "[]" (json-str []))) + (is (= "[]" (json-str (list)))) + (is (= "[]" (json-str #{})))) + +(deftest can-print-json-objects + (is (= "{\"a\":1,\"b\":2}" (json-str (sorted-map :a 1 :b 2))))) + +(deftest object-keys-must-be-strings + (is (= "{\"1\":1,\"2\":2") (json-str (sorted-map 1 1 2 2)))) + +(deftest can-print-empty-objects + (is (= "{}" (json-str {})))) + +(deftest accept-sequence-of-nils + (is (= "[null,null,null]" (json-str [nil nil nil])))) + +(deftest error-on-nil-keys + (is (thrown? Exception (json-str {nil 1})))) + +(deftest characters-in-symbols-are-escaped + (is (= "\"foo\\u1b1b\"" (json-str (symbol "foo\u1b1b"))))) + +;;; Pretty-printer + +(deftest pretty-printing + (let [x (read-json *pass1-string* false)] + (is (= x (read-json (with-out-str (pprint-json x)) false))))) diff --git a/modules/lazy-seqs/src/test/clojure/clojure/contrib/test_lazy_seqs.clj b/modules/lazy-seqs/src/test/clojure/clojure/contrib/test_lazy_seqs.clj new file mode 100644 index 00000000..ecbe46ae --- /dev/null +++ b/modules/lazy-seqs/src/test/clojure/clojure/contrib/test_lazy_seqs.clj @@ -0,0 +1,21 @@ +(ns clojure.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/modules/load-all/src/test/clojure/clojure/contrib/test_load_all.clj b/modules/load-all/src/test/clojure/clojure/contrib/test_load_all.clj new file mode 100644 index 00000000..15bcc4f1 --- /dev/null +++ b/modules/load-all/src/test/clojure/clojure/contrib/test_load_all.clj @@ -0,0 +1,53 @@ +;;; test_load_all.clj - loads all contrib libraries for testing purposes + +;; by Stuart Halloway, http://blog.thinkrelevance.com + +;; 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. + +;; This is only intended to check that the libraries will load without +;; errors, not that they work correctly. + +;; The code includes several design choices I don't love, but find +;; tolerable in a test-only lib: +;; +;; * namespaces that blow up to document deprecation +;; * using directory paths to find contrib +;; * using a macro to reflectively write tests +;; +;; I *am* happy that code that won't even load now breaks the build. + +(ns clojure.contrib.test-load-all + (:use clojure.test clojure.contrib.find-namespaces)) + +(def deprecated-contrib-namespaces + '[clojure.contrib.javadoc]) + +(defn loadable-contrib-namespaces + "Contrib namespaces that can be loaded (everything except + deprecated nses that throw on load.)" + [] + (apply disj + (into #{} (find-namespaces-in-dir (java.io.File. "src/main"))) + deprecated-contrib-namespaces)) + +(defn emit-test-load + [] + `(do + ~@(map + (fn [ns] + `(deftest ~(symbol (str "test-loading-" (.replace (str ns) "." "-"))) + (require :reload '~ns))) + (loadable-contrib-namespaces)))) + +(defmacro test-load + [] + (emit-test-load)) + +(test-load) + diff --git a/modules/macro-utils/src/test/clojure/clojure/contrib/test_macro_utils.clj b/modules/macro-utils/src/test/clojure/clojure/contrib/test_macro_utils.clj new file mode 100644 index 00000000..8b603a67 --- /dev/null +++ b/modules/macro-utils/src/test/clojure/clojure/contrib/test_macro_utils.clj @@ -0,0 +1,67 @@ +;; 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-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-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/modules/math/src/test/clojure/clojure/contrib/test_math.clj b/modules/math/src/test/clojure/clojure/contrib/test_math.clj new file mode 100644 index 00000000..4b58d807 --- /dev/null +++ b/modules/math/src/test/clojure/clojure/contrib/test_math.clj @@ -0,0 +1,118 @@ +(ns clojure.contrib.test-math
+ (:use clojure.test
+ clojure.contrib.math))
+
+(deftest test-expt
+ (are [x y] (= x y) + (expt 2 3) 8
+ (expt (expt 2 16) 2) (expt 2 32)
+ (expt 4/3 2) 16/9
+ (expt 2 -10) 1/1024
+ (expt 0.5M 2) 0.25M
+ (expt 5 4.2) (Math/pow 5 4.2)
+ (expt 5.3 4) (Math/pow 5.3 4)))
+
+(deftest test-abs
+ (are [x y] (= x y) + (abs -2) 2
+ (abs 0) 0
+ (abs 5) 5
+ (abs 123456789123456789) 123456789123456789
+ (abs -123456789123456789) 123456789123456789
+ (abs 5/3) 5/3
+ (abs -4/3) 4/3
+ (abs 4.3M) 4.3M
+ (abs -4.3M) 4.3M
+ (abs 2.8) 2.8
+ (abs -2.8) 2.8))
+
+(deftest test-gcd
+ (are [x y] (= x y) + (gcd 4 3) 1
+ (gcd 24 12) 12
+ (gcd 24 27) 3
+ (gcd 1 0) 1
+ (gcd 0 1) 1
+ (gcd 0 0) 0)
+ (is (thrown? IllegalArgumentException (gcd nil 0)))
+ (is (thrown? IllegalArgumentException (gcd 0 nil)))
+ (is (thrown? IllegalArgumentException (gcd 7.0 0))))
+
+(deftest test-lcm
+ (are [x y] (= x y) + (lcm 2 3) 6
+ (lcm 3 2) 6
+ (lcm -2 3) 6
+ (lcm 2 -3) 6
+ (lcm -2 -3) 6
+ (lcm 4 10) 20
+ (lcm 1 0) 0
+ (lcm 0 1) 0
+ (lcm 0 0))
+ (is (thrown? IllegalArgumentException (lcm nil 0)))
+ (is (thrown? IllegalArgumentException (lcm 0 nil)))
+ (is (thrown? IllegalArgumentException (lcm 7.0 0))))
+
+(deftest test-floor
+ (are [x y] (== x y) + (floor 6) 6
+ (floor -6) -6
+ (floor 123456789123456789) 123456789123456789
+ (floor -123456789123456789) -123456789123456789
+ (floor 4/3) 1
+ (floor -4/3) -2
+ (floor 4.3M) 4
+ (floor -4.3M) -5
+ (floor 4.3) 4.0
+ (floor -4.3) -5.0))
+
+(deftest test-ceil
+ (are [x y] (== x y) + (ceil 6) 6
+ (ceil -6) -6
+ (ceil 123456789123456789) 123456789123456789
+ (ceil -123456789123456789) -123456789123456789
+ (ceil 4/3) 2
+ (ceil -4/3) -1
+ (ceil 4.3M) 5
+ (ceil -4.3M) -4
+ (ceil 4.3) 5.0
+ (ceil -4.3) -4.0))
+
+(deftest test-round
+ (are [x y] (== x y) + (round 6) 6
+ (round -6) -6
+ (round 123456789123456789) 123456789123456789
+ (round -123456789123456789) -123456789123456789
+ (round 4/3) 1
+ (round 5/3) 2
+ (round 5/2) 3
+ (round -4/3) -1
+ (round -5/3) -2
+ (round -5/2) -2
+ (round 4.3M) 4
+ (round 4.7M) 5
+ (round -4.3M) -4
+ (round -4.7M) -5
+ (round 4.5M) 5
+ (round -4.5M) -4
+ (round 4.3) 4
+ (round 4.7) 5
+ (round -4.3) -4
+ (round -4.7) -5
+ (round 4.5) 5
+ (round -4.5) -4))
+
+(deftest test-sqrt
+ (are [x y] (= x y) + (sqrt 9) 3
+ (sqrt 16/9) 4/3
+ (sqrt 0.25M) 0.5M
+ (sqrt 2) (Math/sqrt 2)))
+
+(deftest test-exact-integer-sqrt
+ (are [x y] (= x y) + (exact-integer-sqrt 15) [3 6]
+ (exact-integer-sqrt (inc (expt 2 32))) [(expt 2 16) 1]
+ (exact-integer-sqrt 1000000000000) [1000000 0]))
diff --git a/modules/miglayout/src/test/clojure/clojure/contrib/test_miglayout.clj b/modules/miglayout/src/test/clojure/clojure/contrib/test_miglayout.clj new file mode 100644 index 00000000..0ec32167 --- /dev/null +++ b/modules/miglayout/src/test/clojure/clojure/contrib/test_miglayout.clj @@ -0,0 +1,145 @@ +;; Copyright (c) Stephen C. Gilardi. 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. +;; +;; clojure.contrib.miglayout.test +;; +;; Test/example for clojure.contrib.miglayout +;; +;; scgilardi (gmail) +;; Created 5 October 2008 + +(ns clojure.contrib.test-miglayout + (:import (javax.swing JButton JFrame JLabel JList JPanel + JScrollPane JTabbedPane JTextField JSeparator)) + (:use clojure.contrib.miglayout)) + +(def tests) + +(defn run-test + [index] + (let [panel ((tests index) (JPanel.))] + (println index (components panel)) + (doto (JFrame. (format "MigLayout Test %d" index)) + (.add panel) + (.pack) + (.setVisible true)))) + +(defn label + "Returns a swing label" + [text] + (JLabel. text)) + +(defn text-field + "Returns a swing text field" + ([] (text-field 10)) + ([width] + (JTextField. width))) + +(defn sep + "Returns a swing separator" + [] + (JSeparator.)) + +(def tests [ + + (fn test0 + [panel] + (miglayout panel + (label "Hello") + (label "World") {:gap :unrelated} + (text-field) :wrap + (label "Bonus!") + (JButton. "Bang it") {:wmin :button :grow :x :span 2} :center)) + + ;; test1 and test2 are based on code from + ;; http://www.devx.com/java/Article/38017/1954 + + ;; constraints as strings exclusively + (fn test1 + [panel] + (miglayout panel + :column "[right]" + (label "General") "split, span" + (sep) "growx, wrap" + (label "Company") "gap 10" + (text-field "") "span, growx" + (label "Contact") "gap 10" + (text-field "") "span, growx, wrap" + (label "Propeller") "split, span, gaptop 10" + (sep) "growx, wrap, gaptop 10" + (label "PTI/kW") "gapx 10, gapy 15" + (text-field) + (label "Power/kW") "gap 10" + (text-field) "wrap" + (label "R/mm") "gap 10" + (text-field) + (label "D/mm") "gap 10" + (text-field))) + + ;; the same constraints as strings, keywords, vectors, and maps + (fn test2 + [panel] + (miglayout panel + :column "[right]" + (label "General") "split, span" + (sep) :growx :wrap + (label "Company") [:gap 10] + (text-field "") :span :growx + (label "Contact") [:gap 10] + (text-field "") :span :growx :wrap + (label "Propeller") :split :span [:gaptop 10] + (sep) :growx :wrap [:gaptop 10] + (label "PTI/kW") {:gapx 10 :gapy 15} + (text-field) + (label "Power/kW") [:gap 10] + (text-field) :wrap + (label "R/mm") [:gap 10] + (text-field) + (label "D/mm") [:gap 10] + (text-field))) + + ;; the same constraints using symbols to name groups of constraints + (fn test3 + [panel] + (let [g [:gap 10] + gt [:gaptop 10] + gxs #{:growx :span} + gxw #{:growx :wrap} + gxy {:gapx 10 :gapy 15} + right "[right]" + ss #{:split :span} + w :wrap] + (miglayout panel + :column right + (label "General") ss + (sep) gxw + (label "Company") g + (text-field "") gxs + (label "Contact") g + (text-field "") gxs + (label "Propeller") ss gt + (sep) gxw g + (label "PTI/kW") gxy + (text-field) + (label "Power/kW") g + (text-field) w + (label "R/mm") g + (text-field) + (label "D/mm") g + (text-field)))) + + (fn test4 + [panel] + (miglayout panel + (label "First Name") + (text-field) {:id :firstname} + (label "Surname") [:gap :unrelated] + (text-field) {:id :surname} :wrap + (label "Address") + (text-field) {:id :address} :span :grow)) +]) diff --git a/modules/mock-test-adapter/pom.xml b/modules/mock-test-adapter/pom.xml deleted file mode 100644 index 3acd6504..00000000 --- a/modules/mock-test-adapter/pom.xml +++ /dev/null @@ -1,26 +0,0 @@ -<?xml version="1.0" encoding="UTF-8"?> -<project xmlns="http://maven.apache.org/POM/4.0.0" - xmlns:xsi="http//www.w3.org/2001/XMLSchema-instance" - xsi:schemaLocation="http://maven.apache.org/POM/4.0.0 - http://maven.apache.org/maven-v4_0_0.xsd"> - <modelVersion>4.0.0</modelVersion> - <parent> - <groupId>org.clojure.contrib</groupId> - <artifactId>parent</artifactId> - <version>1.3.0-SNAPSHOT</version> - <relativePath>../parent</relativePath> - </parent> - <artifactId>mock-test-adapter</artifactId> - <dependencies> - <dependency> - <groupId>org.clojure.contrib</groupId> - <artifactId>ns-utils</artifactId> - <version>1.3.0-SNAPSHOT</version> - </dependency> - <dependency> - <groupId>org.clojure.contrib</groupId> - <artifactId>mock</artifactId> - <version>1.3.0-SNAPSHOT</version> - </dependency> - </dependencies> -</project>
\ No newline at end of file diff --git a/modules/mock-test-adapter/src/main/clojure/clojure/contrib/mock/test_adapter.clj b/modules/mock-test-adapter/src/main/clojure/clojure/contrib/mock/test_adapter.clj deleted file mode 100644 index 466cb537..00000000 --- a/modules/mock-test-adapter/src/main/clojure/clojure/contrib/mock/test_adapter.clj +++ /dev/null @@ -1,38 +0,0 @@ -;;; test_adapter.clj: clojure.test adapter for mocking/expectation framework for Clojure - -;; by Matt Clark - -;; Copyright (c) Matt Clark, 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). -;; 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.mock.test-adapter - (:require [clojure.contrib.mock :as mock]) - (:use clojure.test - clojure.contrib.ns-utils)) - -(immigrate 'clojure.contrib.mock) - -(defn report-problem - "This function is designed to be used in a binding macro to override -the report-problem function in clojure.contrib.mock. Instead of printing -the error to the console, the error is logged via clojure.test." - {:dynamic true} - [fn-name expected actual msg] - (report {:type :fail, - :message (str msg " Function name: " fn-name), - :expected expected, - :actual actual})) - - -(defmacro expect [& body] - "Use this macro instead of the standard c.c.mock expect macro to have -failures reported through clojure.test." - `(binding [mock/report-problem report-problem] - (mock/expect ~@body))) - - - diff --git a/modules/mock/src/test/clojure/clojure/contrib/mock/test_adapter.clj b/modules/mock/src/test/clojure/clojure/contrib/mock/test_adapter.clj new file mode 100644 index 00000000..5f21ce11 --- /dev/null +++ b/modules/mock/src/test/clojure/clojure/contrib/mock/test_adapter.clj @@ -0,0 +1,18 @@ +(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/modules/mock/src/test/clojure/clojure/contrib/test_mock.clj b/modules/mock/src/test/clojure/clojure/contrib/test_mock.clj new file mode 100644 index 00000000..961de931 --- /dev/null +++ b/modules/mock/src/test/clojure/clojure/contrib/test_mock.clj @@ -0,0 +1,131 @@ +(ns clojure.contrib.test-mock + (: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-mock/fn2 [1])) + (assert-called mock/no-matching-function-signature true + (mock/has-matching-signature? 'clojure.contrib.test-mock/fn3 [1 3])) + (assert-called mock/no-matching-function-signature false + (mock/has-matching-signature? 'clojure.contrib.test-mock/fn3 [1 3 5])) + (assert-called mock/no-matching-function-signature false + (mock/has-matching-signature? 'clojure.contrib.test-mock/fn4 [1 3 5 7 9])) + (assert-called mock/no-matching-function-signature false + (mock/has-matching-signature? 'clojure.contrib.test-mock/fn4 [1 3])) + (assert-called mock/no-matching-function-signature true + (mock/has-matching-signature? 'clojure.contrib.test-mock/fn4 [1])) + (assert-called mock/no-matching-function-signature false + (mock/has-matching-signature? 'clojure.contrib.test-mock/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/modules/monads/src/test/clojure/clojure/contrib/test_monads.clj b/modules/monads/src/test/clojure/clojure/contrib/test_monads.clj new file mode 100644 index 00000000..2ec9c3e9 --- /dev/null +++ b/modules/monads/src/test/clojure/clojure/contrib/test_monads.clj @@ -0,0 +1,78 @@ +;; 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-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/modules/parent/pom.xml b/modules/parent/pom.xml index 4ec4a560..54641957 100644 --- a/modules/parent/pom.xml +++ b/modules/parent/pom.xml @@ -43,7 +43,7 @@ <configuration> <compileDeclaredNamespaceOnly>true</compileDeclaredNamespaceOnly> </configuration> - <!-- <executions> + <executions> <execution> <id>compile-clojure</id> <phase>compile</phase> @@ -58,7 +58,7 @@ <goal>test</goal> </goals> </execution> - </executions> --> + </executions> </plugin> </plugins> </build> diff --git a/modules/pprint/src/test/clojure/clojure/contrib/pprint/test_cl_format.clj b/modules/pprint/src/test/clojure/clojure/contrib/pprint/test_cl_format.clj new file mode 100644 index 00000000..4022e5e3 --- /dev/null +++ b/modules/pprint/src/test/clojure/clojure/contrib/pprint/test_cl_format.clj @@ -0,0 +1,691 @@ +;;; 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.pprint.test-cl-format + (:refer-clojure :exclude [format]) + (:use [clojure.test :only (deftest are run-tests)] + clojure.contrib.pprint.test-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" + (cl-format nil "~$" 0.099) "0.10" + (cl-format nil "~1$" 0.099) "0.1" + (cl-format nil "~1$" 0.1) "0.1" + (cl-format nil "~1$" 0.99) "1.0" + (cl-format nil "~1$" -0.99) "-1.0") + +(simple-tests f-tests + (cl-format nil "~,1f" -12.0) "-12.0" + (cl-format nil "~,0f" 9.4) "9." + (cl-format nil "~,0f" 9.5) "10." + (cl-format nil "~,0f" -0.99) "-1." + (cl-format nil "~,1f" -0.99) "-1.0" + (cl-format nil "~,2f" -0.99) "-0.99" + (cl-format nil "~,3f" -0.99) "-0.990" + (cl-format nil "~,0f" 0.99) "1." + (cl-format nil "~,1f" 0.99) "1.0" + (cl-format nil "~,2f" 0.99) "0.99" + (cl-format nil "~,3f" 0.99) "0.990" + (cl-format nil "~f" -1) "-1.0" + (cl-format nil "~2f" -1) "-1." + (cl-format nil "~3f" -1) "-1." + (cl-format nil "~4f" -1) "-1.0" + (cl-format nil "~8f" -1) " -1.0" + (cl-format nil "~1,1f" 0.1) ".1") + +(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 (get-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 (:base @@(:base @@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/modules/pprint/src/test/clojure/clojure/contrib/pprint/test_helper.clj b/modules/pprint/src/test/clojure/clojure/contrib/pprint/test_helper.clj new file mode 100644 index 00000000..9a36bbbe --- /dev/null +++ b/modules/pprint/src/test/clojure/clojure/contrib/pprint/test_helper.clj @@ -0,0 +1,21 @@ +;;; 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.pprint.test-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/modules/pprint/src/test/clojure/clojure/contrib/pprint/test_pretty.clj b/modules/pprint/src/test/clojure/clojure/contrib/pprint/test_pretty.clj new file mode 100644 index 00000000..f5de6f1e --- /dev/null +++ b/modules/pprint/src/test/clojure/clojure/contrib/pprint/test_pretty.clj @@ -0,0 +1,127 @@ +;;; 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.pprint.test-pretty + (:use [clojure.test :only (deftest are run-tests)] + clojure.contrib.pprint.test-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/modules/profile/src/test/clojure/clojure/contrib/test_profile.clj b/modules/profile/src/test/clojure/clojure/contrib/test_profile.clj new file mode 100644 index 00000000..560b58db --- /dev/null +++ b/modules/profile/src/test/clojure/clojure/contrib/test_profile.clj @@ -0,0 +1,8 @@ +(ns clojure.contrib.test-profile + (:use clojure.test + clojure.contrib.profile)) + +(deftest test-print-summary + (testing "doesn't blow up with no data (assembla #31)" + (is (= "Name mean min max count sum\n" + (with-out-str (print-summary {})))))) diff --git a/modules/properties/src/test/clojure/clojure/contrib/test_properties.clj b/modules/properties/src/test/clojure/clojure/contrib/test_properties.clj new file mode 100644 index 00000000..65b1371f --- /dev/null +++ b/modules/properties/src/test/clojure/clojure/contrib/test_properties.clj @@ -0,0 +1,63 @@ +(ns clojure.contrib.test-properties + (:refer-clojure :exclude (spit)) + (:use clojure.test clojure.contrib.properties + [clojure.contrib.io :only (spit)]) + (:import (java.util Properties) + (java.io File))) + +(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.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.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.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))))) + diff --git a/modules/prxml/src/test/clojure/clojure/contrib/test_prxml.clj b/modules/prxml/src/test/clojure/clojure/contrib/test_prxml.clj new file mode 100644 index 00000000..53b2b388 --- /dev/null +++ b/modules/prxml/src/test/clojure/clojure/contrib/test_prxml.clj @@ -0,0 +1,10 @@ +(ns clojure.contrib.test-prxml + (:use clojure.test clojure.contrib.prxml)) + +(deftest prxml-basic + (is (= "<p>Hello, World!</p>" + (with-out-str (prxml [:p "Hello, World!"]))))) + +(deftest prxml-escaping + (is (= "<a href=\"foo&bar\">foo<bar</a>" + (with-out-str (prxml [:a {:href "foo&bar"} "foo<bar"]))))) diff --git a/modules/repl-utils/src/test/clojure/clojure/contrib/test_repl_utils.clj b/modules/repl-utils/src/test/clojure/clojure/contrib/test_repl_utils.clj new file mode 100644 index 00000000..6fa12ed7 --- /dev/null +++ b/modules/repl-utils/src/test/clojure/clojure/contrib/test_repl_utils.clj @@ -0,0 +1,20 @@ +(ns clojure.contrib.test-repl-utils + (:use clojure.test + clojure.contrib.repl-utils)) + +(deftest test-apropos + (testing "with a regular expression" + (is (= '[defmacro] (apropos #"^defmacro$"))) + (is (some '#{defmacro} (apropos #"def.acr."))) + (is (= [] (apropos #"nothing-has-this-name")))) + + + (testing "with a string" + (is (some '#{defmacro} (apropos "defmacro"))) + (is (some '#{defmacro} (apropos "efmac"))) + (is (= [] (apropos "nothing-has-this-name")))) + + (testing "with a symbol" + (is (some '#{defmacro} (apropos 'defmacro))) + (is (some '#{defmacro} (apropos 'efmac))) + (is (= [] (apropos 'nothing-has-this-name))))) diff --git a/modules/seq/src/test/clojure/clojure/contrib/test_seq.clj b/modules/seq/src/test/clojure/clojure/contrib/test_seq.clj new file mode 100644 index 00000000..eacd9b73 --- /dev/null +++ b/modules/seq/src/test/clojure/clojure/contrib/test_seq.clj @@ -0,0 +1,128 @@ +(ns clojure.contrib.test-seq + (:use clojure.test) + (:require [clojure.contrib.seq :as seq])) + + +(deftest test-positions + (are [expected pred coll] (= expected (seq/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] (= (seq/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] (= (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))) + +;Note - this does not make sense for maps and sets, because order is expected +(deftest test-indexed + (are [expected test-seq] (= (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 (= (seq/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] (= (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] (= (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 (= (seq/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 (= (seq/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 (= (seq/partition-all 4 [1 2 3 4 5 6 7 8 9]) + [[1 2 3 4] [5 6 7 8] [9]])) + (is (= (seq/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 (seq/shuffle [1 2 3 4])) 4)) + (let [shuffled-seq (seq/shuffle [1 2 3 4])] + (is (every? #{1 2 3 4} shuffled-seq)))) + +;Thanks to Andy Fingerhut for the idea of testing invariants +(deftest test-rand-elt-invariants + (let [elt (seq/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 (= (seq/find-first even? [1 2 3 4 5]) 2)) + (is (= (seq/find-first even? '(1 2 3 4 5)) 2))) + +(deftest test-includes + (are [coll k] (false? (seq/includes? coll k)) + [1 2 3] 0 + [] nil + [:a :b] :c) + (are [coll k] (true? (seq/includes? coll k)) + [1 2 3] 1 + [:a :b] :b)) diff --git a/modules/shell/src/test/clojure/clojure/contrib/test_shell.clj b/modules/shell/src/test/clojure/clojure/contrib/test_shell.clj new file mode 100644 index 00000000..120093e7 --- /dev/null +++ b/modules/shell/src/test/clojure/clojure/contrib/test_shell.clj @@ -0,0 +1,41 @@ +(ns clojure.contrib.test-shell + (:use clojure.test + clojure.contrib.shell) + (:import (java.io File))) + +; workaroung to access private parse-args. Better way? +(def parse-args ((ns-interns 'clojure.contrib.shell) 'parse-args)) +(def as-file ((ns-interns 'clojure.contrib.shell) 'as-file)) +(def as-env-string ((ns-interns 'clojure.contrib.shell) '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/modules/sql/src/test/clojure/clojure/contrib/test_sql.clj b/modules/sql/src/test/clojure/clojure/contrib/test_sql.clj new file mode 100644 index 00000000..62c91ef0 --- /dev/null +++ b/modules/sql/src/test/clojure/clojure/contrib/test_sql.clj @@ -0,0 +1,207 @@ +;; Copyright (c) Stephen C. Gilardi. 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.clj +;; +;; test/example for clojure.contrib.sql +;; +;; scgilardi (gmail) +;; Created 13 September 2008 + +(ns clojure.contrib.test-sql + (:use [clojure.contrib.sql :as sql :only ()])) + +(def db {:classname "org.apache.derby.jdbc.EmbeddedDriver" + :subprotocol "derby" + :subname "/tmp/clojure.contrib.sql.test.db" + :create true}) + +(defn create-fruit + "Create a table" + [] + (sql/create-table + :fruit + [:name "varchar(32)" "PRIMARY KEY"] + [:appearance "varchar(32)"] + [:cost :int] + [:grade :real])) + +(defn drop-fruit + "Drop a table" + [] + (try + (sql/drop-table :fruit) + (catch Exception _))) + +(defn insert-rows-fruit + "Insert complete rows" + [] + (sql/insert-rows + :fruit + ["Apple" "red" 59 87] + ["Banana" "yellow" 29 92.2] + ["Peach" "fuzzy" 139 90.0] + ["Orange" "juicy" 89 88.6])) + +(defn insert-values-fruit + "Insert rows with values for only specific columns" + [] + (sql/insert-values + :fruit + [:name :cost] + ["Mango" 722] + ["Feijoa" 441])) + +(defn insert-records-fruit + "Insert records, maps from keys specifying columns to values" + [] + (sql/insert-records + :fruit + {:name "Pomegranate" :appearance "fresh" :cost 585} + {:name "Kiwifruit" :grade 93})) + +(defn db-write + "Write initial values to the database as a transaction" + [] + (sql/with-connection db + (sql/transaction + (drop-fruit) + (create-fruit) + (insert-rows-fruit) + (insert-values-fruit) + (insert-records-fruit))) + nil) + +(defn db-read + "Read the entire fruit table" + [] + (sql/with-connection db + (sql/with-query-results res + ["SELECT * FROM fruit"] + (doseq [rec res] + (println rec))))) + +(defn db-update-appearance-cost + "Update the appearance and cost of the named fruit" + [name appearance cost] + (sql/update-values + :fruit + ["name=?" name] + {:appearance appearance :cost cost})) + +(defn db-update + "Update two fruits as a transaction" + [] + (sql/with-connection db + (sql/transaction + (db-update-appearance-cost "Banana" "bruised" 14) + (db-update-appearance-cost "Feijoa" "green" 400))) + nil) + +(defn db-update-or-insert + "Updates or inserts a fruit" + [record] + (sql/with-connection db + (sql/update-or-insert-values + :fruit + ["name=?" (:name record)] + record))) + +(defn db-read-all + "Return all the rows of the fruit table as a vector" + [] + (sql/with-connection db + (sql/with-query-results res + ["SELECT * FROM fruit"] + (into [] res)))) + +(defn db-grade-range + "Print rows describing fruit that are within a grade range" + [min max] + (sql/with-connection db + (sql/with-query-results res + [(str "SELECT name, cost, grade " + "FROM fruit " + "WHERE grade >= ? AND grade <= ?") + min max] + (doseq [rec res] + (println rec))))) + +(defn db-grade-a + "Print rows describing all grade a fruit (grade between 90 and 100)" + [] + (db-grade-range 90 100)) + +(defn db-get-tables + "Demonstrate getting table info" + [] + (sql/with-connection db + (into [] + (resultset-seq + (-> (sql/connection) + (.getMetaData) + (.getTables nil nil nil (into-array ["TABLE" "VIEW"]))))))) + +(defn db-exception + "Demonstrate rolling back a partially completed transaction on exception" + [] + (sql/with-connection db + (sql/transaction + (sql/insert-values + :fruit + [:name :appearance] + ["Grape" "yummy"] + ["Pear" "bruised"]) + ;; at this point the insert-values call is complete, but the transaction + ;; is not. the exception will cause it to roll back leaving the database + ;; untouched. + (throw (Exception. "sql/test exception"))))) + +(defn db-sql-exception + "Demonstrate an sql exception" + [] + (sql/with-connection db + (sql/transaction + (sql/insert-values + :fruit + [:name :appearance] + ["Grape" "yummy"] + ["Pear" "bruised"] + ["Apple" "strange" "whoops"])))) + +(defn db-batchupdate-exception + "Demonstrate a batch update exception" + [] + (sql/with-connection db + (sql/transaction + (sql/do-commands + "DROP TABLE fruit" + "DROP TABLE fruit")))) + +(defn db-rollback + "Demonstrate a rollback-only trasaction" + [] + (sql/with-connection db + (sql/transaction + (prn "is-rollback-only" (sql/is-rollback-only)) + (sql/set-rollback-only) + (sql/insert-values + :fruit + [:name :appearance] + ["Grape" "yummy"] + ["Pear" "bruised"]) + (prn "is-rollback-only" (sql/is-rollback-only)) + (sql/with-query-results res + ["SELECT * FROM fruit"] + (doseq [rec res] + (println rec)))) + (prn) + (sql/with-query-results res + ["SELECT * FROM fruit"] + (doseq [rec res] + (println rec))))) diff --git a/modules/string/src/test/clojure/clojure/contrib/test_string.clj b/modules/string/src/test/clojure/clojure/contrib/test_string.clj new file mode 100644 index 00000000..98f03a78 --- /dev/null +++ b/modules/string/src/test/clojure/clojure/contrib/test_string.clj @@ -0,0 +1,124 @@ +(ns clojure.contrib.test-string + (:require [clojure.contrib.string :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 {\a \o, \o \a} "foobar")))) + +(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 3 "foobar"))) + (is (= "foobar" (s/take 7 "foobar"))) + (is (= "" (s/take 0 "foo")))) + +(deftest t-drop + (is (= "bar" (s/drop 3 "foobar"))) + (is (= "" (s/drop 9 "foobar"))) + (is (= "foobar" (s/drop 0 "foobar")))) + +(deftest t-butlast + (is (= "foob" (s/butlast 2 "foobar"))) + (is (= "" (s/butlast 9 "foobar"))) + (is (= "foobar" (s/butlast 0 "foobar")))) + +(deftest t-tail + (is (= "ar" (s/tail 2 "foobar"))) + (is (= "foobar" (s/tail 9 "foobar"))) + (is (= "" (s/tail 0 "foobar")))) + +(deftest t-repeat + (is (= "foofoofoo" (s/repeat 3 "foo")))) + +(deftest t-reverse + (is (= "tab" (s/reverse "bat")))) + +(deftest t-replace + (is (= "faabar" (s/replace-char \o \a "foobar"))) + (is (= "barbarbar" (s/replace-str "foo" "bar" "foobarfoo"))) + (is (= "FOObarFOO" (s/replace-by #"foo" s/upper-case "foobarfoo")))) + +(deftest t-replace-first + (is (= "barbarfoo" (s/replace-first-re #"foo" "bar" "foobarfoo"))) + (is (= "FOObarfoo" (s/replace-first-by #"foo" s/upper-case "foobarfoo")))) + +(deftest t-partition + (is (= (list "" "abc" "123" "def") + (s/partition #"[a-z]+" "abc123def")))) + +(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-substring + (is (s/substring? "foo" "foobar")) + (is (not (s/substring? "baz" "foobar")))) + +(deftest t-get + (is (= \o (s/get "foo" 1)))) + +(deftest t-as-str + (testing "keyword to string" + (is (= "foo") (s/as-str :foo))) + (testing "symbol to string" + (is (= "foo") (s/as-str 'foo))) + (testing "string to string" + (is (= "foo") (s/as-str "foo"))) + (testing "stringifying non-namish things" + (is (= "42") (s/as-str 42)))) diff --git a/modules/strint/src/test/clojure/clojure/contrib/test_strint.clj b/modules/strint/src/test/clojure/clojure/contrib/test_strint.clj new file mode 100644 index 00000000..83ff1f86 --- /dev/null +++ b/modules/strint/src/test/clojure/clojure/contrib/test_strint.clj @@ -0,0 +1,41 @@ +; Copyright (c) Stuart Halloway, 2010-. 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-strint + (:use clojure.test) + (:use [clojure.contrib strint with-ns])) + +(def silent-read (with-ns 'clojure.contrib.strint silent-read)) +(def interpolate (with-ns 'clojure.contrib.strint interpolate)) + +(deftest test-silent-read + (testing "reading a valid form returns [read form, rest of string]" + (is (= [[1] "[2]"] (silent-read "[1][2]")))) + (testing "reading an invalid form returns nil" + (is (= nil (silent-read "["))))) + +(deftest test-interpolate + (testing "a plain old string" + (is (= ["a plain old string"] (interpolate "a plain old string")))) + (testing "some value replacement forms" + (is (= '["" foo " and " bar ""] (interpolate "~{foo} and ~{bar}")))) + (testing "some fn-calling forms" + (is (= '["" (+ 1 2) " and " (vector 3) ""] (interpolate "~(+ 1 2) and ~(vector 3)"))))) + +(deftest test-<< + (testing "docstring examples" + (let [v 30.5 + m {:a [1 2 3]}] + (is (= "This trial required 30.5ml of solution." + (<< "This trial required ~{v}ml of solution."))) + (is (= "There are 30 days in November." + (<< "There are ~(int v) days in November."))) + (is (= "The total for your order is $6." + (<< "The total for your order is $~(->> m :a (apply +)).")))))) diff --git a/modules/trace/src/test/clojure/clojure/contrib/test_trace.clj b/modules/trace/src/test/clojure/clojure/contrib/test_trace.clj new file mode 100644 index 00000000..015fff65 --- /dev/null +++ b/modules/trace/src/test/clojure/clojure/contrib/test_trace.clj @@ -0,0 +1,16 @@ +(ns clojure.contrib.test-trace + (:use clojure.test + clojure.contrib.trace)) + +(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/modules/with-ns/src/test/clojure/clojure/contrib/test_with_ns.clj b/modules/with-ns/src/test/clojure/clojure/contrib/test_with_ns.clj new file mode 100644 index 00000000..8d3ca3c1 --- /dev/null +++ b/modules/with-ns/src/test/clojure/clojure/contrib/test_with_ns.clj @@ -0,0 +1,18 @@ +(ns clojure.contrib.test-with-ns + (:use clojure.test + clojure.contrib.with-ns)) + +(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 (some #{ns-name} (all-ns-names)))))) + (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 (some #{(symbol ns-name-str)} (all-ns-names)))))))) @@ -62,7 +62,6 @@ <module>modules/miglayout</module> <module>modules/mmap</module> <module>modules/mock</module> - <module>modules/mock-test-adapter</module> <module>modules/monadic-io-streams</module> <module>modules/monads</module> <module>modules/ns-utils</module> |