1 extern prolog-no-bindings

2

3 main args

4 (church-init-matcher-compiler)

5 suite = `[ [list "`[[member 1 [1]]]" [[]]]

6 [list "`[[member 3 [1 2 3 4]]]" [[]]]

7 [list "`[[member 5 [1 2 3 4]]]" nil]

8 [person "`[[person X]]" [[X john] [X jane]]]

9 [imply "`[[worm W] [classify W]]" [[W w]]]

10 [map "`[[map1 M] [adjacent 1 2 M]]" nil]

11 [map "`[[map1 M] [find_regions M [] R]]" [[R [5 4 3 1 2]]]]

12 [map "`[[map3 M] [conflict M [[1 green] [2 green]]]]" nil]

13 [map "`[[map3 M] [not [conflict M [[1 green] [2 blue]]]]]" nil]

14 [map "`[[map3 M] [color M [green blue] Coloring]]" [[Coloring [[1 green] [2 blue]]]]]

15 [map "`[[map1 M] [color M [red green blue yellow] Coloring]]" [[Coloring [[5 red] [4 green] [3 red] [1 blue] [2 yellow]]]]]

16 ]

17 if (> (length args) 1)

18 suite = list (assoc (intern (second args)) suite)

19 loop

20 for [test-name query expected-bindings] in suite

21 do

22 test-file-name = concat "genesis/church/prolog/" (coerce test-name 'string)

23 test-file-name = concat test-file-name ".prolog"

24 result = run-prolog-query test-file-name query expected-bindings

25

26 run-prolog-query test-file-name query expected-bindings

27 (init-prolog)

28 pi = new 'prolog-interpreter

29 query = (church-read-from-string query)

30 run-query-with-file pi query test-file-name (fn result

31 vars = (variables-in query)

32 check-result test-file-name (list vars result) expected-bindings

33 )

34

35

36 church-read-from-string str

37 delistify (ometa-parse-array (coerce str 'array) 'church-parser 'quoted-expression)

38

39 check-result test-file-name result expected-bindings

40 print test-file-name

41 vars = first result

42 solutions = second result

43 ; print solutions

44 loop

45 for binding in expected-bindings

46 for solution in solutions

47 do

48 if binding

49 var-name = first binding

50 value = second binding

51 if (member? var-name vars)

52 v = (subst-bindings solution var-name)

53 if (not (equal? value v))

54 out "FAIL "

55 out binding

56 out " "

57 print v

58 else

59 out "FAIL "

60 out binding

61 print " missing"

62

63