giles
09683b8a18
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
117 lines
2.8 KiB
Plaintext
117 lines
2.8 KiB
Plaintext
;; lib/prolog/tests/programs/family.sx — facts + ancestor + sibling relations.
|
|
|
|
(define pl-fa-test-count 0)
|
|
(define pl-fa-test-pass 0)
|
|
(define pl-fa-test-fail 0)
|
|
(define pl-fa-test-failures (list))
|
|
|
|
(define
|
|
pl-fa-test!
|
|
(fn
|
|
(name got expected)
|
|
(begin
|
|
(set! pl-fa-test-count (+ pl-fa-test-count 1))
|
|
(if
|
|
(= got expected)
|
|
(set! pl-fa-test-pass (+ pl-fa-test-pass 1))
|
|
(begin
|
|
(set! pl-fa-test-fail (+ pl-fa-test-fail 1))
|
|
(append!
|
|
pl-fa-test-failures
|
|
(str name "\n expected: " expected "\n got: " got)))))))
|
|
|
|
(define
|
|
pl-fa-goal
|
|
(fn
|
|
(src env)
|
|
(pl-instantiate (nth (first (pl-parse (str "g :- " src "."))) 2) env)))
|
|
|
|
(define
|
|
pl-fa-prog-src
|
|
"parent(tom, bob). parent(tom, liz). parent(bob, ann). parent(bob, pat). parent(pat, jim). male(tom). male(bob). male(jim). male(pat). female(liz). female(ann). father(F, C) :- parent(F, C), male(F). mother(M, C) :- parent(M, C), female(M). ancestor(X, Y) :- parent(X, Y). ancestor(X, Y) :- parent(X, Z), ancestor(Z, Y). sibling(X, Y) :- parent(P, X), parent(P, Y), \\=(X, Y).")
|
|
|
|
(define pl-fa-db (pl-mk-db))
|
|
(pl-db-load! pl-fa-db (pl-parse pl-fa-prog-src))
|
|
|
|
(pl-fa-test!
|
|
"parent(tom, bob) is a fact"
|
|
(pl-solve-once!
|
|
pl-fa-db
|
|
(pl-fa-goal "parent(tom, bob)" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
(pl-fa-test!
|
|
"parent(tom, ann) — not a direct parent"
|
|
(pl-solve-once!
|
|
pl-fa-db
|
|
(pl-fa-goal "parent(tom, ann)" {})
|
|
(pl-mk-trail))
|
|
false)
|
|
|
|
(pl-fa-test!
|
|
"5 parent/2 facts in total"
|
|
(pl-solve-count!
|
|
pl-fa-db
|
|
(pl-fa-goal "parent(X, Y)" {})
|
|
(pl-mk-trail))
|
|
5)
|
|
|
|
(pl-fa-test!
|
|
"ancestor(tom, jim) — three-step transitive"
|
|
(pl-solve-once!
|
|
pl-fa-db
|
|
(pl-fa-goal "ancestor(tom, jim)" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
(pl-fa-test!
|
|
"tom has 5 ancestors-of: bob, liz, ann, pat, jim"
|
|
(pl-solve-count!
|
|
pl-fa-db
|
|
(pl-fa-goal "ancestor(tom, X)" {})
|
|
(pl-mk-trail))
|
|
5)
|
|
|
|
(pl-fa-test!
|
|
"father(bob, ann) succeeds"
|
|
(pl-solve-once!
|
|
pl-fa-db
|
|
(pl-fa-goal "father(bob, ann)" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
(pl-fa-test!
|
|
"father(liz, ann) fails (liz is female)"
|
|
(pl-solve-once!
|
|
pl-fa-db
|
|
(pl-fa-goal "father(liz, ann)" {})
|
|
(pl-mk-trail))
|
|
false)
|
|
|
|
(pl-fa-test!
|
|
"mother(liz, X) fails (liz has no children)"
|
|
(pl-solve-once!
|
|
pl-fa-db
|
|
(pl-fa-goal "mother(liz, X)" {})
|
|
(pl-mk-trail))
|
|
false)
|
|
|
|
(pl-fa-test!
|
|
"sibling(ann, pat) succeeds"
|
|
(pl-solve-once!
|
|
pl-fa-db
|
|
(pl-fa-goal "sibling(ann, pat)" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
(pl-fa-test!
|
|
"sibling(ann, ann) fails by \\="
|
|
(pl-solve-once!
|
|
pl-fa-db
|
|
(pl-fa-goal "sibling(ann, ann)" {})
|
|
(pl-mk-trail))
|
|
false)
|
|
|
|
(define pl-family-tests-run! (fn () {:failed pl-fa-test-fail :passed pl-fa-test-pass :total pl-fa-test-count :failures pl-fa-test-failures}))
|