aboutsummaryrefslogtreecommitdiff
path: root/src/test
diff options
context:
space:
mode:
Diffstat (limited to 'src/test')
-rw-r--r--src/test/clojure/clojure/contrib/core/tests.clj36
-rw-r--r--src/test/clojure/clojure/contrib/datalog/tests/test.clj45
-rw-r--r--src/test/clojure/clojure/contrib/datalog/tests/test_database.clj153
-rw-r--r--src/test/clojure/clojure/contrib/datalog/tests/test_literals.clj187
-rw-r--r--src/test/clojure/clojure/contrib/datalog/tests/test_magic.clj72
-rw-r--r--src/test/clojure/clojure/contrib/datalog/tests/test_rules.clj130
-rw-r--r--src/test/clojure/clojure/contrib/datalog/tests/test_softstrat.clj233
-rw-r--r--src/test/clojure/clojure/contrib/datalog/tests/test_util.clj69
-rw-r--r--src/test/clojure/clojure/contrib/math/tests.clj118
-rw-r--r--src/test/clojure/clojure/contrib/miglayout/test.clj145
-rw-r--r--src/test/clojure/clojure/contrib/sql/test.clj207
-rw-r--r--src/test/clojure/clojure/contrib/test_contrib.clj45
-rw-r--r--src/test/clojure/clojure/contrib/test_contrib/complex_numbers.clj313
-rw-r--r--src/test/clojure/clojure/contrib/test_contrib/fnmap.clj39
-rw-r--r--src/test/clojure/clojure/contrib/test_contrib/greatest_least.clj65
-rw-r--r--src/test/clojure/clojure/contrib/test_contrib/java_utils.clj10
-rw-r--r--src/test/clojure/clojure/contrib/test_contrib/macro_utils.clj67
-rw-r--r--src/test/clojure/clojure/contrib/test_contrib/mock_test.clj131
-rw-r--r--src/test/clojure/clojure/contrib/test_contrib/mock_test/test_adapter_test.clj18
-rw-r--r--src/test/clojure/clojure/contrib/test_contrib/monads.clj78
-rw-r--r--src/test/clojure/clojure/contrib/test_contrib/pprint/cl_format.clj670
-rw-r--r--src/test/clojure/clojure/contrib/test_contrib/pprint/helper.clj21
-rw-r--r--src/test/clojure/clojure/contrib/test_contrib/pprint/pretty.clj127
-rw-r--r--src/test/clojure/clojure/contrib/test_contrib/seq_utils_test.clj127
-rw-r--r--src/test/clojure/clojure/contrib/test_contrib/shell_out.clj41
-rw-r--r--src/test/clojure/clojure/contrib/test_contrib/str_utils.clj33
-rw-r--r--src/test/clojure/clojure/contrib/test_contrib/str_utils2.clj119
-rw-r--r--src/test/clojure/clojure/contrib/test_contrib/test_dataflow.clj90
-rw-r--r--src/test/clojure/clojure/contrib/test_contrib/test_graph.clj187
-rw-r--r--src/test/clojure/clojure/contrib/test_contrib/test_java_utils.clj123
-rw-r--r--src/test/clojure/clojure/contrib/test_contrib/test_jmx.clj166
-rw-r--r--src/test/clojure/clojure/contrib/test_contrib/test_lazy_seqs.clj21
-rw-r--r--src/test/clojure/clojure/contrib/test_contrib/test_trace.clj16
-rw-r--r--src/test/clojure/clojure/contrib/test_contrib/walk.clj34
-rw-r--r--src/test/clojure/clojure/contrib/test_contrib/with_ns_test.clj19
35 files changed, 3955 insertions, 0 deletions
diff --git a/src/test/clojure/clojure/contrib/core/tests.clj b/src/test/clojure/clojure/contrib/core/tests.clj
new file mode 100644
index 00000000..d2e0d50d
--- /dev/null
+++ b/src/test/clojure/clojure/contrib/core/tests.clj
@@ -0,0 +1,36 @@
+; 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.core.tests
+ (: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 -?> returns nil if passed nil"
+ (is (nil? (-?> nil .toString)))
+ (is (nil? (-?> "foo" seq next next next .toString))))
+ (testing "Version -?> works well for some basic use cases"
+ (is (= (list \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)))))
+ \ No newline at end of file
diff --git a/src/test/clojure/clojure/contrib/datalog/tests/test.clj b/src/test/clojure/clojure/contrib/datalog/tests/test.clj
new file mode 100644
index 00000000..121d264e
--- /dev/null
+++ b/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/src/test/clojure/clojure/contrib/datalog/tests/test_database.clj b/src/test/clojure/clojure/contrib/datalog/tests/test_database.clj
new file mode 100644
index 00000000..77719008
--- /dev/null
+++ b/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/src/test/clojure/clojure/contrib/datalog/tests/test_literals.clj b/src/test/clojure/clojure/contrib/datalog/tests/test_literals.clj
new file mode 100644
index 00000000..36ee5147
--- /dev/null
+++ b/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/src/test/clojure/clojure/contrib/datalog/tests/test_magic.clj b/src/test/clojure/clojure/contrib/datalog/tests/test_magic.clj
new file mode 100644
index 00000000..7eabae78
--- /dev/null
+++ b/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/src/test/clojure/clojure/contrib/datalog/tests/test_rules.clj b/src/test/clojure/clojure/contrib/datalog/tests/test_rules.clj
new file mode 100644
index 00000000..8b80b770
--- /dev/null
+++ b/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/src/test/clojure/clojure/contrib/datalog/tests/test_softstrat.clj b/src/test/clojure/clojure/contrib/datalog/tests/test_softstrat.clj
new file mode 100644
index 00000000..a33d8c96
--- /dev/null
+++ b/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))
+
+ (<- ({:pr