suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Moving tests

Browse Source
This commit is contained in:
Jay McCarthy 2010-06-25 22:00:14 -06:00
parent 489d1d730f
commit 30e3cd1071
56 changed files with 1 additions and 1133 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

80
collects/datalog/tests/ast.rkt
View File

@ -1,80 +0,0 @@
#lang racket
(require rackunit
"../ast.rkt")
(provide ast-tests)
(define ast-tests
(test-suite
"ast"
(test-suite
"datum-equal?"
(test-not-false "str/str" (datum-equal? "str" "str"))
(test-false "str/str" (datum-equal? "str1" "str2"))
(test-not-false "sym/sym" (datum-equal? 'sym1 'sym1))
(test-false "sym/sym" (datum-equal? 'sym1 'sym2))
(test-false "str/sym" (datum-equal? "str" 'sym))
(test-false "sym/str" (datum-equal? 'sym "str")))
(test-suite
"variable-equal?"
(test-not-false "var/var" (variable-equal? (make-variable #f 'sym1) (make-variable #f 'sym1)))
(test-not-false "var/var" (variable-equal? (make-variable #f 'sym1) (make-variable #'sym1 'sym1)))
(test-false "var/var" (variable-equal? (make-variable #f 'sym1) (make-variable #f 'sym2)))
(test-false "var/var" (variable-equal? (make-variable #f 'sym1) (make-variable #'sym2 'sym2))))
(test-suite
"constant-equal?"
(test-not-false "sym/sym" (constant-equal? (make-constant #f 'sym1) (make-constant #f 'sym1)))
(test-not-false "sym/sym" (constant-equal? (make-constant #f 'sym1) (make-constant #'sym1 'sym1)))
(test-false "sym/sym" (constant-equal? (make-constant #f 'sym1) (make-constant #'sym1 'sym2)))
(test-not-false "str/str" (constant-equal? (make-constant #f "sym1") (make-constant #f "sym1")))
(test-not-false "str/str" (constant-equal? (make-constant #f "sym1") (make-constant #'sym1 "sym1")))
(test-false "str/str" (constant-equal? (make-constant #f "sym1") (make-constant #'sym1 "sym2")))
(test-false "sym/str" (constant-equal? (make-constant #f 'sym1) (make-constant #'sym1 "sym2")))
(test-false "str/sym" (constant-equal? (make-constant #'sym1 "sym2") (make-constant #f 'sym1))))
(test-suite
"term-equal?"
(test-not-false "var/var" (term-equal? (make-variable #f 'sym1) (make-variable #f 'sym1)))
(test-not-false "var/var" (term-equal? (make-variable #f 'sym1) (make-variable #'sym1 'sym1)))
(test-false "var/var" (term-equal? (make-variable #f 'sym1) (make-variable #f 'sym2)))
(test-false "var/var" (term-equal? (make-variable #f 'sym1) (make-variable #'sym2 'sym2)))
(test-not-false "sym/sym" (term-equal? (make-constant #f 'sym1) (make-constant #f 'sym1)))
(test-not-false "sym/sym" (term-equal? (make-constant #f 'sym1) (make-constant #'sym1 'sym1)))
(test-false "sym/sym" (term-equal? (make-constant #f 'sym1) (make-constant #'sym1 'sym2)))
(test-not-false "str/str" (term-equal? (make-constant #f "sym1") (make-constant #f "sym1")))
(test-not-false "str/str" (term-equal? (make-constant #f "sym1") (make-constant #'sym1 "sym1")))
(test-false "str/str" (term-equal? (make-constant #f "sym1") (make-constant #'sym1 "sym2")))
(test-false "sym/str" (term-equal? (make-constant #f 'sym1) (make-constant #'sym1 "sym2")))
(test-false "str/sym" (term-equal? (make-constant #'sym1 "sym2") (make-constant #f 'sym1)))
(test-false "con/var" (term-equal? (make-constant #'sym1 "sym2") (make-variable #f 'sym1)))
(test-false "var/con" (term-equal? (make-variable #f 'sym1) (make-constant #'sym1 "sym2"))))
(test-suite
"literal-equal?"
(test-not-false "lit" (literal-equal? (make-literal #f 'lit1 empty) (make-literal #'lit1 'lit1 empty)))
(test-not-false "lit" (literal-equal? (make-literal #f 'lit1 (list (make-variable #f 'sym1)))
(make-literal #'lit1 'lit1 (list (make-variable #f 'sym1)))))
(test-not-false "lit" (literal-equal? (make-literal #f 'lit1 (list (make-variable #f 'sym1)))
(make-literal #'lit1 'lit1 (list (make-variable #'sym1 'sym1)))))
(test-false "lit" (literal-equal? (make-literal #f 'lit1 empty) (make-literal #'lit1 'lit2 empty)))
(test-false "lit" (literal-equal? (make-literal #f 'lit1 (list (make-variable #f 'sym1))) (make-literal #'lit1 'lit2 empty)))
(test-false "lit" (literal-equal? (make-literal #f 'lit1 (list (make-variable #f 'sym1)))
(make-literal #'lit1 'lit2 (list (make-variable #'sym1 'sym2))))))
(test-suite
"clause-equal?"
(test-not-false "lit" (clause-equal? (make-clause #f (make-literal #f 'lit1 empty) empty)
(make-clause #f (make-literal #f 'lit1 empty) empty)))
(test-not-false "lit" (clause-equal? (make-clause #f (make-literal #f 'lit1 empty) (list (make-literal #f 'lit1 empty)))
(make-clause #f (make-literal #f 'lit1 empty) (list (make-literal #f 'lit1 empty)))))
(test-not-false "lit" (clause-equal? (make-clause #f (make-literal #f 'lit1 empty) empty)
(make-clause #'cl1 (make-literal #f 'lit1 empty) empty)))
(test-false "lit" (clause-equal? (make-clause #f (make-literal #f 'lit1 empty) empty)
(make-clause #f (make-literal #f 'lit2 empty) empty)))
(test-false "lit" (clause-equal? (make-clause #f (make-literal #f 'lit1 empty) (list (make-literal #f 'lit1 empty)))
(make-clause #f (make-literal #f 'lit1 empty) empty)))
(test-false "lit" (clause-equal? (make-clause #f (make-literal #f 'lit1 empty) (list (make-literal #f 'lit1 empty)))
(make-clause #f (make-literal #f 'lit1 empty) (list (make-literal #f 'lit2 empty))))))))

47
collects/datalog/tests/eval.rkt
View File

@ -1,47 +0,0 @@
#lang racket
(require rackunit
racket/runtime-path
"../parse.rkt"
"../eval.rkt")
(provide eval-tests)
(define-runtime-path here ".")
(define (test-examples examples-dir)
(define (test-example t)
(define test-rkt (build-path examples-dir (format "~a.rkt" t)))
(define test-txt (build-path examples-dir (format "~a.txt" t)))
(test-equal? t
(filter (lambda (l)
(not (string=? l "")))
(with-input-from-string
(with-output-to-string
(lambda () (dynamic-require test-rkt #f)))
port->lines))
(filter (lambda (l)
(not (string=? l "")))
(file->lines test-txt))
))
(test-suite
(path->string examples-dir)
(test-example "ancestor")
(test-example "bidipath")
(test-example "laps")
(test-example "long")
(test-example "path")
(test-example "pq")
(test-example "revpath")
(test-example "says")
(test-example "true")
(test-example "tutorial")))
(define eval-tests
(test-suite
"eval"
(test-examples (build-path here "examples"))
(test-examples (build-path here "paren-examples"))))

12
collects/datalog/tests/examples/ancestor.rkt
View File

@ -1,12 +0,0 @@
#lang datalog
% Equality test
ancestor(A, B) :-
parent(A, B).
ancestor(A, B) :-
parent(A, C),
D = C, % Unification required
ancestor(D, B).
parent(john, douglas).
parent(bob, john).
parent(ebbon, bob).
ancestor(A, B)?

6
collects/datalog/tests/examples/ancestor.txt
View File

@ -1,6 +0,0 @@
ancestor(ebbon, bob).
ancestor(bob, john).
ancestor(john, douglas).
ancestor(bob, douglas).
ancestor(ebbon, john).
ancestor(ebbon, douglas).

7
collects/datalog/tests/examples/bidipath.rkt
View File

@ -1,7 +0,0 @@
#lang datalog
% path test from Chen & Warren
edge(a, b). edge(b, c). edge(c, d). edge(d, a).
path(X, Y) :- edge(X, Y).
path(X, Y) :- edge(X, Z), path(Z, Y).
path(X, Y) :- path(X, Z), edge(Z, Y).
path(X, Y)?

17
collects/datalog/tests/examples/bidipath.txt
View File

@ -1,17 +0,0 @@
path(a, a).
path(a, d).
path(a, c).
path(a, b).
path(b, b).
path(b, a).
path(b, d).
path(b, c).
path(c, c).
path(c, b).
path(c, a).
path(c, d).
path(d, d).
path(d, c).
path(d, b).
path(d, a).

12
collects/datalog/tests/examples/laps.rkt
View File

@ -1,12 +0,0 @@
#lang datalog
% Laps Test
contains(ca, store, rams_couch, rams).
contains(rams, fetch, rams_couch, will).
contains(ca, fetch, Name, Watcher) :-
contains(ca, store, Name, Owner),
contains(Owner, fetch, Name, Watcher).
trusted(ca).
permit(User, Priv, Name) :-
contains(Auth, Priv, Name, User),
trusted(Auth).
permit(User, Priv, Name)?

2
collects/datalog/tests/examples/laps.txt
View File

@ -1,2 +0,0 @@
permit(rams, store, rams_couch).
permit(will, fetch, rams_couch).

8
collects/datalog/tests/examples/long.rkt
View File

@ -1,8 +0,0 @@
#lang datalog
abcdefghi(z123456789,
z1234567890123456789,
z123456789012345678901234567890123456789,
z1234567890123456789012345678901234567890123456789012345678901234567890123456789).
this_is_a_long_identifier_and_tests_the_scanners_concat_when_read_with_a_small_buffer.
this_is_a_long_identifier_and_tests_the_scanners_concat_when_read_with_a_small_buffer?

1
collects/datalog/tests/examples/long.txt
View File

@ -1 +0,0 @@
this_is_a_long_identifier_and_tests_the_scanners_concat_when_read_with_a_small_buffer.

6
collects/datalog/tests/examples/path.rkt
View File

@ -1,6 +0,0 @@
#lang datalog
% path test from Chen & Warren
edge(a, b). edge(b, c). edge(c, d). edge(d, a).
path(X, Y) :- edge(X, Y).
path(X, Y) :- edge(X, Z), path(Z, Y).
path(X, Y)?

17
collects/datalog/tests/examples/path.txt
View File

@ -1,17 +0,0 @@
path(a, a).
path(a, d).
path(a, c).
path(a, b).
path(b, a).
path(b, d).
path(b, c).
path(b, b).
path(c, a).
path(c, b).
path(c, c).
path(c, d).
path(d, b).
path(d, c).
path(d, d).
path(d, a).

6
collects/datalog/tests/examples/pq.rkt
View File

@ -1,6 +0,0 @@
#lang datalog
% p q test from Chen & Warren
q(X) :- p(X).
q(a).
p(X) :- q(X).
q(X)?

1
collects/datalog/tests/examples/pq.txt
View File

@ -1 +0,0 @@
q(a).

6
collects/datalog/tests/examples/revpath.rkt
View File

@ -1,6 +0,0 @@
#lang datalog
% path test from Chen & Warren
edge(a, b). edge(b, c). edge(c, d). edge(d, a).
path(X, Y) :- edge(X, Y).
path(X, Y) :- path(X, Z), edge(Z, Y).
path(X, Y)?

17
collects/datalog/tests/examples/revpath.txt
View File

@ -1,17 +0,0 @@
path(a, a).
path(a, d).
path(a, c).
path(a, b).
path(b, b).
path(b, a).
path(b, d).
path(b, c).
path(c, c).
path(c, b).
path(c, a).
path(c, d).
path(d, d).
path(d, c).
path(d, b).
path(d, a).

5
collects/datalog/tests/examples/says.rkt
View File

@ -1,5 +0,0 @@
#lang datalog
tpme(tpme1).
ms(m1,'TPME',tpme1,ek,tp).
says(TPME,M) :- tpme(TPME),ms(M,'TPME',TPME,A,B).
says(A,B)?

1
collects/datalog/tests/examples/says.txt
View File

@ -1 +0,0 @@
says(tpme1, m1).

3
collects/datalog/tests/examples/true.rkt
View File

@ -1,3 +0,0 @@
#lang datalog
true.
true?

1
collects/datalog/tests/examples/true.txt
View File

@ -1 +0,0 @@
true.

42
collects/datalog/tests/examples/tutorial.rkt
View File

@ -1,42 +0,0 @@
#lang datalog
parent(john,douglas).
parent(john,douglas)?
% parent(john, douglas).
parent(john,ebbon)?
parent(bob,john).
parent(ebbon,bob).
parent(A,B)?
% parent(john, douglas).
% parent(bob, john).
% parent(ebbon, bob).
parent(john,B)?
% parent(john, douglas).
parent(A,A)?
ancestor(A,B) :- parent(A,B).
ancestor(A,B) :- parent(A,C), ancestor(C, B).
ancestor(A, B)?
% ancestor(ebbon, bob).
% ancestor(bob, john).
% ancestor(john, douglas).
% ancestor(bob, douglas).
% ancestor(ebbon, john).
% ancestor(ebbon, douglas).
ancestor(X,john)?
% ancestor(bob, john).
% ancestor(ebbon, john).
parent(bob, john)~
parent(A,B)?
% parent(john, douglas).
% parent(ebbon, bob).
ancestor(A,B)?
% ancestor(john, douglas).
% ancestor(ebbon, bob).

26
collects/datalog/tests/examples/tutorial.txt
View File

@ -1,26 +0,0 @@
parent(john, douglas).
parent(john, douglas).
parent(bob, john).
parent(ebbon, bob).
parent(john, douglas).
ancestor(ebbon, bob).
ancestor(bob, john).
ancestor(john, douglas).
ancestor(bob, douglas).
ancestor(ebbon, john).
ancestor(ebbon, douglas).
ancestor(bob, john).
ancestor(ebbon, john).
parent(john, douglas).
parent(ebbon, bob).
ancestor(ebbon, bob).
ancestor(john, douglas).

42
collects/datalog/tests/main.rkt
View File

@ -1,42 +0,0 @@
#lang racket
(require rackunit
rackunit/text-ui
"ast.rkt"
"private/lex.rkt"
"tool/syntax-color.rkt"
"parse.rkt"
"sexp.rkt"
"pretty.rkt"
"private/env.rkt"
"private/subst.rkt"
"private/unify.rkt"
"private/variant.rkt"
"runtime.rkt"
"eval.rkt"
"private/compiler.rkt")
(run-tests
(test-suite
"Datalog"
ast-tests
lex-tests
syntax-color-tests
parse-tests
sexp-tests
pretty-tests
env-tests
subst-tests
unify-tests
variant-tests
runtime-tests
eval-tests
compiler-tests))

12
collects/datalog/tests/paren-examples/ancestor.rkt
View File

@ -1,12 +0,0 @@
#lang datalog/sexp
; Equality test
(! (:- (ancestor ,A ,B)
(parent ,A ,B)))
(! (:- (ancestor ,A ,B)
(parent ,A ,C)
(= D C) ; Unification required
(ancestor ,D ,B)))
(! (parent john douglas))
(! (parent bob john))
(! (parent ebbon bob))
(? (ancestor ,A ,B))

6
collects/datalog/tests/paren-examples/ancestor.txt
View File

@ -1,6 +0,0 @@
ancestor(ebbon, douglas).
ancestor(ebbon, john).
ancestor(bob, douglas).
ancestor(ebbon, bob).
ancestor(bob, john).
ancestor(john, douglas).

15
collects/datalog/tests/paren-examples/bidipath.rkt
View File

@ -1,15 +0,0 @@
#lang datalog/sexp
; path test from Chen & Warren
(! (edge a b))
(! (edge b c))
(! (edge c d))
(! (edge d a))
(! (:- (path ,X ,Y)
(edge ,X ,Y)))
(! (:- (path ,X ,Y)
(edge ,X ,Z)
(path ,Z ,Y)))
(! (:- (path ,X ,Y)
(path ,X ,Z)
(edge ,Z ,Y)))
(? (path ,X ,Y))

17
collects/datalog/tests/paren-examples/bidipath.txt
View File

@ -1,17 +0,0 @@
path(a, a).
path(a, d).
path(a, c).
path(a, b).
path(b, b).
path(b, a).
path(b, d).
path(b, c).
path(c, c).
path(c, b).
path(c, a).
path(c, d).
path(d, d).
path(d, c).
path(d, b).
path(d, a).

13
collects/datalog/tests/paren-examples/laps.rkt
View File

@ -1,13 +0,0 @@
#lang datalog/sexp
; Laps Test
(! (contains ca store rams_couch rams))
(! (contains rams fetch rams_couch will))
(! (:- (contains ca fetch ,Name ,Watcher)
(contains ca store ,Name ,Owner)
(contains ,Owner fetch ,Name ,Watcher)))
(! (trusted ca))
(! (:- (permit ,User ,Priv ,Name)
(contains ,Auth ,Priv ,Name ,User)
(trusted ,Auth)))
(? (permit ,User ,Priv ,Name))

2
collects/datalog/tests/paren-examples/laps.txt
View File

@ -1,2 +0,0 @@
permit(rams, store, rams_couch).
permit(will, fetch, rams_couch).

8
collects/datalog/tests/paren-examples/long.rkt
View File

@ -1,8 +0,0 @@
#lang datalog/sexp
(! (abcdefghi z123456789
z1234567890123456789
z123456789012345678901234567890123456789
z1234567890123456789012345678901234567890123456789012345678901234567890123456789))
(! this_is_a_long_identifier_and_tests_the_scanners_concat_when_read_with_a_small_buffer)
(? this_is_a_long_identifier_and_tests_the_scanners_concat_when_read_with_a_small_buffer)

1
collects/datalog/tests/paren-examples/long.txt
View File

@ -1 +0,0 @@
this_is_a_long_identifier_and_tests_the_scanners_concat_when_read_with_a_small_buffer.

12
collects/datalog/tests/paren-examples/path.rkt
View File

@ -1,12 +0,0 @@
#lang datalog/sexp
; path test from Chen & Warren
(! (edge a b))
(! (edge b c))
(! (edge c d))
(! (edge d a))
(! (:- (path ,X ,Y)
(edge ,X ,Y)))
(! (:- (path ,X ,Y)
(edge ,X ,Z)
(path ,Z ,Y)))
(? (path ,X ,Y))

17
collects/datalog/tests/paren-examples/path.txt
View File

@ -1,17 +0,0 @@
path(a, a).
path(a, d).
path(a, c).
path(a, b).
path(b, a).
path(b, d).
path(b, c).
path(b, b).
path(c, a).
path(c, b).
path(c, c).
path(c, d).
path(d, b).
path(d, c).
path(d, d).
path(d, a).

8
collects/datalog/tests/paren-examples/pq.rkt
View File

@ -1,8 +0,0 @@
#lang datalog/sexp
; p q test from Chen & Warren
(! (:- (q ,X)
(p ,X)))
(! (q a))
(! (:- (p ,X)
(q ,X)))
(? (q ,X))

1
collects/datalog/tests/paren-examples/pq.txt
View File

@ -1 +0,0 @@
q(a).

12
collects/datalog/tests/paren-examples/revpath.rkt
View File

@ -1,12 +0,0 @@
#lang datalog/sexp
; path test from Chen & Warren
(! (edge a b))
(! (edge b c))
(! (edge c d))
(! (edge d a))
(! (:- (path ,X ,Y)
(edge ,X ,Y)))
(! (:- (path ,X ,Y)
(path ,X ,Z)
(edge ,Z ,Y)))
(? (path ,X ,Y))

17
collects/datalog/tests/paren-examples/revpath.txt
View File

@ -1,17 +0,0 @@
path(a, a).
path(a, d).
path(a, c).
path(a, b).
path(b, b).
path(b, a).
path(b, d).
path(b, c).
path(c, c).
path(c, b).
path(c, a).
path(c, d).
path(d, d).
path(d, c).
path(d, b).
path(d, a).

7
collects/datalog/tests/paren-examples/says.rkt
View File

@ -1,7 +0,0 @@
#lang datalog/sexp
(! (tpme tpme1))
(! (ms m1 "TPME" tpme1 ek tp))
(! (:- (says ,TPME ,M)
(tpme ,TPME)
(ms ,M "TPME" ,TPME ,A ,B)))
(? (says ,A ,B))

1
collects/datalog/tests/paren-examples/says.txt
View File

@ -1 +0,0 @@
says(tpme1, m1).

3
collects/datalog/tests/paren-examples/true.rkt
View File

@ -1,3 +0,0 @@
#lang datalog/sexp
(! true)
(? true)

1
collects/datalog/tests/paren-examples/true.txt
View File

@ -1 +0,0 @@
true.

28
collects/datalog/tests/paren-examples/tutorial.rkt
View File

@ -1,28 +0,0 @@
#lang datalog/sexp
(! (parent john douglas))
(? (parent john douglas))
(? (parent john ebbon))
(! (parent bob john))
(! (parent ebbon bob))
(? (parent ,A ,B))
(? (parent john ,B))
(? (parent ,A ,A))
(! (:- (ancestor ,A ,B)
(parent ,A ,B)))
(! (:- (ancestor ,A ,B)
(parent ,A ,C)
(ancestor ,C ,B)))
(? (ancestor ,A ,B))
(? (ancestor ,X john))
(~ (parent bob john))
(? (parent ,A ,B))
(? (ancestor ,A ,B))

26
collects/datalog/tests/paren-examples/tutorial.txt
View File

@ -1,26 +0,0 @@
parent(john, douglas).
parent(john, douglas).
parent(bob, john).
parent(ebbon, bob).
parent(john, douglas).
ancestor(ebbon, bob).
ancestor(bob, john).
ancestor(john, douglas).
ancestor(bob, douglas).
ancestor(ebbon, john).
ancestor(ebbon, douglas).
ancestor(bob, john).
ancestor(ebbon, john).
parent(john, douglas).
parent(ebbon, bob).
ancestor(ebbon, bob).
ancestor(john, douglas).

52
collects/datalog/tests/parse.rkt
View File

@ -1,52 +0,0 @@
#lang racket
(require rackunit
"../ast.rkt"
"util.rkt"
"../parse.rkt")
(provide parse-tests)
(define (test-literal-parse str res)
(test-literal str (parse-literal (open-input-string str)) res))
(define (test-clause-parse str res)
(test-clause str (parse-clause (open-input-string str)) res))
(define parse-tests
(test-suite
"parse"
(test-suite
"literal"
(test-literal-parse "parent(john, douglas)"
(make-literal #f 'parent (list (make-constant #f 'john) (make-constant #f 'douglas))))
(test-literal-parse "1 = 2"
(make-literal #f '= (list (make-constant #f '|1|) (make-constant #f '|2|))))
(test-literal-parse "zero-arity-literal"
(make-literal #f 'zero-arity-literal empty))
(test-literal-parse "zero-arity-literal()"
(make-literal #f 'zero-arity-literal empty))
(test-literal-parse "\"=\"(3,3)"
(make-literal #f "=" (list (make-constant #f '|3|) (make-constant #f '|3|))))
(test-literal-parse "\"\"(-0-0-0,&&&,***,\"\00\")"
(make-literal #f "" (list (make-constant #f '-0-0-0)
(make-constant #f '&&&)
(make-constant #f '***)
(make-constant #f "\00")))))
(test-suite
"clause"
(test-clause-parse "parent(john, douglas)"
(make-clause #f (make-literal #f 'parent (list (make-constant #f 'john) (make-constant #f 'douglas))) empty))
(test-clause-parse "ancestor(A, B) :- parent(A, B)"
(make-clause #f (make-literal #f 'ancestor (list (make-variable #f 'A) (make-variable #f 'B)))
(list (make-literal #f 'parent (list (make-variable #f 'A) (make-variable #f 'B))))))
(test-clause-parse "ancestor(A, B) :- parent(A, C), ancestor(C, B)"
(make-clause #f (make-literal #f 'ancestor (list (make-variable #f 'A) (make-variable #f 'B)))
(list (make-literal #f 'parent (list (make-variable #f 'A) (make-variable #f 'C)))
(make-literal #f 'ancestor (list (make-variable #f 'C) (make-variable #f 'B)))))))
(test-suite
"statement"
(test-not-false "assertion" (assertion? (parse-statement (open-input-string "parent(john, douglas)."))))
(test-not-false "retraction" (retraction? (parse-statement (open-input-string "parent(john, douglas)~"))))
(test-not-false "query" (query? (parse-statement (open-input-string "parent(john, douglas)?")))))))

49
collects/datalog/tests/pretty.rkt
View File

@ -1,49 +0,0 @@
#lang racket
(require rackunit
"../parse.rkt"
"../pretty.rkt")
(provide pretty-tests)
(define pretty-tests
(test-suite
"Pretty"
(test-equal? "program"
(format-program
(parse-program
(open-input-string #<<END
parent(john, douglas).
parent(john, douglas)?
parent(john, ebbon)?
parent(bob, john).
parent(ebbon, bob).
parent(A, B)?
parent(john, B)?
parent(A, A)?
ancestor(A, B) :- parent(A, B).
ancestor(A, B) :-
parent(A, C),
ancestor(C, B).
ancestor(A, B)?
parent(bob, john)~
parent(A,B)?
ancestor(A,B)?
END
)))
#<<END
parent(john, douglas).
parent(john, douglas)?
parent(john, ebbon)?
parent(bob, john).
parent(ebbon, bob).
parent(A, B)?
parent(john, B)?
parent(A, A)?
ancestor(A, B) :- parent(A, B).
ancestor(A, B) :- parent(A, C), ancestor(C, B).
ancestor(A, B)?
parent(bob, john)~
parent(A, B)?
ancestor(A, B)?
END
)))

24
collects/datalog/tests/private/compiler.rkt
View File

@ -1,24 +0,0 @@
#lang racket
(require rackunit
(for-template "../../eval.rkt")
"../../parse.rkt"
"../../private/compiler.rkt")
(provide compiler-tests)
(define s1
(parse-statement
(open-input-string
"parent(john,douglas).")))
(define compiler-tests
(test-suite
"compiler"
(test-equal? "stmt"
(syntax->datum (compile-stmt s1))
`(eval-statement ,s1))
(test-equal? "module"
(syntax->datum (compile-module (list s1)))
`(begin (eval-statement ,s1)))))

22
collects/datalog/tests/private/env.rkt
View File

@ -1,22 +0,0 @@
#lang racket
(require rackunit
"../../ast.rkt"
"../../private/env.rkt")
(provide env-tests)
(define t1 (make-constant #f 't1))
(define t2 (make-constant #f 't2))
(define env-tests
(test-suite
"env"
(test-equal? "default" (lookup (empty-env) 'v) #f)
(test-equal? "default" (lookup (empty-env) 'v t1) t1)
(test-equal? "extend" (lookup (extend (empty-env) 'v1 t1) 'v1) t1)
(test-equal? "extend"
(lookup (extend (extend (empty-env) 'v1 t1)
'v1 t1)
'v1)
t1)))

37
collects/datalog/tests/private/lex.rkt
View File

@ -1,37 +0,0 @@
#lang racket
(require rackunit
parser-tools/lex
"../../private/lex.rkt")
(provide lex-tests)
(define (test-lexer str tok-name [tok-value str])
(define pv (dlexer (open-input-string str)))
(define v (position-token-token pv))
(test-equal? (format "lexer: ~a: <~a,~a>" str tok-name tok-value)
(cons tok-name tok-value)
(cons (token-name v) (token-value v))))
(define lex-tests
(test-suite
"lex"
(test-lexer "=" 'EQUAL #f)
(test-lexer "?" 'QMARK #f)
(test-lexer "~" 'TILDE #f)
(test-lexer "." 'DOT #f)
(test-lexer ")" 'RPAREN #f)
(test-lexer "," 'COMMA #f)
(test-lexer "(" 'LPAREN #f)
(test-lexer "\"\"" 'STRING "")
(test-lexer "\"foo\"" 'STRING "foo")
(test-lexer "\"\\\"\"" 'STRING "\"")
(test-lexer ":-" 'TSTILE #f)
(test-lexer "" 'EOF #f)
(test-lexer "Va1_" 'VARIABLE)
(test-lexer "val_" 'IDENTIFIER)
(test-lexer "912Kadf" 'IDENTIFIER)
(test-lexer " =" 'EQUAL #f)
(test-lexer "% 12453\n=" 'EQUAL #f)
))

114
collects/datalog/tests/private/subst.rkt
View File

@ -1,114 +0,0 @@
#lang racket
(require rackunit
"../../private/subst.rkt"
"../../ast.rkt"
"../../private/env.rkt")
(require/expose "../../private/subst.rkt" (subst-literal shuffle))
(provide subst-tests)
(define (gensym-var? v)
(define s (variable-sym v))
(not (eq? s (string->symbol (symbol->string s)))))
(define subst-tests
(test-suite
"subst"
(test-suite
"subst-term"
(test-equal? "con"
(subst-term (empty-env) (make-constant #f 'v1))
(make-constant #f 'v1))
(test-equal? "var def"
(subst-term (empty-env) (make-variable #f 'v1))
(make-variable #f 'v1))
(test-equal? "var"
(subst-term (extend (empty-env) 'v1 (make-constant #f 'v1)) (make-variable #f 'v1))
(make-constant #f 'v1)))
(test-suite
"subst-literal"
(test-equal? "con"
(subst-literal (empty-env) (make-literal #f 'lit (list (make-constant #f 'v1))))
(make-literal #f 'lit (list (make-constant #f 'v1))))
(test-equal? "var def"
(subst-literal (extend (empty-env) 'v1 (make-constant #f 'v1)) (make-literal #f 'lit (list (make-variable #f 'v1))))
(make-literal #f 'lit (list (make-constant #f 'v1))))
(test-equal? "var def"
(subst-literal (extend (empty-env) 'v1 (make-constant #f 'v1)) (make-literal #f 'lit (list (make-variable #f 'v1))))
(make-literal #f 'lit (list (make-constant #f 'v1)))))
(test-suite
"subst-clause"
(test-equal? "con"
(subst-clause (empty-env) (make-clause #f (make-literal #f 'lit (list (make-constant #f 'v1))) empty))
(make-clause #f (make-literal #f 'lit (list (make-constant #f 'v1))) empty))
(test-equal? "var def"
(subst-clause (extend (empty-env) 'v1 (make-constant #f 'v1))
(make-clause #f (make-literal #f 'lit (list (make-variable #f 'v1))) empty))
(make-clause #f (make-literal #f 'lit (list (make-constant #f 'v1))) empty))
(test-equal? "var def"
(subst-clause (extend (empty-env) 'v1 (make-constant #f 'v1))
(make-clause #f (make-literal #f 'lit (list (make-variable #f 'v1))) empty))
(make-clause #f (make-literal #f 'lit (list (make-constant #f 'v1))) empty))
(test-equal? "con"
(subst-clause (empty-env) (make-clause #f (make-literal #f 'lit (list (make-constant #f 'v1)))
(list (make-literal #f 'lit (list (make-constant #f 'v1))))))
(make-clause #f (make-literal #f 'lit (list (make-constant #f 'v1)))
(list (make-literal #f 'lit (list (make-constant #f 'v1))))))
(test-equal? "var def"
(subst-clause (extend (empty-env) 'v1 (make-constant #f 'v1))
(make-clause #f (make-literal #f 'lit (list (make-variable #f 'v1)))
(list (make-literal #f 'lit (list (make-variable #f 'v1))))))
(make-clause #f (make-literal #f 'lit (list (make-constant #f 'v1)))
(list (make-literal #f 'lit (list (make-constant #f 'v1))))))
(test-equal? "var def"
(subst-clause (extend (empty-env) 'v1 (make-constant #f 'v1))
(make-clause #f (make-literal #f 'lit (list (make-variable #f 'v1)))
(list (make-literal #f 'lit (list (make-variable #f 'v1))))))
(make-clause #f (make-literal #f 'lit (list (make-constant #f 'v1)))
(list (make-literal #f 'lit (list (make-constant #f 'v1)))))))
(test-suite
"shuffle"
(test-equal? "con"
(shuffle (empty-env) (make-literal #f 'lit (list (make-constant #f 'v1))))
(empty-env))
(test-equal? "var"
(shuffle (extend (empty-env) 'v1 (make-constant #f 'k1)) (make-literal #f 'lit (list (make-variable #f 'v1))))
(extend (empty-env) 'v1 (make-constant #f 'k1)))
(test-not-false "var"
(gensym-var? (lookup (shuffle (empty-env)
(make-literal #f 'lit (list (make-variable #f 'v1))))
'v1))))
(test-suite
"rename-literal"
(test-equal? "l" (rename-literal (make-literal #f 'lit (list (make-constant #f 'v1))))
(make-literal #f 'lit (list (make-constant #f 'v1))))
(test-not-false "l"
(gensym-var?
(first
(literal-terms
(rename-literal (make-literal #f 'lit (list (make-variable #f 'v1)))))))))
(test-suite
"rename-clause"
(test-equal? "c" (rename-clause (make-clause #f (make-literal #f 'lit (list (make-constant #f 'v1))) empty))
(make-clause #f (make-literal #f 'lit (list (make-constant #f 'v1))) empty))
(test-not-false "c"
(gensym-var?
(first
(literal-terms
(clause-head
(rename-clause (make-clause #f (make-literal #f 'lit (list (make-variable #f 'v1))) empty)))))))
(test-not-false "c"
(gensym-var?
(first
(literal-terms
(first
(clause-body
(rename-clause (make-clause #f (make-literal #f 'lit (list (make-constant #f 'v1)))
(list (make-literal #f 'lit (list (make-variable #f 'v1)))))))))))))))

54
collects/datalog/tests/private/unify.rkt
View File

@ -1,54 +0,0 @@
#lang racket
(require rackunit
"../../ast.rkt"
"../../private/env.rkt"
"../../private/unify.rkt")
(require/expose "../../private/unify.rkt" (chase unify-terms))
(provide unify-tests)
(define unify-tests
(test-suite
"unify"
(test-suite
"chase"
(test-equal? "con" (chase (empty-env) (make-constant #f 'k1))
(make-constant #f 'k1))
(test-equal? "var" (chase (empty-env) (make-variable #f 'v1))
(make-variable #f 'v1))
(test-equal? "var->con"
(chase (extend (empty-env) 'v1 (make-constant #f 'k1)) (make-variable #f 'v1))
(make-constant #f 'k1))
(test-equal? "var->var->con"
(chase (extend (extend (empty-env) 'v2 (make-constant #f 'k1))
'v1 (make-variable #f 'v2))
(make-variable #f 'v1))
(make-constant #f 'k1)))
(test-suite
"unify-term"
(test-equal? "con/con" (unify-term (empty-env) (make-constant #f 'k1) (make-constant #f 'k1))
(empty-env))
(test-false "con/con" (unify-term (empty-env) (make-constant #f 'k1) (make-constant #f 'k2)))
(test-equal? "var/con" (unify-term (empty-env) (make-variable #f 'v1) (make-constant #f 'k2))
(extend (empty-env) 'v1 (make-constant #f 'k2)))
(test-equal? "con/var" (unify-term (empty-env) (make-constant #f 'k2) (make-variable #f 'v1))
(extend (empty-env) 'v1 (make-constant #f 'k2)))
(test-equal? "var/var" (unify-term (empty-env) (make-variable #f 'v1) (make-variable #f 'v2))
(extend (empty-env) 'v1 (make-variable #f 'v2))))
(test-suite
"unify-terms"
(test-equal? "con/con" (unify-terms (empty-env) (list (make-constant #f 'k1)) (list (make-constant #f 'k1)))
(empty-env))
(test-false "con/con" (unify-terms (empty-env) (list (make-constant #f 'k1)) (list (make-constant #f 'k2))))
(test-false "/con" (unify-terms (empty-env) (list) (list (make-constant #f 'k2))))
(test-false "con/" (unify-terms (empty-env) (list (make-constant #f 'k2)) (list))))
(test-suite
"unify"
(test-false "lit/lit" (unify (make-literal #f 'lit1 empty) (make-literal #f 'lit2 empty)))
(test-equal? "con/con" (unify (make-literal #f 'lit1 (list (make-constant #f 'k1)))
(make-literal #f 'lit1 (list (make-constant #f 'k1))))
(empty-env)))))

58
collects/datalog/tests/private/variant.rkt
View File

@ -1,58 +0,0 @@
#lang racket
(require rackunit
"../../ast.rkt"
"../../private/variant.rkt")
(require/expose "../../private/variant.rkt" (variant-terms variant-term variant-var variant? term-hash mk-literal-hash))
(provide variant-tests)
(define (test-not-equal? n v1 v2)
(test-case n (check-not-equal? v1 v2)))
(define variant-tests
(test-suite
"variant"
(test-suite
"variant?"
(test-not-false "same" (variant? (make-literal #f 'lit1 empty) (make-literal #f 'lit1 empty)))
(test-false "dif lit" (variant? (make-literal #f 'lit1 empty) (make-literal #f 'lit2 empty)))
(test-not-false "same" (variant? (make-literal #f 'lit1 (list (make-constant #f 'k1)))
(make-literal #f 'lit1 (list (make-constant #f 'k1)))))
(test-false "dif con" (variant? (make-literal #f 'lit1 (list (make-constant #f 'k1)))
(make-literal #f 'lit1 (list (make-constant #f 'k2)))))
(test-false "dif var/con" (variant? (make-literal #f 'lit1 (list (make-variable #f 'v1)))
(make-literal #f 'lit1 (list (make-constant #f 'k1)))))
(test-false "dif con/var" (variant? (make-literal #f 'lit1 (list (make-constant #f 'k1)))
(make-literal #f 'lit1 (list (make-variable #f 'v1)))))
(test-not-false "same" (variant? (make-literal #f 'lit1 (list (make-variable #f 'v1)))
(make-literal #f 'lit1 (list (make-variable #f 'v1)))))
(test-not-false "var (dif name)" (variant? (make-literal #f 'lit1 (list (make-variable #f 'v2)))
(make-literal #f 'lit1 (list (make-variable #f 'v1))))))
(test-suite
"mem-literal"
(test-false "mt" (mem-literal (make-literal #f 'lit1 empty) empty))
(test-not-false "in" (mem-literal (make-literal #f 'lit1 empty) (list (make-literal #f 'lit1 empty))))
(test-not-false "var" (mem-literal (make-literal #f 'lit1 (list (make-variable #f 'v2)))
(list (make-literal #f 'lit1 (list (make-variable #f 'v1)))))))
(test-suite
"term-hash"
(test-equal? "var" (term-hash (make-variable #f (gensym)) equal-hash-code) 101)
(test-equal? "con" (term-hash (make-constant #f 'v2) equal-hash-code) (equal-hash-code 'v2)))
(local [(define literal-hash (mk-literal-hash equal-hash-code))
(define (literal-hash-equal? l1 l2)
(equal? (literal-hash l1) (literal-hash l2)))]
(test-suite
"mk-literal-hash"
(test-not-false "same" (literal-hash-equal? (make-literal #f 'lit1 empty) (make-literal #f 'lit1 empty)))
(test-not-false "same" (literal-hash-equal? (make-literal #f 'lit1 (list (make-constant #f 'k1)))
(make-literal #f 'lit1 (list (make-constant #f 'k1)))))
(test-not-false "same" (literal-hash-equal? (make-literal #f 'lit1 (list (make-variable #f 'v1)))
(make-literal #f 'lit1 (list (make-variable #f 'v1)))))
(test-not-false "var (dif name)" (literal-hash-equal? (make-literal #f 'lit1 (list (make-variable #f 'v2)))
(make-literal #f 'lit1 (list (make-variable #f 'v1)))))))))

53
collects/datalog/tests/runtime.rkt
View File

@ -1,53 +0,0 @@
#lang racket
(require rackunit
"../parse.rkt"
"util.rkt"
"../runtime.rkt")
(provide runtime-tests)
(define pc (parse-clause (open-input-string "parent(john, douglas)")))
(define pl (parse-literal (open-input-string "parent(john, douglas)")))
(define runtime-tests
(test-suite
"runtime"
(test-suite
"safe-clause?"
(test-not-false "safe" (safe-clause? pc))
(test-not-false "safe" (safe-clause? (parse-clause (open-input-string "ancestor(A, B) :- parent(A, B)"))))
(test-false "not safe" (safe-clause? (parse-clause (open-input-string "ancestor(A, B) :- parent(jay, B)"))))
(test-not-false "safe" (safe-clause? (parse-clause (open-input-string "ancestor(A, B) :- parent(A, C), ancestor(C, B)")))))
(test-suite
"imm simple"
(test-equal? "empty" (prove (make-immutable-theory) pl) empty)
(test-literal "ass->prov"
(first (prove (assume (make-immutable-theory) pc) pl))
pl)
(test-equal? "ass->ret->prov" (prove (retract (assume (make-immutable-theory) pc) pc) pl) empty)
(test-equal? "ret->prov" (prove (retract (make-immutable-theory) pc) pl) empty))
(test-suite
"mut simple"
(test-equal? "empty" (prove (make-mutable-theory) pl) empty)
(test-literal "ass->prov"
(let ([thy (make-mutable-theory)])
(assume! thy pc)
(first (prove thy pl)))
pl)
(test-equal? "ass->ret->prov"
(let ([thy (make-mutable-theory)])
(assume! thy pc)
(retract! thy pc)
(prove thy pl))
empty)
(test-equal? "ret->prov"
(let ([thy (make-mutable-theory)])
(retract! thy pc)
(prove thy pl))
empty))
))

49
collects/datalog/tests/sexp.rkt
View File

@ -1,49 +0,0 @@
#lang racket
(require rackunit
"../ast.rkt"
"util.rkt"
"../sexp.rkt")
(provide sexp-tests)
(define test
#'(begin
(! (parent john douglas))
(? (parent john douglas))
(? (parent john ebbon))
(! (parent bob john))
(! (parent ebbon bob))
(? (parent ,A ,B))
(? (parent john ,B))
(? (parent ,A ,A))
(! (:- (ancestor ,A ,B)
(parent ,A ,B)))
(! (:- (ancestor ,A ,B)
(parent ,A ,C)
(ancestor ,C ,B)))
(? (ancestor ,A ,B))
(? (ancestor ,X john))
(~ (parent bob john))
(? (parent ,A ,B))
(? (ancestor ,A ,B))))
(define sexp-tests
(test-suite
"sexp"
(test-not-exn "program" (lambda () (contract program/c (stx->program test) 'pos 'neg)))
(test-not-false "stmt" (assertion? (stx->statement #'(! (parent john douglas)))))
(test-not-false "stmt" (retraction? (stx->statement #'(~ (parent john douglas)))))
(test-not-false "stmt" (query? (stx->statement #'(? (parent john douglas)))))
(test-clause "clause" (stx->clause #'(parent john douglas))
(make-clause #f (make-literal #f 'parent (list (make-constant #f 'john) (make-constant #f 'douglas))) empty))
(test-clause "clause" (stx->clause #'(:- (ancestor ,A ,B) (parent ,A ,B)))
(make-clause #f (make-literal #f 'ancestor (list (make-variable #f 'A) (make-variable #f 'B)))
(list (make-literal #f 'parent (list (make-variable #f 'A) (make-variable #f 'B))))))
(test-literal "literal" (stx->literal #'(parent john douglas))
(make-literal #f 'parent (list (make-constant #f 'john) (make-constant #f 'douglas))))
))

37
collects/datalog/tests/tool/syntax-color.rkt
View File

@ -1,37 +0,0 @@
#lang racket
(require rackunit
"../../tool/syntax-color.rkt")
(provide syntax-color-tests)
(define (test-color str key)
(define-values (lex color b start end) (get-syntax-token (open-input-string str)))
(test-equal? (format "Syntax Color: ~a: ~a" key str) color key))
(define syntax-color-tests
(test-suite
"syntax-color"
(test-color " " 'whitespace)
(test-color " " 'whitespace)
(test-color "\t" 'whitespace)
(test-color "\n" 'whitespace)
(test-color "% \n" 'comment)
(test-color "% 12 31 2 6\n" 'comment)
(test-color "Var" 'symbol)
(test-color "V124_3" 'symbol)
(test-color "var" 'identifier)
(test-color "123var" 'identifier)
(test-color "(" 'parenthesis)
(test-color ")" 'parenthesis)
(test-color "=" 'parenthesis)
(test-color "?" 'parenthesis)
(test-color "~" 'parenthesis)
(test-color "." 'parenthesis)
(test-color "," 'parenthesis)
(test-color ":-" 'parenthesis)
(test-color "\"foo\"" 'string)
(test-color "\"fo\\\"o\"" 'string)
(test-color "\"fo\no\"" 'string)
(test-color "\"foo" 'error)
(test-color ":" 'error)))

12
collects/datalog/tests/util.rkt
View File

@ -1,12 +0,0 @@
#lang racket
(require rackunit
"../ast.rkt")
(provide test-literal test-clause)
(define (test-literal str l1 l2)
(test-case
str (check literal-equal? l1 l2)))
(define (test-clause str c1 c2)
(test-case
str (check clause-equal? c1 c2)))

1
collects/meta/props
View File

@ -1362,6 +1362,7 @@ path/s is either such a string or a list of them.
"collects/tests/compiler" responsible (jay) "collects/tests/compiler" responsible (jay)
"collects/tests/compiler/regression.rkt" responsible (mflatt) "collects/tests/compiler/regression.rkt" responsible (mflatt)
"collects/tests/compiler/zo-test.rkt" drdr:command-line (racket "-t" * "--" "-I" "-S" "-t" "60" "-v" "-R") drdr:random #t "collects/tests/compiler/zo-test.rkt" drdr:command-line (racket "-t" * "--" "-I" "-S" "-t" "60" "-v" "-R") drdr:random #t
"collects/tests/datalog" responsible (jay)
"collects/tests/deinprogramm" responsible (sperber) "collects/tests/deinprogramm" responsible (sperber)
"collects/tests/deinprogramm/image.rkt" drdr:command-line (gracket-text "-t" *) "collects/tests/deinprogramm/image.rkt" drdr:command-line (gracket-text "-t" *)
"collects/tests/deinprogramm/run-image-test.rkt" drdr:command-line (gracket-text "-t" *) "collects/tests/deinprogramm/run-image-test.rkt" drdr:command-line (gracket-text "-t" *)