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
|
# Copyright (C) 1992 - 2002, 2003 Free Software Foundation, Inc.
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
# Please email any bugs, comments, and/or additions to this file to:
# bug-dejagnu@gnu.org
#
# Setup an environment so we can execute library procs without DejaGnu
#
#
# Create a default environment and start expect.
#
proc make_defaults_file { defs } {
global srcdir
global objdir
global subdir
global build_triplet
global host_triplet
global target_triplet
global target_os
global target_cpu
# We need to setup default values and a few default procs so we
# can execute library code without DejaGnu
set fd [open $defs w]
puts ${fd} "set tool foobar"
puts ${fd} "set srcdir ${srcdir}"
puts ${fd} "set objdir ${objdir}"
puts ${fd} "set subdir ${subdir}"
puts ${fd} "set build_triplet ${build_triplet}"
puts ${fd} "set host_triplet ${host_triplet}"
puts ${fd} "set target_triplet ${target_triplet}"
puts ${fd} "set target_os ${target_os}"
puts ${fd} "set target_cpu ${target_cpu}"
puts ${fd} "set tool foobar"
puts ${fd} "set testcnt 0"
puts ${fd} "set warncnt 0"
puts ${fd} "set errcnt 0"
puts ${fd} "set passcnt 0"
puts ${fd} "set xpasscnt 0"
puts ${fd} "set kpasscnt 0"
puts ${fd} "set failcnt 0"
puts ${fd} "set xfailcnt 0"
puts ${fd} "set kfailcnt 0"
puts ${fd} "set prms_id 0"
puts ${fd} "set bug_id 0"
puts ${fd} "set exit_status 0"
puts ${fd} "set untestedcnt 0"
puts ${fd} "set unresolvedcnt 0"
puts ${fd} "set unsupportedcnt 0"
puts ${fd} "set xfail_flag 0"
puts ${fd} "set xfail_prms 0"
puts ${fd} "set kfail_flag 0"
puts ${fd} "set kfail_prms 0"
puts ${fd} "set mail_logs 0"
puts ${fd} "set multipass_name 0"
catch "close $fd"
}
proc start_expect { } {
global spawn_id
global base_dir
# We need to setup default values and a few default procs so we
# can execute library code without DejaGnu
set defaults_file setval.tmp
make_defaults_file $defaults_file
set fd [open ${defaults_file} w]
# look for expect
if ![info exists EXPECT] {
set EXPECT [findfile $base_dir/../../expect/expect "$base_dir/../../expect/expect" expect]
verbose "EXPECT defaulting to $EXPECT" 2
}
# catch close
# catch wait
# Start expect runing
spawn "$EXPECT"
expect {
-re "expect.*> " {
verbose "Started the child expect shell" 2
}
timeout {
perror "Timed out starting the child expect shell."
return -1
}
}
# Load the defaults file
exp_send "source ${defaults_file}\n"
expect {
"expect*> " {
verbose "Loaded testing defaults file." 2
return 1
}
timeout {
perror "Couldn't load the testing defaults file."
return -1
}
}
}
#
# Stop the runing expect process
#
proc stop_expect { } {
global spawn_id
# make expect exit
exp_send "exit\n"
catch "close -i $spawn_id"
catch "wait -i $spawn_id"
}
#
# Load the library to test
#
proc load_test_lib { lib } {
global spawn_id
exp_send "source ${lib}\n"
expect {
"expect*> " {
verbose "Testing ${lib}" 2
}
timeout {
perror "Couldn't load the libraries to test"
return -1
}
}
}
#
# test a library proc that emits patterns
#
proc exp_test { cmd pattern msg } {
global spawn_id
exp_send "puts ACK ; $cmd ; puts NAK\r\n"
expect {
"puts ACK*puts NAK" {
verbose "Got command echo" 3
}
timeout {
warning "Never got command echo"
}
}
expect {
"ACK" {
exp_continue
}
-re "\r\n1\r\n" {
warning "$msg, 1 was returned"
exp_continue
}
-re "\r\n0\r\n" {
warning "$msg, 0 was returned"
exp_continue
}
"$pattern" {
pass "$msg"
}
timeout {
fail "$msg"
}
}
}
# test a config proc that only returns a code
# ex... config_test "isbuild $build_triplet" "pass" "fail" "isbuild, native"
# args are: command, true condition, false condition, message to print
proc config_test { cmd true false msg } {
global spawn_id
set timeout 20
exp_send "puts ACK ; puts \[$cmd\] ; puts NAK\r\n"
expect {
"puts ACK*$cmd*puts NAK" {
verbose "Got command echo" 3
}
timeout {
warning "Never got command echo"
}
}
expect {
-re "Checking pattern*with*\[\r\n\]" {
exp_continue
}
-re "\r\n1\r\n" {
$true "$msg"
}
-re "\r\n0\r\n" {
$false "$msg"
}
timeout {
perror "$msg (timed out)"
}
}
}
|
