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
|
# me_cpucore.test: Tests for the ME virtual machine -*- tcl -*-
#
# This file contains a collection of tests for one or more of the
# commands making up the ME virtual machine. Sourcing this file into
# Tcl runs the tests and generates output for errors. No output means
# no errors were found.
#
# Copyright (c) 2005-2006 Andreas Kupries <andreas_kupries@users.sourceforge.net>
# All rights reserved.
#
# RCS: @(#) $Id: me_cpu.test,v 1.3 2006/10/09 21:41:40 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 {
use fileutil/fileutil.tcl fileutil
useLocal me_cpucore.tcl grammar::me::cpu::core
}
testing {
useLocalKeep me_cpu.tcl grammar::me::cpu
}
# -------------------------------------------------------------------------
snitErrors
proc cpustate {cpu} {
set vstate {}
lappend vstate cd [$cpu code ]
lappend vstate pc [$cpu pc ]
lappend vstate ht [$cpu halted]
lappend vstate eo [$cpu iseof ]
lappend vstate tc [$cpu tok ]
lappend vstate at [$cpu at ]
lappend vstate cc [$cpu cc ]
lappend vstate ok [$cpu ok ]
lappend vstate sv [$cpu sv ]
lappend vstate er [$cpu error ]
lappend vstate ls [$cpu lstk ]
lappend vstate as [$cpu astk ]
lappend vstate ms [$cpu mstk ]
lappend vstate es [$cpu estk ]
lappend vstate rs [$cpu rstk ]
lappend vstate nc [$cpu nc ]
return $vstate
}
proc cpudelta {prev now} {
array set _ {}
foreach {k v} $prev {
set _($k) $v
}
set res {}
foreach {k v} $now {
if {[info exists _($k)] && ($_($k) eq $v)} continue
lappend res $k $v
}
return $res
}
proc cpufstate {vstate} {
set res {}
foreach {k v} $vstate {lappend res [list $k $v]}
join $res \n
}
proc cpusubst {vstate args} {
array set _ $vstate
foreach {k v} $args {set _($k) $v}
set res {}
foreach k {cd pc ht eo tc at cc ok sv er ls as ms es rs nc} {
if {![info exists _($k)]} continue
lappend res $k $_($k)
}
return $res
}
proc cpufilter {vstate args} {
array set _ $vstate
set res {}
foreach k $args { lappend res $k $_($k) }
return $res
}
proc canon_code {code} {
foreach {i p t} $code break
# Sorting the token map, canonical rep for direct comparison
return [list $i $p [dictsort $t]]
}
# -------------------------------------------------------------------------
set asm_table [string trimright \
[fileutil::cat \
[localPath me_cpucore.tests.asm-map.txt]]]
set badmach_table [string trimright \
[fileutil::cat \
[localPath me_cpucore.tests.badmach-map.txt]]]
set semantics [string trimright \
[fileutil::cat \
[localPath me_cpucore.tests.semantics.txt]]]
# -------------------------------------------------------------------------
# In this section we run all the tests depending on a grammar::me::cpu::core,
# and thus have to test all the available implementations.
set tests [file join [file dirname [info script]] me_cpu.testsuite]
#catch {memory validate on}
set impl tcl
set usec [time {source $tests} 1]
if 0 {
foreach impl [grammar::me::cpu::core::Implementations] {
grammar::me::cpu::core::SwitchTo $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 grammar::me::cpu::core
set usec [time {source $tests} 1]
#puts "$impl:\t$usec"
}
}
catch {memory validate off}
unset usec
unset tests
#puts ""
# Reset system to fully inactive state.
# grammar::me::cpu::core::SwitchTo {}
# -------------------------------------------------------------------------
# ### ### ### ######### ######### #########
## Cleanup and statistics.
rename cpustate {}
rename cpufstate {}
rename cpudelta {}
rename cpufilter {}
rename canon_code {}
unset asm_table badmach_table semantics
testsuiteCleanup
|
