Re: [PATCH] gdb_init argument ARGS is a string rather than a list

[Yao Qi <yao@codesourcery.com>]

On 05/16/2014 02:17 AM, Tom Tromey wrote:
> 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.

Tom,
I didn't realize "args" is a special one.  Thanks for pointing this out.
The code is correct, but using "args" isn't necessary, because caller
(proc runtest) only passes one string to it.

> 
> 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.

I want to proceed with this since it simplifies code in default_gdb_init.
"eval" is removed in the updated patch.

-- 
Yao (齐尧)

Subject: [PATCH] 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-19  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(-)

diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp
index 3125e7a..a34ab3a 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 [default_gdb_init $test_file_name]
 }
 
 proc gdb_finish { } {
-- 
1.9.0