Check-in [db5c306a7f]

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Add more Datalog tests, and adjust loadscript.tcl.in to allow for running Nagelfar instrumented code while testing.
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:db5c306a7fdd2802a4d85a2fb998ef5515a306ca
User & Date: kbk 2014-10-26 04:02:50
Context
2014-10-26
04:09
Adjust Datalog tests to cover EQUALITY check-in: c991aa8ae7 user: kbk tags: trunk
04:02
Add more Datalog tests, and adjust loadscript.tcl.in to allow for running Nagelfar instrumented code while testing. check-in: db5c306a7f user: kbk tags: trunk
2014-10-25
18:55
datalog: test assertion of a single fact. check-in: 3e177181c8 user: kbk tags: trunk
Changes

Changes to loadscript.tcl.in.

1
2
3
4
5
6
7



8
9

10



11

12
13
14
15
16



17

18
19
20



21
22

23



24
25

# Script to define the local packages when testing against an uninstalled
# tclbdd

# TEMP - Two packages that really ought to be in the coroutine area of
#        tcllib

package ifneeded coroutine::corovar 1.0 {



    source [file join {@LIBRARY_SRCDIR@} coroutine_corovar.tcl]
}

package ifneeded coroutine::iterator 1.0 {



    source [file join {@LIBRARY_SRCDIR@} coroutine_iterator.tcl]

}

# Actual packages of tclbdd

package ifneeded tclbdd @PACKAGE_VERSION@ {



    source [file join {@LIBRARY_SRCDIR@} tclbdd.tcl]

    load [file join . @PKG_LIB_FILE@] tclbdd
}
package ifneeded tclbdd::fddd @PACKAGE_VERSION@ {



    source [file join {@LIBRARY_SRCDIR@} tclfddd.tcl]
}

package ifneeded tclbdd::datalog @PACKAGE_VERSION@ {



    source [file join {@LIBRARY_SRCDIR@} datalog.tcl]
}








>
>
>
|
|
>

>
>
>
|
>





>
>
>
|
>



>
>
>
|
|
>

>
>
>
|
|
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
# Script to define the local packages when testing against an uninstalled
# tclbdd

# TEMP - Two packages that really ought to be in the coroutine area of
#        tcllib

package ifneeded coroutine::corovar 1.0 {
    if {[file exists [file join {@LIBRARY_SRCDIR@} coroutine_corovar.tcl_i]]} {
	source [file join {@LIBRARY_SRCDIR@} coroutine_corovar.tcl_i]
    } else {
	source [file join {@LIBRARY_SRCDIR@} coroutine_corovar.tcl]
    }	
}
package ifneeded coroutine::iterator 1.0 {
    if {[file exists [file join {@LIBRARY_SRCDIR@} coroutine_iterator.tcl_i]]} {
	source [file join {@LIBRARY_SRCDIR@} coroutine_iterator.tcl_i]
    } else {
	source [file join {@LIBRARY_SRCDIR@} coroutine_iterator.tcl]
    }
}

# Actual packages of tclbdd

package ifneeded tclbdd @PACKAGE_VERSION@ {
    if {[file exists [file join {@LIBRARY_SRCDIR@} tclbdd.tcl_i]]} {
	source [file join {@LIBRARY_SRCDIR@} tclbdd.tcl_i]
    } else {
	source [file join {@LIBRARY_SRCDIR@} tclbdd.tcl]
    }
    load [file join . @PKG_LIB_FILE@] tclbdd
}
package ifneeded tclbdd::fddd @PACKAGE_VERSION@ {
    if {[file exists [file join {@LIBRARY_SRCDIR@} tclfddd.tcl_i]]} {
	source [file join {@LIBRARY_SRCDIR@} tclfddd.tcl_i]
    } else {
	source [file join {@LIBRARY_SRCDIR@} tclfddd.tcl]
    }
}
package ifneeded tclbdd::datalog @PACKAGE_VERSION@ {
    if {[file exists [file join {@LIBRARY_SRCDIR@} datalog.tcl_i]]} {
	source [file join {@LIBRARY_SRCDIR@} datalog.tcl_i]
    } else {
	source [file join {@LIBRARY_SRCDIR@} datalog.tcl]
    }
}

Added tests/datalog.test.







































































































































































































































































































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
# datalog.test --
#
#       Tests for the Datalog compiler.
#
# Copyright (c) 2014 by Kevin B. Kenny.

package require tcltest 2
namespace import -force ::tcltest::test
loadTestedCommands
package require tclbdd::datalog

proc init0 {} {
    variable people
    variable p
    set i 0
    set people {
	Andrew Anne Beatrice Charles Edward
	Elizabeth Eugenie George Harry
	James Louise William
    }
    foreach x $people {
	set p($x) $i
	incr i
    }	
    bdd::fddd::database create db \
	[bdd::fddd::interleave \
	     [bdd::fddd::domain p1 5 bigendian] \
	     [bdd::fddd::domain p2 5 bigendian] \
	     [bdd::fddd::domain p3 5 bigendian]]
    db relation isParentOf p1 p2
    db relation isGrandparentOf p1 p2
}

proc init1 {} {
    variable p
    init0
    interp alias {} loadIsParentOf {} {*}[db loader isParentOf]
    foreach {parent child} {
	Elizabeth Charles	Elizabeth Anne		Elizabeth Andrew
	Elizabeth Edward	Charles William		Charles Harry
	Andrew Beatrice		Andrew Eugenie		Edward Louise
	Edward James		William George
    } {
	loadIsParentOf $p($parent) $p($child)
    }
    rename loadIsParentOf {}
}

proc fini0 {} {
    variable people
    variable p
    db destroy
    catch {unset p}
    catch {unset people}
}
proc fini1 {} {
    fini0
}

test datalog-1.1 {assert a single fact and enumerate over it} {*}{
    -setup init0
    -body {
	proc t {parent child} [bdd::datalog::compileProgram db {
	} {
	    isParentOf($parent,$child).
	} {
	}]
	t $p(Elizabeth) $p(Charles)
	t $p(Charles) $p(William)
	set result {}
	db enumerate d isParentOf {
	    dict lappend result \
		[lindex $people [dict get $d p1]] \
		[lindex $people [dict get $d p2]]
	}
	list [dict get $result Elizabeth] [dict get $result Charles]
    }
    -result {Charles William}
    -cleanup fini0
}

test datalog-1.2 {assert a fact with a free var and enumerate over it} {*}{
    -setup init0
    -body {
	proc t {parent} [bdd::datalog::compileProgram db {
	} {
	    isParentOf($parent, _).
	} {
	}]
	t $p(Elizabeth)
	set result {}
	foreach name $people {
	    dict set need $name {}
	}
	db enumerate d isParentOf {
	    set p1 [dict get $d p1]
	    set name1 [lindex $people $p1]
	    set p2 [dict get $d p2]
	    if {$p2 >= [llength $people]} {
		set name2 $p2
	    } else {
		set name2 [lindex $people $p2]
	    }
	    lappend result $name1 $name2
	    if {$name1 ne {Elizabeth}} {
		return -level 0 -code error "Spurious parent $name1"
	    } else {
		dict unset need $name2
	    }
	}
	set need
    }
    -result {}
    -cleanup fini0
}

test datalog-1.3 {assert two facts} {*}{
    -setup init0
    -body {
	proc t {parent} [bdd::datalog::compileProgram db {
	} {
	    isParentOf(31, $parent).
	    "isParentOf"($parent, 30).
	} {
	}]
	t $p(Elizabeth)
	set result {}
	set need {}
	dict set need 31 $p(Elizabeth) {}
	dict set need $p(Elizabeth) 30 {}
	db enumerate d isParentOf {
	    set p1 [dict get $d p1]
	    set p2 [dict get $d p2]
	    if {[dict exists $need $p1 $p2]} {
		dict unset need $p1 $p2
	    } else {
		return -code error -level 0 "Spurious: $p1 $p2"
	    }
	}
	set result {}
	dict for {p1 d} $need {
	    dict for {p2 -} $d {
		return -code error -level 0 "Missing: $p1 $p2"
	    }
	}
	concat
    }
    -result {}
    -cleanup fini0
}

test datalog-2.1 {simple query} {*}{
    -setup init1
    -body {
	proc t {parent} [bdd::datalog::compileProgram db {
	    variable p
	    variable people
	    set p1 $p($parent)
	    set results {}
	} {
	    isParentOf($p1,p2)?
	} d {
	    lappend results [lindex $people [dict get $d p2]]
	} {
	    return [lsort $results]
	}]
	t Elizabeth
    }
    -cleanup fini1
    -result {Andrew Anne Charles Edward}
}

test datalog-3.1 {trivial rule} {
    -setup {
	init1
	db relation resultSet p2
    }
    -body {
	proc t {parent} [bdd::datalog::compileProgram db {
	    variable p
	    variable people
	    set p1 $p($parent)
	    set results {}
	} {
	    resultSet(p2) :- isParentOf($p1, p2).
	    resultSet(p2)?
	} d {
	    lappend results [lindex $people [dict get $d p2]]
	} {
	    lsort $results
	}]
	t Elizabeth
    }
    -cleanup fini1
    -result {Andrew Anne Charles Edward}
}

test datalog-3.2 {rule with inequality} {
    -setup {
	init1
	db relation isSiblingOf p1 p2
    }
    -body {
	proc t {} [bdd::datalog::compileProgram db {
	    variable p
	    variable people
	    set results {}
	} {
	    isSiblingOf(p1,p2) :- isParentOf(p3,p1), isParentOf(p3,p2), p1!=p2.
	    isSiblingOf(p1,p2)?
	} d {
	    lappend results \
		[lsort [list \
			    [lindex $people [dict get $d p1]] \
			    [lindex $people [dict get $d p2]]]]
	} {
	    lsort -unique $results
	}]
	t
    }
    -cleanup fini1
    -result {{Andrew Anne} {Andrew Charles} {Andrew Edward} {Anne Charles} {Anne Edward} {Beatrice Eugenie} {Charles Edward} {Harry William} {James Louise}}

}

test datalog-3.3 {rule with NOT} {*}{
    -setup {
	init1
	db relation hasParent p2
	db relation hasNoParent p2
    }
    -body {
	proc t {} [bdd::datalog::compileProgram db {
	    variable p
	    variable people
	    set results {}
	} {
	    hasParent(p2) :- isParentOf(_, p2).
	    hasNoParent(p2) :- !hasParent(p2).
	    hasNoParent(p2) ?
	} d {
	    set p2 [dict get $d p2]
	    if {$p2 < [llength $people]} {
		lappend result [lindex $people $p2]
	    }
	} {
	    lsort $result
	}]
	t
    }
    -cleanup fini1
    -result Elizabeth
}

test datalog-4.1 {simple recursion} {*}{
    -setup {
	init1
	db relation isAncestorOf p1 p2
    }
    -body {
	proc t {who} [bdd::datalog::compileProgram db {
	    variable p
	    variable people
	    set results {}
	    set p2 $p($who)
	} {
	    isAncestorOf(p1,p2) :- isParentOf(p1,p2).
	    isAncestorOf(p1,p2) :- isParentOf(p1,p3), isAncestorOf(p3,p2).
	    isAncestorOf(p1, $p2) ?
	} d {
	    set p1 [dict get $d p1]
	    if {$p1 < [llength $people]} {
		lappend result [lindex $people $p1]
	    }
	} {
	    lsort $result
	}]
	t George
    }
    -cleanup fini1
    -result {Charles Elizabeth William}
}

cleanupTests
return

# Local Variables:
# mode: tcl
# c-basic-offset: 4
# indent-tabs-mode: nil
# End: