gdb_init argument ARGS is a string rather than a list

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 inn default_gdb_init (callee of gdb_init), we have

    set gdb_test_file_name [file rootname [file tail [lindex $args 0]]]

In tcl, all actual arguments are combined to a list and assigned to
args.  This code here isn't wrong, but unnecessary, because its caller
(proc runtest) only passes one string to it, and IMO, we don't need
such tricky tcl "args".

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-20  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'.
This commit is contained in:
Yao Qi 2014-05-09 11:01:07 +08:00
parent f2205de008
commit 73c9764f95
2 changed files with 12 additions and 10 deletions

View File

@ -1,3 +1,9 @@
2014-05-20 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'.
2014-05-19 Jan Kratochvil <jan.kratochvil@redhat.com> 2014-05-19 Jan Kratochvil <jan.kratochvil@redhat.com>
* gdb.arch/powerpc-power.exp: New file. * gdb.arch/powerpc-power.exp: New file.

View File

@ -3519,17 +3519,18 @@ proc gdb_continue { function } {
return [gdb_test "continue" ".*Breakpoint $decimal, $function .*" "continue to $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_initialized
global gdb_wrapper_target global gdb_wrapper_target
global gdb_test_file_name global gdb_test_file_name
global cleanfiles global cleanfiles
global pf_prefix
set cleanfiles {} set cleanfiles {}
gdb_clear_suppressed 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 # Make sure that the wrapper is rebuilt
# with the appropriate multilib option. # with the appropriate multilib option.
@ -3545,13 +3546,8 @@ proc default_gdb_init { args } {
match_max [match_max -d] match_max [match_max -d]
# We want to add the name of the TCL testcase to the PASS/FAIL messages. # We want to add the name of the TCL testcase to the PASS/FAIL messages.
if { [llength $args] > 0 } { set pf_prefix "[file tail [file dirname $test_file_name]]/[file tail $test_file_name]:"
global pf_prefix
set file [lindex $args 0]
set pf_prefix "[file tail [file dirname $file]]/[file tail $file]:"
}
global gdb_prompt global gdb_prompt
if [target_info exists gdb_prompt] { if [target_info exists gdb_prompt] {
set gdb_prompt [target_info 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. # if the banned variables and procedures are already traced.
set banned_traced 0 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 # Reset the timeout value to the default. This way, any testcase
# that changes the timeout value without resetting it cannot affect # that changes the timeout value without resetting it cannot affect
# the timeout used in subsequent testcases. # the timeout used in subsequent testcases.
@ -3766,7 +3762,7 @@ proc gdb_init { args } {
set gdbserver_reconnect_p 1 set gdbserver_reconnect_p 1
unset gdbserver_reconnect_p unset gdbserver_reconnect_p
return [eval default_gdb_init $args] return [default_gdb_init $test_file_name]
} }
proc gdb_finish { } { proc gdb_finish { } {