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
|
# me_util.test: tests for the AST utilities -*- tcl -*-
#
# This file contains a collection of tests for one or more of the Tcl
# built-in commands. Sourcing this file into Tcl runs the tests and
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 2005 Andreas Kupries <andreas_kupries@users.sourceforge.net>
# All rights reserved.
#
# RCS: @(#) $Id: me_util.test,v 1.7 2007/08/01 22:49:26 andreas_kupries Exp $
# -------------------------------------------------------------------------
source [file join \
[file dirname [file dirname [file join [pwd] [info script]]]] \
devtools testutilities.tcl]
testsNeedTcl 8.5
testsNeedTcltest 2.1
support {
useAccel [useTcllibC] struct/tree.tcl struct::tree
TestAccelInit struct::tree
}
testing {
useLocal me_util.tcl grammar::me::util
}
# -------------------------------------------------------------------------
# -------------------------------------------------------------------------
## Pre-requisites. An AST value and various serializations of plain
## and extended tree representations of the same AST. Plus helper
## commands for the checking of trees for structural equality.
set ast {a 0 56 {{} 3 15} {b 16 40 {d 16 20} {{} 21 40}} {c 41 56}}
set serial_0 {
root {} {}
node0 0 {type nonterminal detail a range {0 56}}
node1 3 {type terminal range {3 15}}
node2 3 {type nonterminal detail b range {16 40}}
node3 3 {type nonterminal detail c range {41 56}}
node4 9 {type nonterminal detail d range {16 20}}
node5 9 {type terminal range {21 40}}
}
set serial_0a {
node0 {} {type nonterminal detail a range {0 56}}
node1 0 {type terminal range {3 15}}
node2 0 {type nonterminal detail b range {16 40}}
node3 0 {type nonterminal detail c range {41 56}}
node4 6 {type nonterminal detail d range {16 20}}
node5 6 {type terminal range {21 40}}
}
set serial_1 {
root {} {}
foo 0 {}
node0 3 {type nonterminal detail a range {0 56}}
node1 6 {type terminal range {3 15}}
node2 6 {type nonterminal detail b range {16 40}}
node3 6 {type nonterminal detail c range {41 56}}
node4 12 {type nonterminal detail d range {16 20}}
node5 12 {type terminal range {21 40}}
}
set serial_2 {
root {} {}
node0 0 {type nonterminal detail a range {0 56} range_lc {{l0 c0} {l56 c56}}}
node1 3 {type terminal range {3 15} range_lc {{l3 c3} {l15 c15}} detail {{T3 l3 c3 L3} {T4 l4 c4 L4} {T5 l5 c5 L5} {T6 l6 c6 L6} {T7 l7 c7 L7} {T8 l8 c8 L8} {T9 l9 c9 L9} {T10 l10 c10 L10} {T11 l11 c11 L11} {T12 l12 c12 L12} {T13 l13 c13 L13} {T14 l14 c14 L14} {T15 l15 c15 L15}}}
node2 3 {type nonterminal detail b range {16 40} range_lc {{l16 c16} {l40 c40}}}
node3 3 {type nonterminal detail c range {41 56} range_lc {{l41 c41} {l56 c56}}}
node4 9 {type nonterminal detail d range {16 20} range_lc {{l16 c16} {l20 c20}}}
node5 9 {type terminal range {21 40} range_lc {{l21 c21} {l40 c40}} detail {{T21 l21 c21 L21} {T22 l22 c22 L22} {T23 l23 c23 L23} {T24 l24 c24 L24} {T25 l25 c25 L25} {T26 l26 c26 L26} {T27 l27 c27 L27} {T28 l28 c28 L28} {T29 l29 c29 L29} {T30 l30 c30 L30} {T31 l31 c31 L31} {T32 l32 c32 L32} {T33 l33 c33 L33} {T34 l34 c34 L34} {T35 l35 c35 L35} {T36 l36 c36 L36} {T37 l37 c37 L37} {T38 l38 c38 L38} {T39 l39 c39 L39} {T40 l40 c40 L40}}}
}
set serial_2a {
node0 {} {type nonterminal detail a range {0 56}}
node1 0 {type terminal range {3 15}}
node2 0 {type nonterminal detail b range {16 40}}
node3 0 {type nonterminal detail c range {41 56}}
node4 6 {type nonterminal detail d range {16 20}}
node5 6 {type terminal range {21 40}}
}
set serial_3 {
root {} {}
foo 0 {}
node0 3 {type nonterminal detail a range {0 56} range_lc {{l0 c0} {l56 c56}}}
node1 6 {type terminal range {3 15} range_lc {{l3 c3} {l15 c15}} detail {{T3 l3 c3 L3} {T4 l4 c4 L4} {T5 l5 c5 L5} {T6 l6 c6 L6} {T7 l7 c7 L7} {T8 l8 c8 L8} {T9 l9 c9 L9} {T10 l10 c10 L10} {T11 l11 c11 L11} {T12 l12 c12 L12} {T13 l13 c13 L13} {T14 l14 c14 L14} {T15 l15 c15 L15}}}
node2 6 {type nonterminal detail b range {16 40} range_lc {{l16 c16} {l40 c40}}}
node3 6 {type nonterminal detail c range {41 56} range_lc {{l41 c41} {l56 c56}}}
node4 12 {type nonterminal detail d range {16 20} range_lc {{l16 c16} {l20 c20}}}
node5 12 {type terminal range {21 40} range_lc {{l21 c21} {l40 c40}} detail {{T21 l21 c21 L21} {T22 l22 c22 L22} {T23 l23 c23 L23} {T24 l24 c24 L24} {T25 l25 c25 L25} {T26 l26 c26 L26} {T27 l27 c27 L27} {T28 l28 c28 L28} {T29 l29 c29 L29} {T30 l30 c30 L30} {T31 l31 c31 L31} {T32 l32 c32 L32} {T33 l33 c33 L33} {T34 l34 c34 L34} {T35 l35 c35 L35} {T36 l36 c36 L36} {T37 l37 c37 L37} {T38 l38 c38 L38} {T39 l39 c39 L39} {T40 l40 c40 L40}}}
}
proc tree_equal {ta tb} {
set tna [llength [$ta nodes]]
set tnb [llength [$tb nodes]]
if {$tna != $tnb} {
puts "sizes: $ta n = $tna != $tnb = $tb n"
return 0
}
node_equal $ta $tb [$ta rootname] [$tb rootname]
}
proc node_equal {ta tb na nb} {
if {[dictsort [$ta getall $na]] ne [dictsort [$tb getall $nb]]} {
puts "attr delta $ta $na: [dictsort [$ta getall $na]]\n $tb $nb: [dictsort [$tb getall $nb]]"
return 0
}
if {[$ta numchildren $na] != [$tb numchildren $nb]} {
puts "#c $na / $nb: [$ta numchildren $na] != [$tb numchildren $nb]"
return 0
}
foreach ca [$ta children $na] cb [$tb children $nb] {
if {![node_equal $ta $tb $ca $cb]} {
return 0
}
}
return 1
}
proc tsdump {ser} {
set line {}
foreach {a b c} $ser {
lappend line [list $a $b $c]
}
return \t[join $line \n\t]
}
# -------------------------------------------------------------------------
# In this section we run all the tests depending on a struct::tree,
# and thus have to test all the available implementations.
set tests [file join [file dirname [info script]] me_util.testsuite]
#catch {memory validate on}
TestAccelDo struct::tree impl {
# The global variable 'impl' is part of the public API the
# testsuit (in htmlparse_tree.testsuite) can expect from the
# environment.
namespace import -force struct::tree
set usec [time {source $tests} 1]
#puts "$impl:\t$usec"
}
catch {memory validate off}
unset usec
unset tests
# -------------------------------------------------------------------------
## Cleanup and statistics.
rename tree_equal {}
rename node_equal {}
rename tsdump {}
TestAccelExit struct::tree
testsuiteCleanup
|
