1# Copyright (C) 1998 Free Software Foundation, Inc.
2
3# This program is free software; you can redistribute it and/or modify
4# it under the terms of the GNU General Public License as published by
5# the Free Software Foundation; either version 2 of the License, or
6# (at your option) any later version.
7#
8# This program is distributed in the hope that it will be useful,
9# but WITHOUT ANY WARRANTY; without even the implied warranty of
10# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
11# GNU General Public License for more details.
12#
13# You should have received a copy of the GNU General Public License
14# along with this program; if not, write to the Free Software
15# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
16
17# Please email any bugs, comments, and/or additions to this file to:
18# bug-gdb@prep.ai.mit.edu
19
20
21#
22# Support procedures for trace testing
23#
24
25
26#
27# Procedure: gdb_target_supports_trace
28# Returns true if GDB is connected to a target that supports tracing.
29# Allows tests to abort early if not running on a trace-aware target.
30#
31
32proc gdb_target_supports_trace { } {
33    global gdb_prompt
34
35    send_gdb "tstatus\n"
36    gdb_expect {
37	-re "\[Tt\]race can only be run on.*$gdb_prompt $" {
38	    return 0
39	}
40	-re "\[Tt\]race can not be run on.*$gdb_prompt $" {
41	    return 0
42	}
43	-re "\[Tt\]arget does not support.*$gdb_prompt $" {
44	    return 0
45	}
46	-re ".*\[Ee\]rror.*$gdb_prompt $" {
47	    return 0
48	}
49	-re ".*\[Ww\]arning.*$gdb_prompt $" {
50	    return 0
51	}
52	-re ".*$gdb_prompt $" {
53	    return 1
54	}
55	timeout {
56	    return 0
57	}
58    }
59}
60
61
62#
63# Procedure: gdb_delete_tracepoints
64# Many of the tests depend on setting tracepoints at various places and
65# running until that tracepoint is reached.  At times, we want to start
66# with a clean slate with respect to tracepoints, so this utility proc
67# lets us do this without duplicating this code everywhere.
68#
69
70proc gdb_delete_tracepoints {} {
71    global gdb_prompt
72
73    send_gdb "delete tracepoints\n"
74    gdb_expect 30 {
75	-re "Delete all tracepoints.*y or n.*$" {
76	    send_gdb "y\n";
77	    exp_continue
78	}
79	-re ".*$gdb_prompt $" { # This happens if there were no tracepoints }
80	timeout {
81	    perror "Delete all tracepoints in delete_tracepoints (timeout)"
82	    return
83	}
84    }
85    send_gdb "info tracepoints\n"
86    gdb_expect 30 {
87	 -re "No tracepoints.*$gdb_prompt $" {}
88	 -re "$gdb_prompt $" { perror "tracepoints not deleted" ; return }
89	 timeout { perror "info tracepoints (timeout)" ; return }
90    }
91}
92
93#
94# Procedure: gdb_trace_setactions
95#   Define actions for a tracepoint.
96#   Arguments:
97#	testname   -- identifying string for pass/fail output
98#	tracepoint -- to which tracepoint do these actions apply? (optional)
99#	args       -- list of actions to be defined.
100#   Returns:
101#	zero       -- success
102#	non-zero   -- failure
103
104proc gdb_trace_setactions { testname tracepoint args } {
105    global gdb_prompt;
106
107    set state 0;
108    set passfail "pass";
109    send_gdb "actions $tracepoint\n";
110    set expected_result "";
111    gdb_expect 5 {
112	-re "No tracepoint number .*$gdb_prompt $" {
113	    fail $testname
114	    return 1;
115	}
116	-re "Enter actions for tracepoint $tracepoint.*>" {
117	    if { [llength $args] > 0 } {
118		set lastcommand "[lindex $args $state]";
119		send_gdb "[lindex $args $state]\n";
120		incr state;
121		set expected_result [lindex $args $state];
122		incr state;
123	    } else {
124		send_gdb "end\n";
125	    }
126	    exp_continue;
127	}
128	-re "\(.*\)\[\r\n\]+\[ \t]*> $" {
129	    if { $expected_result != "" } {
130		regsub "^\[^\r\n\]+\[\r\n\]+" "$expect_out(1,string)" "" out;
131		if ![regexp $expected_result $out] {
132		    set passfail "fail";
133		}
134		set expected_result "";
135	    }
136	    if { $state < [llength $args] } {
137		send_gdb "[lindex $args $state]\n";
138		incr state;
139		set expected_result [lindex $args $state];
140		incr state;
141	    } else {
142		send_gdb "end\n";
143		set expected_result "";
144	    }
145	    exp_continue;
146	}
147	-re "\(.*\)$gdb_prompt $" {
148	    if { $expected_result != "" } {
149		if ![regexp $expected_result $expect_out(1,string)] {
150		    set passfail "fail";
151		}
152		set expected_result "";
153	    }
154	    if { [llength $args] < $state } {
155		set passfail "fail";
156	    }
157	}
158	default {
159	    set passfail "fail";
160	}
161    }
162    if { $testname != "" } {
163	$passfail $testname;
164    }
165    if { $passfail == "pass" } then {
166	return 0;
167    } else {
168	return 1;
169    }
170}
171
172#
173# Procedure: gdb_tfind_test
174#   Find a specified trace frame.
175#   Arguments:
176#	testname   -- identifying string for pass/fail output
177#	tfind_arg  -- frame (line, PC, etc.) identifier
178#	exp_res    -- Expected result of frame test
179#	args       -- Test expression
180#   Returns:
181#	zero       -- success
182#	non-zero   -- failure
183#
184
185proc gdb_tfind_test { testname tfind_arg exp_res args } {
186    global gdb_prompt;
187
188    if { "$args" != "" } {
189	set expr "$exp_res";
190	set exp_res "$args";
191    } else {
192	set expr "(int) \$trace_frame";
193    }
194    set passfail "fail";
195
196    gdb_test "tfind $tfind_arg" "" ""
197    send_gdb "printf \"x \%d x\\n\", $expr\n";
198    gdb_expect 10 {
199	-re "x (-*\[0-9\]+) x" {
200	    if { $expect_out(1,string) == $exp_res } {
201		set passfail "pass";
202	    }
203	    exp_continue;
204	}
205	-re "$gdb_prompt $" { }
206    }
207    $passfail "$testname";
208    if { $passfail == "pass" } then {
209	return 0;
210    } else {
211	return 1;
212    }
213}
214
215#
216# Procedure: gdb_readexpr
217#   Arguments:
218#	gdb_expr    -- the expression whose value is desired
219#   Returns:
220#	the value of gdb_expr, as evaluated by gdb.
221#       [FIXME: returns -1 on error, which is sometimes a legit value]
222#
223
224proc gdb_readexpr { gdb_expr } {
225    global gdb_prompt;
226
227    set result -1;
228    send_gdb "print $gdb_expr\n"
229    gdb_expect 5 {
230	-re "\[$\].*= (\[0-9\]+).*$gdb_prompt $" {
231	    set result $expect_out(1,string);
232	}
233	-re "$gdb_prompt $" { }
234	default { }
235    }
236    return $result;
237}
238
239#
240# Procedure: gdb_gettpnum
241#   Arguments:
242#	tracepoint (optional): if supplied, set a tracepoint here.
243#   Returns:
244#	the tracepoint ID of the most recently set tracepoint.
245#
246
247proc gdb_gettpnum { tracepoint } {
248    global gdb_prompt;
249
250    if { $tracepoint != "" } {
251	gdb_test "trace $tracepoint" "" ""
252    }
253    return [gdb_readexpr "\$tpnum"];
254}
255
256
257#
258# Procedure: gdb_find_function_baseline
259#   Arguments:
260#	func_name -- name of source function
261#   Returns:
262#	Sourcefile line of function definition (open curly brace),
263#	or -1 on failure.  Caller must check return value.
264#   Note:
265#	Works only for open curly brace at beginning of source line!
266#
267
268proc gdb_find_function_baseline { func_name } {
269    global gdb_prompt;
270
271    set baseline -1;
272
273    send_gdb "list $func_name\n"
274#    gdb_expect {
275#	-re "\[\r\n\]\[\{\].*$gdb_prompt $" {
276#	    set baseline 1
277#        }
278#    }
279}
280
281#
282# Procedure: gdb_find_function_baseline
283#   Arguments:
284#	filename: name of source file of desired function.
285#   Returns:
286#	Sourcefile line of function definition (open curly brace),
287#	or -1 on failure.  Caller must check return value.
288#   Note:
289#	Works only for open curly brace at beginning of source line!
290#
291
292proc gdb_find_recursion_test_baseline { filename } {
293    global gdb_prompt;
294
295    set baseline -1;
296
297    gdb_test "list $filename:1" "" ""
298    send_gdb "search gdb_recursion_test line 0\n"
299    gdb_expect {
300	-re "(\[0-9\]+)\[\t \]+\{.*line 0.*$gdb_prompt $" {
301	    set baseline $expect_out(1,string);
302	}
303	-re "$gdb_prompt $" { }
304	default { }
305    }
306    return $baseline;
307}
308