giles
ffc3716b0e
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
115 lines
3.0 KiB
Plaintext
115 lines
3.0 KiB
Plaintext
;; lib/prolog/tests/programs/append.sx — append/3 test runner
|
|
;;
|
|
;; Mirrors the Prolog source in append.pl (embedded as a string here because
|
|
;; the SX runtime has no file-read primitive yet).
|
|
|
|
(define pl-ap-test-count 0)
|
|
(define pl-ap-test-pass 0)
|
|
(define pl-ap-test-fail 0)
|
|
(define pl-ap-test-failures (list))
|
|
|
|
(define
|
|
pl-ap-test!
|
|
(fn
|
|
(name got expected)
|
|
(begin
|
|
(set! pl-ap-test-count (+ pl-ap-test-count 1))
|
|
(if
|
|
(= got expected)
|
|
(set! pl-ap-test-pass (+ pl-ap-test-pass 1))
|
|
(begin
|
|
(set! pl-ap-test-fail (+ pl-ap-test-fail 1))
|
|
(append!
|
|
pl-ap-test-failures
|
|
(str name "\n expected: " expected "\n got: " got)))))))
|
|
|
|
(define
|
|
pl-ap-term-to-sx
|
|
(fn
|
|
(t)
|
|
(cond
|
|
((pl-num? t) (pl-num-val t))
|
|
((pl-atom? t) (pl-atom-name t))
|
|
(true (list :complex)))))
|
|
|
|
(define
|
|
pl-ap-list-walked
|
|
(fn
|
|
(w)
|
|
(cond
|
|
((and (pl-atom? w) (= (pl-atom-name w) "[]")) (list))
|
|
((and (pl-compound? w) (= (pl-fun w) ".") (= (len (pl-args w)) 2))
|
|
(cons
|
|
(pl-ap-term-to-sx (first (pl-args w)))
|
|
(pl-ap-list-walked (nth (pl-args w) 1))))
|
|
(true (list :not-list)))))
|
|
|
|
(define pl-ap-list-to-sx (fn (t) (pl-ap-list-walked (pl-walk-deep t))))
|
|
|
|
(define
|
|
pl-ap-goal
|
|
(fn
|
|
(src env)
|
|
(pl-instantiate (nth (first (pl-parse (str "g :- " src "."))) 2) env)))
|
|
|
|
(define
|
|
pl-ap-prog-src
|
|
"append([], L, L). append([H|T], L, [H|R]) :- append(T, L, R).")
|
|
|
|
(define pl-ap-db (pl-mk-db))
|
|
|
|
(pl-db-load! pl-ap-db (pl-parse pl-ap-prog-src))
|
|
|
|
(define pl-ap-env-1 {})
|
|
(define pl-ap-goal-1 (pl-ap-goal "append([], [a, b], X)" pl-ap-env-1))
|
|
(pl-solve-once! pl-ap-db pl-ap-goal-1 (pl-mk-trail))
|
|
|
|
(pl-ap-test!
|
|
"append([], [a, b], X) → X = [a, b]"
|
|
(pl-ap-list-to-sx (dict-get pl-ap-env-1 "X"))
|
|
(list "a" "b"))
|
|
|
|
(define pl-ap-env-2 {})
|
|
(define pl-ap-goal-2 (pl-ap-goal "append([1, 2], [3, 4], X)" pl-ap-env-2))
|
|
(pl-solve-once! pl-ap-db pl-ap-goal-2 (pl-mk-trail))
|
|
|
|
(pl-ap-test!
|
|
"append([1, 2], [3, 4], X) → X = [1, 2, 3, 4]"
|
|
(pl-ap-list-to-sx (dict-get pl-ap-env-2 "X"))
|
|
(list 1 2 3 4))
|
|
|
|
(pl-ap-test!
|
|
"append([1], [2, 3], [1, 2, 3]) succeeds"
|
|
(pl-solve-once!
|
|
pl-ap-db
|
|
(pl-ap-goal "append([1], [2, 3], [1, 2, 3])" {})
|
|
(pl-mk-trail))
|
|
true)
|
|
|
|
(pl-ap-test!
|
|
"append([1, 2], [3], [1, 2, 4]) fails"
|
|
(pl-solve-once!
|
|
pl-ap-db
|
|
(pl-ap-goal "append([1, 2], [3], [1, 2, 4])" {})
|
|
(pl-mk-trail))
|
|
false)
|
|
|
|
(pl-ap-test!
|
|
"append(X, Y, [1, 2, 3]) backtracks 4 times"
|
|
(pl-solve-count!
|
|
pl-ap-db
|
|
(pl-ap-goal "append(X, Y, [1, 2, 3])" {})
|
|
(pl-mk-trail))
|
|
4)
|
|
|
|
(define pl-ap-env-6 {})
|
|
(define pl-ap-goal-6 (pl-ap-goal "append(X, [3], [1, 2, 3])" pl-ap-env-6))
|
|
(pl-solve-once! pl-ap-db pl-ap-goal-6 (pl-mk-trail))
|
|
|
|
(pl-ap-test!
|
|
"append(X, [3], [1, 2, 3]) deduces X = [1, 2]"
|
|
(pl-ap-list-to-sx (dict-get pl-ap-env-6 "X"))
|
|
(list 1 2))
|
|
|
|
(define pl-append-tests-run! (fn () {:failed pl-ap-test-fail :passed pl-ap-test-pass :total pl-ap-test-count :failures pl-ap-test-failures}))
|