gdb_init argument ARGS is a string rather than a list
Commit Message
The argument ARGS of gdb_init is passed from dejagnu is a string, the
test file name. In dejagnu/runtest.exp:
proc runtest { test_file_name } {
....
....
if [info exists tool] {
if { [info procs "${tool}_init"] != "" } {
${tool}_init $test_file_name;
}
}
....
}
but GDB thinks it is a list. In default_gdb_init (callee of gdb_init),
set gdb_test_file_name [file rootname [file tail [lindex $args 0]]]
Fortunately, simple strings are also lists in tcl, so "[lindex $args 0]"
is equivalent to "$args" if args is a string.
I doubt that "[lindex $args 0]" is to be backward compatible with old
dejagnu, but dejagnu-1.4 release started to pass $test_file_name to
${too}_init, as I showed above. dejagnu-1.4 was released in 2001, and
it should be old enough. I also tried to check whether gdb testusite
works with dejagnu-1.3 or not, but failed to build dejagnu-1.3 on my
machine. Supposing GDB testsuite requires at least dejagnu-1.4, this
change should be safe.
This patch is update default_gdb_init to treat ARGS as a string instead
of a list. Then, 'args' sounds like a list, and this patch also renames
it by 'test_file_name', to align with dejagnu.
gdb/testsuite:
2014-05-09 Yao Qi <yao@codesourcery.com>
* lib/gdb.exp (default_gdb_init): Rename argument 'args' by
'test_file_name'. Treat args as a string instead of a list.
(gdb_init): Rename argument 'args' by 'test_file_name'.
---
gdb/testsuite/lib/gdb.exp | 16 ++++++----------
1 file changed, 6 insertions(+), 10 deletions(-)
Comments
>>>>> "Yao" == Yao Qi <yao@codesourcery.com> writes:
Yao> but GDB thinks it is a list. In default_gdb_init (callee of gdb_init),
Yao> set gdb_test_file_name [file rootname [file tail [lindex $args 0]]]
Yao> Fortunately, simple strings are also lists in tcl, so "[lindex $args 0]"
Yao> is equivalent to "$args" if args is a string.
The "args" parameter is special in Tcl. It signals a "rest" parameter
and so causes a single argument to be list-ified by the interpreter:
% proc l {args} { return [llength $args] }
% l {a b c}
1
% proc r {a} { return [llength $a] }
% r {a b c}
3
So while the current code is a bit odd, I think it is also
correct-enough.
Yao> - return [eval default_gdb_init $args]
Yao> + return [eval default_gdb_init $test_file_name]
If you want to proceed with this you will need to remove the "eval"
here.
Tom
@@ -3519,17 +3519,18 @@ proc gdb_continue { function } {
return [gdb_test "continue" ".*Breakpoint $decimal, $function .*" "continue to $function"]
}
-proc default_gdb_init { args } {
+proc default_gdb_init { test_file_name } {
global gdb_wrapper_initialized
global gdb_wrapper_target
global gdb_test_file_name
global cleanfiles
+ global pf_prefix
set cleanfiles {}
gdb_clear_suppressed
- set gdb_test_file_name [file rootname [file tail [lindex $args 0]]]
+ set gdb_test_file_name [file rootname [file tail $test_file_name]]
# Make sure that the wrapper is rebuilt
# with the appropriate multilib option.
@@ -3545,13 +3546,8 @@ proc default_gdb_init { args } {
match_max [match_max -d]
# We want to add the name of the TCL testcase to the PASS/FAIL messages.
- if { [llength $args] > 0 } {
- global pf_prefix
+ set pf_prefix "[file tail [file dirname $test_file_name]]/[file tail $test_file_name]:"
- set file [lindex $args 0]
-
- set pf_prefix "[file tail [file dirname $file]]/[file tail $file]:"
- }
global gdb_prompt
if [target_info exists gdb_prompt] {
set gdb_prompt [target_info gdb_prompt]
@@ -3687,7 +3683,7 @@ set banned_procedures { strace }
# if the banned variables and procedures are already traced.
set banned_traced 0
-proc gdb_init { args } {
+proc gdb_init { test_file_name } {
# Reset the timeout value to the default. This way, any testcase
# that changes the timeout value without resetting it cannot affect
# the timeout used in subsequent testcases.
@@ -3766,7 +3762,7 @@ proc gdb_init { args } {
set gdbserver_reconnect_p 1
unset gdbserver_reconnect_p
- return [eval default_gdb_init $args]
+ return [eval default_gdb_init $test_file_name]
}
proc gdb_finish { } {