giles
1888c272f9
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
100 lines
2.4 KiB
Plaintext
100 lines
2.4 KiB
Plaintext
;; lib/prolog/tests/clausedb.sx — Clause DB unit tests
|
|
|
|
(define pl-db-test-count 0)
|
|
(define pl-db-test-pass 0)
|
|
(define pl-db-test-fail 0)
|
|
(define pl-db-test-failures (list))
|
|
|
|
(define
|
|
pl-db-test!
|
|
(fn
|
|
(name got expected)
|
|
(begin
|
|
(set! pl-db-test-count (+ pl-db-test-count 1))
|
|
(if
|
|
(= got expected)
|
|
(set! pl-db-test-pass (+ pl-db-test-pass 1))
|
|
(begin
|
|
(set! pl-db-test-fail (+ pl-db-test-fail 1))
|
|
(append!
|
|
pl-db-test-failures
|
|
(str name "\n expected: " expected "\n got: " got)))))))
|
|
|
|
(pl-db-test!
|
|
"head-key atom arity 0"
|
|
(pl-head-key (nth (first (pl-parse "foo.")) 1))
|
|
"foo/0")
|
|
|
|
(pl-db-test!
|
|
"head-key compound arity 2"
|
|
(pl-head-key (nth (first (pl-parse "bar(a, b).")) 1))
|
|
"bar/2")
|
|
|
|
(pl-db-test!
|
|
"clause-key of :- clause"
|
|
(pl-clause-key (first (pl-parse "likes(mary, X) :- friendly(X).")))
|
|
"likes/2")
|
|
|
|
(pl-db-test!
|
|
"empty db lookup returns empty list"
|
|
(len (pl-db-lookup (pl-mk-db) "parent/2"))
|
|
0)
|
|
|
|
(define pl-db-t1 (pl-mk-db))
|
|
(pl-db-load! pl-db-t1 (pl-parse "foo(a). foo(b). foo(c)."))
|
|
|
|
(pl-db-test!
|
|
"three facts same functor"
|
|
(len (pl-db-lookup pl-db-t1 "foo/1"))
|
|
3)
|
|
(pl-db-test!
|
|
"mismatching key returns empty"
|
|
(len (pl-db-lookup pl-db-t1 "foo/2"))
|
|
0)
|
|
|
|
(pl-db-test!
|
|
"first clause has arg a"
|
|
(pl-atom-name
|
|
(first (pl-args (nth (first (pl-db-lookup pl-db-t1 "foo/1")) 1))))
|
|
"a")
|
|
|
|
(pl-db-test!
|
|
"third clause has arg c"
|
|
(pl-atom-name
|
|
(first (pl-args (nth (nth (pl-db-lookup pl-db-t1 "foo/1") 2) 1))))
|
|
"c")
|
|
|
|
(define pl-db-t2 (pl-mk-db))
|
|
(pl-db-load! pl-db-t2 (pl-parse "foo. bar. foo. parent(a, b). parent(c, d)."))
|
|
|
|
(pl-db-test!
|
|
"atom heads keyed as foo/0"
|
|
(len (pl-db-lookup pl-db-t2 "foo/0"))
|
|
2)
|
|
(pl-db-test!
|
|
"atom heads keyed as bar/0"
|
|
(len (pl-db-lookup pl-db-t2 "bar/0"))
|
|
1)
|
|
(pl-db-test!
|
|
"compound heads keyed as parent/2"
|
|
(len (pl-db-lookup pl-db-t2 "parent/2"))
|
|
2)
|
|
|
|
(pl-db-test!
|
|
"lookup-goal extracts functor/arity"
|
|
(len
|
|
(pl-db-lookup-goal pl-db-t2 (nth (first (pl-parse "parent(X, Y).")) 1)))
|
|
2)
|
|
|
|
(pl-db-test!
|
|
"lookup-goal on atom goal"
|
|
(len (pl-db-lookup-goal pl-db-t2 (nth (first (pl-parse "foo.")) 1)))
|
|
2)
|
|
|
|
(pl-db-test!
|
|
"stored clause is clause form"
|
|
(first (first (pl-db-lookup pl-db-t2 "parent/2")))
|
|
"clause")
|
|
|
|
(define pl-clausedb-tests-run! (fn () {:failed pl-db-test-fail :passed pl-db-test-pass :total pl-db-test-count :failures pl-db-test-failures}))
|