giles
1302f5a3cc
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
92 lines
2.2 KiB
Plaintext
92 lines
2.2 KiB
Plaintext
;; lib/prolog/tests/programs/member.sx — member/2 generator.
|
|
|
|
(define pl-mb-test-count 0)
|
|
(define pl-mb-test-pass 0)
|
|
(define pl-mb-test-fail 0)
|
|
(define pl-mb-test-failures (list))
|
|
|
|
(define
|
|
pl-mb-test!
|
|
(fn
|
|
(name got expected)
|
|
(begin
|
|
(set! pl-mb-test-count (+ pl-mb-test-count 1))
|
|
(if
|
|
(= got expected)
|
|
(set! pl-mb-test-pass (+ pl-mb-test-pass 1))
|
|
(begin
|
|
(set! pl-mb-test-fail (+ pl-mb-test-fail 1))
|
|
(append!
|
|
pl-mb-test-failures
|
|
(str name "\n expected: " expected "\n got: " got)))))))
|
|
|
|
(define
|
|
pl-mb-goal
|
|
(fn
|
|
(src env)
|
|
(pl-instantiate (nth (first (pl-parse (str "g :- " src "."))) 2) env)))
|
|
|
|
(define pl-mb-prog-src "member(X, [X|_]). member(X, [_|T]) :- member(X, T).")
|
|
|
|
(define pl-mb-db (pl-mk-db))
|
|
(pl-db-load! pl-mb-db (pl-parse pl-mb-prog-src))
|
|
|
|
(pl-mb-test!
|
|
"member(2, [1, 2, 3]) succeeds"
|
|
(pl-solve-once!
|
|
pl-mb-db
|
|
(pl-mb-goal "member(2, [1, 2, 3])" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
(pl-mb-test!
|
|
"member(4, [1, 2, 3]) fails"
|
|
(pl-solve-once!
|
|
pl-mb-db
|
|
(pl-mb-goal "member(4, [1, 2, 3])" {})
|
|
(pl-mk-trail))
|
|
false)
|
|
|
|
(pl-mb-test!
|
|
"member(X, []) fails"
|
|
(pl-solve-once!
|
|
pl-mb-db
|
|
(pl-mb-goal "member(X, [])" {})
|
|
(pl-mk-trail))
|
|
false)
|
|
|
|
(pl-mb-test!
|
|
"member(X, [a, b, c]) generates 3 solutions"
|
|
(pl-solve-count!
|
|
pl-mb-db
|
|
(pl-mb-goal "member(X, [a, b, c])" {})
|
|
(pl-mk-trail))
|
|
3)
|
|
|
|
(define pl-mb-env-1 {})
|
|
(define pl-mb-goal-1 (pl-mb-goal "member(X, [11, 22, 33])" pl-mb-env-1))
|
|
(pl-solve-once! pl-mb-db pl-mb-goal-1 (pl-mk-trail))
|
|
|
|
(pl-mb-test!
|
|
"member(X, [11, 22, 33]) first solution X = 11"
|
|
(pl-num-val (pl-walk-deep (dict-get pl-mb-env-1 "X")))
|
|
11)
|
|
|
|
(pl-mb-test!
|
|
"member(2, [1, 2, 3, 2, 1]) matches twice on backtrack"
|
|
(pl-solve-count!
|
|
pl-mb-db
|
|
(pl-mb-goal "member(2, [1, 2, 3, 2, 1])" {})
|
|
(pl-mk-trail))
|
|
2)
|
|
|
|
(pl-mb-test!
|
|
"member with unbound list cell unifies"
|
|
(pl-solve-once!
|
|
pl-mb-db
|
|
(pl-mb-goal "member(a, [X, b, c])" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
(define pl-member-tests-run! (fn () {:failed pl-mb-test-fail :passed pl-mb-test-pass :total pl-mb-test-count :failures pl-mb-test-failures}))
|