gdb_init argument ARGS is a string rather than a list

Message ID 1399626515-29231-1-git-send-email-yao@codesourcery.com
State Deferred
Headers

Commit Message

Yao Qi May 9, 2014, 9:08 a.m. UTC
  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

Tom Tromey May 15, 2014, 6:17 p.m. UTC | #1
>>>>> "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
  

Patch

diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp
index 3125e7a..aec86cd 100644
--- a/gdb/testsuite/lib/gdb.exp
+++ b/gdb/testsuite/lib/gdb.exp
@@ -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 { } {