giles
c6f58116bf
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
148 lines
3.3 KiB
Plaintext
148 lines
3.3 KiB
Plaintext
;; lib/prolog/tests/term_inspect.sx — copy_term/2, functor/3, arg/3.
|
|
|
|
(define pl-tt-test-count 0)
|
|
(define pl-tt-test-pass 0)
|
|
(define pl-tt-test-fail 0)
|
|
(define pl-tt-test-failures (list))
|
|
|
|
(define
|
|
pl-tt-test!
|
|
(fn
|
|
(name got expected)
|
|
(begin
|
|
(set! pl-tt-test-count (+ pl-tt-test-count 1))
|
|
(if
|
|
(= got expected)
|
|
(set! pl-tt-test-pass (+ pl-tt-test-pass 1))
|
|
(begin
|
|
(set! pl-tt-test-fail (+ pl-tt-test-fail 1))
|
|
(append!
|
|
pl-tt-test-failures
|
|
(str name "\n expected: " expected "\n got: " got)))))))
|
|
|
|
(define
|
|
pl-tt-goal
|
|
(fn
|
|
(src env)
|
|
(pl-instantiate (nth (first (pl-parse (str "g :- " src "."))) 2) env)))
|
|
|
|
(define pl-tt-db (pl-mk-db))
|
|
|
|
;; ── copy_term/2 ──
|
|
|
|
(pl-tt-test!
|
|
"copy_term ground compound succeeds + copy = original"
|
|
(pl-solve-once!
|
|
pl-tt-db
|
|
(pl-tt-goal "copy_term(foo(a, b), X), X = foo(a, b)" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
(pl-tt-test!
|
|
"copy_term preserves var aliasing in source"
|
|
(pl-solve-once!
|
|
pl-tt-db
|
|
(pl-tt-goal "copy_term(p(Y, Y), p(A, B)), A = 5, B = 5" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
(pl-tt-test!
|
|
"copy_term distinct vars stay distinct"
|
|
(pl-solve-once!
|
|
pl-tt-db
|
|
(pl-tt-goal "copy_term(p(Y, Y), p(A, B)), A = 5, B = 6" {})
|
|
(pl-mk-trail))
|
|
false)
|
|
|
|
(define pl-tt-env-1 {})
|
|
(pl-solve-once!
|
|
pl-tt-db
|
|
(pl-tt-goal "copy_term(X, Y), Y = 5" pl-tt-env-1)
|
|
(pl-mk-trail))
|
|
(pl-tt-test!
|
|
"copy_term: binding the copy doesn't bind the source"
|
|
(pl-var-bound? (dict-get pl-tt-env-1 "X"))
|
|
false)
|
|
|
|
;; ── functor/3 ──
|
|
|
|
(define pl-tt-env-2 {})
|
|
(pl-solve-once!
|
|
pl-tt-db
|
|
(pl-tt-goal "functor(foo(a, b, c), F, N)" pl-tt-env-2)
|
|
(pl-mk-trail))
|
|
(pl-tt-test!
|
|
"functor of compound: F = foo"
|
|
(pl-atom-name (pl-walk-deep (dict-get pl-tt-env-2 "F")))
|
|
"foo")
|
|
(pl-tt-test!
|
|
"functor of compound: N = 3"
|
|
(pl-num-val (pl-walk-deep (dict-get pl-tt-env-2 "N")))
|
|
3)
|
|
|
|
(define pl-tt-env-3 {})
|
|
(pl-solve-once!
|
|
pl-tt-db
|
|
(pl-tt-goal "functor(hello, F, N)" pl-tt-env-3)
|
|
(pl-mk-trail))
|
|
(pl-tt-test!
|
|
"functor of atom: F = hello"
|
|
(pl-atom-name (pl-walk-deep (dict-get pl-tt-env-3 "F")))
|
|
"hello")
|
|
(pl-tt-test!
|
|
"functor of atom: N = 0"
|
|
(pl-num-val (pl-walk-deep (dict-get pl-tt-env-3 "N")))
|
|
0)
|
|
|
|
(pl-tt-test!
|
|
"functor construct compound: T unifies with foo(a, b)"
|
|
(pl-solve-once!
|
|
pl-tt-db
|
|
(pl-tt-goal "functor(T, foo, 2), T = foo(a, b)" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
(pl-tt-test!
|
|
"functor construct atom: T = hello"
|
|
(pl-solve-once!
|
|
pl-tt-db
|
|
(pl-tt-goal "functor(T, hello, 0), T = hello" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
;; ── arg/3 ──
|
|
|
|
(pl-tt-test!
|
|
"arg(1, foo(a, b, c), a)"
|
|
(pl-solve-once!
|
|
pl-tt-db
|
|
(pl-tt-goal "arg(1, foo(a, b, c), a)" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
(pl-tt-test!
|
|
"arg(2, foo(a, b, c), X) → X = b"
|
|
(pl-solve-once!
|
|
pl-tt-db
|
|
(pl-tt-goal "arg(2, foo(a, b, c), X), X = b" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
(pl-tt-test!
|
|
"arg out-of-range high fails"
|
|
(pl-solve-once!
|
|
pl-tt-db
|
|
(pl-tt-goal "arg(4, foo(a, b, c), X)" {})
|
|
(pl-mk-trail))
|
|
false)
|
|
|
|
(pl-tt-test!
|
|
"arg(0, ...) fails (1-indexed)"
|
|
(pl-solve-once!
|
|
pl-tt-db
|
|
(pl-tt-goal "arg(0, foo(a), X)" {})
|
|
(pl-mk-trail))
|
|
false)
|
|
|
|
(define pl-term-inspect-tests-run! (fn () {:failed pl-tt-test-fail :passed pl-tt-test-pass :total pl-tt-test-count :failures pl-tt-test-failures}))
|