Add some tests
They pass. Wow.
author |
Steve Losh <steve@stevelosh.com> |
date |
Sun, 24 Apr 2016 13:55:28 +0000 |
parents |
f3ed7ce70f3b
|
children |
1184d75b21fe
|
branches/tags |
(none) |
files |
bones-test.asd package-test.lisp test/run.lisp test/wam.lisp |
Changes
--- a/bones-test.asd Sun Apr 24 13:52:33 2016 +0000
+++ b/bones-test.asd Sun Apr 24 13:55:28 2016 +0000
@@ -9,5 +9,6 @@
(:module "test"
:serial t
:components ((:file "bones")
- (:file "paip")))))
+ (:file "paip")
+ (:file "wam")))))
--- a/package-test.lisp Sun Apr 24 13:52:33 2016 +0000
+++ b/package-test.lisp Sun Apr 24 13:55:28 2016 +0000
@@ -11,4 +11,19 @@
#:bones.quickutils
#:bones.paip)
; kill me
- (:shadowing-import-from #:5am #:fail))
+ (:shadowing-import-from #:5am
+ #:fail))
+
+(defpackage #:bones-test.wam
+ (:use
+ #:cl
+ #:5am
+ #:bones.quickutils
+ #:bones.wam)
+ (:import-from #:bones.wam
+ #:with-database
+ #:make-database
+ #:rules
+ #:facts
+ #:return-one
+ #:return-all))
--- a/test/run.lisp Sun Apr 24 13:52:33 2016 +0000
+++ b/test/run.lisp Sun Apr 24 13:55:28 2016 +0000
@@ -12,5 +12,6 @@
(test :bones)
(test :bones.paip)
+(test :bones.wam)
(sb-ext:exit :code (if *passed* 0 1))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/test/wam.lisp Sun Apr 24 13:55:28 2016 +0000
@@ -0,0 +1,139 @@
+(in-package #:bones-test.wam)
+
+(def-suite :bones.wam)
+(in-suite :bones.wam)
+
+
+;;;; Setup
+(defun make-test-database ()
+ (let ((db (make-database)))
+ (with-database db
+
+ (facts (always))
+
+ (facts (drinks tom :anything)
+ (drinks kim water)
+ (drinks alice bourbon)
+ (drinks bob genny-cream)
+ (drinks candace birch-beer))
+
+ (facts (listens alice blues)
+ (listens alice jazz)
+ (listens bob blues)
+ (listens bob rock)
+ (listens candace blues))
+
+ (facts (fuzzy cats))
+
+ (facts (cute cats)
+ (cute snakes))
+
+ (rules ((pets alice :what)
+ (cute :what))
+
+ ((pets bob :what)
+ (cute :what)
+ (fuzzy :what))
+
+ ((pets candace :bird)
+ (flies :bird)))
+
+ (rules ((likes sally :who)
+ (likes :who cats)
+ (drinks :who beer))
+
+ ((likes tom cats))
+ ((likes alice cats))
+ ((likes kim cats))
+
+ ((likes kim :who)
+ (likes :who cats))
+
+ )
+
+ (rules ((narcissist :person)
+ (likes :person :person))))
+ db))
+
+(defparameter *test-database* (make-test-database))
+
+
+;;;; Utils
+(defun result= (x y)
+ (set-equal (plist-alist x)
+ (plist-alist y)
+ :test #'equal))
+
+(defun results= (r1 r2)
+ (set-equal r1 r2 :test #'result=))
+
+; (defmacro status (successp query)
+; `(eql )
+; )
+
+(defmacro q (&body query)
+ `(with-database *test-database*
+ (return-all ,@query)))
+
+(defmacro check (query)
+ `(with-database *test-database*
+ (nth-value 1 (return-one ,query))))
+
+
+;;;; Tests
+(test facts-literal
+ (is (results= '(nil) (q (always))))
+ (is (results= '(nil) (q (fuzzy cats))))
+ (is (results= nil (q (fuzzy snakes)))))
+
+(test facts-variables
+ (is (results= '((:what cats))
+ (q (fuzzy :what))))
+ (is (results= '((:what blues)
+ (:what rock))
+ (q (listens bob :what))))
+ (is (results= '((:who alice)
+ (:who bob)
+ (:who candace))
+ (q (listens :who blues))))
+ (is (results= '()
+ (q (listens :who metal)))))
+
+(test facts-conjunctions
+ (is (results= '((:who alice))
+ (q (listens :who blues)
+ (listens :who jazz))))
+ (is (results= '((:who alice))
+ (q (listens :who blues)
+ (drinks :who bourbon))))
+ (is (results= '((:what bourbon :who alice)
+ (:what genny-cream :who bob)
+ (:what birch-beer :who candace))
+ (q (listens :who blues)
+ (drinks :who :what)))))
+
+(test basic-rules
+ (is (results= '((:what snakes)
+ (:what cats))
+ (q (pets alice :what))))
+
+ (is (results= '((:what cats))
+ (q (pets bob :what))))
+
+ (is (results= '()
+ (q (pets candace :what))))
+
+ (is (results= '((:who alice))
+ (q (pets :who snakes))))
+
+ (is (results= '((:who tom)
+ (:who alice)
+ (:who kim)
+ (:who cats))
+ (q (likes kim :who))))
+
+ (is (results= '((:who tom))
+ (q (likes sally :who))))
+
+ (is (results= '((:person kim))
+ (q (narcissist :person)))))