Re: [PATCH 3/3][gdb/testsuite] Warn about leaked global array

[Tom de Vries <tdevries@suse.de>]

[-- Attachment #1: Type: text/plain, Size: 1612 bytes --]

On 03-06-2020 14:54, Andrew Burgess wrote:
> * Tom de Vries <tdevries@suse.de> [2020-06-03 12:24:09 +0200]:
> 
>> On 03-06-2020 12:09, Tom de Vries wrote:
>>> On 03-06-2020 11:38, Tom de Vries wrote:
>>>> On 03-06-2020 10:47, Tom de Vries wrote:
>>>>> ERROR: can't read "mi_gdb_prompt": no such variable
>>>>>     while executing
>>>>> "expect {
>>>>> -i exp95 -timeout 10
>>>>>         -re "~\"GNU.*\r\n~\".*$mi_gdb_prompt$" {
>>>>>             # We have a new format mi startup prompt.  If we are
>>>>>             # running mi1,..."
>>>>>     ("uplevel" body line 1)
>>>>>     invoked from within
>>>>> "uplevel $body" TCL READ VARNAME can't read "mi_gdb_prompt": no such
>>>>> variable
>>>>
>>>> So, the following happens:
>>>> - a test-case imports mi-support.exp using load_lib
>>>> - mi-support.exp sets mi_gdb_prompt
>>>> - the test-case finishes and the new global mi_gdb_prompt is unset,
>>>>   because it was not set before the test-case
>>>> - a next test-case imports mi-support.exp using load_lib
>>>> - load_lib sees that the file already has been loaded, so it skips it
>>>> - mi_gdb_prompt remains unset
>>>> - the test-case uses mi_gdb_prompt, and we have an error.
> 
> I couldn't work out why my testing was going fine if this problem
> exists... then I realised that my testing script was causing the tests
> to run in parallel!
> 
> I like the load_lib override solution.  I think a solution that avoids
> having to place each test into a new namespace would be a good thing
> if we can pull it off.
> 

I've tested this with runtest -v, I'm currently re-testing without -v.

Thanks,
- Tom

[-- Attachment #2: 0001-gdb-testsuite-Prevent-globals-leaking-between-test-scripts.patch --]
[-- Type: text/x-patch, Size: 6431 bytes --]

gdb/testsuite: Prevent globals leaking between test scripts

Many of the test scripts create variables in the global namespace,
these variables will then be present for the following test scripts.
In most cases this is harmless, but in some cases this can cause
problems.

For example, if a variable is created as an array in one script, but
then assigned as a scalar in a different script, this will cause a TCL
error.

The solution proposed in this patch is to have the GDB test harness
record a list of all known global variables at the point just before
we source the test script.  Then, after the test script has run, we
again iterate over all global variables.  Any variable that was not in
the original list is deleted, unless it was marked as a persistent global
variable using gdb_persistent_global.

The assumption here is that no test script should need to create a
global variable that will outlive the lifetime of the test script
itself.  With this patch in place all tests currently seem to pass, so
the assumption seems to hold.

gdb/testsuite/ChangeLog:

2020-06-03  Andrew Burgess  <andrew.burgess@embecosm.com>
	    Tom de Vries  <tdevries@suse.de>

	* lib/gdb.exp (gdb_known_globals, gdb_persistent_globals): New global.
	(gdb_persistent_global): New proc.
	(gdb_setup_known_globals): New proc.
	(gdb_cleanup_globals): New proc.
	* lib/gdb.exp (load_lib): New override proc.
	(gdb_stdin_log_init): Set var in_file as persistent global.
	* lib/pascal.exp (gdb_stdin_log_init): Set vars
	pascal_compiler_is_gpc, pascal_compiler_is_fpc, gpc_compiler and
	fpc_compiler as persistent global.
	* lib/tuiterm.exp (spawn): Don't assume gdb_spawn_name is set.

---
 gdb/testsuite/lib/gdb.exp     | 79 ++++++++++++++++++++++++++++++++++++++++++-
 gdb/testsuite/lib/pascal.exp  |  4 +++
 gdb/testsuite/lib/tuiterm.exp |  4 ++-
 3 files changed, 85 insertions(+), 2 deletions(-)

diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp
index 444cea01c3..45e90a55b0 100644
--- a/gdb/testsuite/lib/gdb.exp
+++ b/gdb/testsuite/lib/gdb.exp
@@ -25,6 +25,44 @@ if {$tool == ""} {
     exit 2
 }
 
+# Variable in which we keep track of globals that are allowed to be live
+# across test-cases.
+array set gdb_persistent_globals {}
+
+# Mark variable with name VARNAME as a persistent global.
+proc gdb_persistent_global { varname } {
+    global gdb_persistent_globals
+    set gdb_persistent_globals($varname) 1
+}
+
+# Override proc load_lib.
+rename load_lib saved_load_lib
+# Run the runtest version of load_lib, and mark all variables that were
+# created by this call as persistent.
+proc load_lib { file } {
+    array set known_global {}
+    foreach varname [info globals] {
+       set known_globals($varname) 1
+    }
+
+    set code [catch "saved_load_lib $file" result]
+
+    foreach varname [info globals] {
+       if { ![info exists known_globals($varname)] } {
+           gdb_persistent_global $varname
+       }
+    }
+
+    if {$code == 1} {
+	global errorInfo errorCode
+	return -code error -errorinfo $errorInfo -errorcode $errorCode $result
+    } elseif {$code > 1} {
+	return -code $code $result
+    }
+
+    return $result
+}
+
 load_lib libgloss.exp
 load_lib cache.exp
 load_lib gdb-utils.exp
@@ -5094,6 +5132,39 @@ set banned_procedures { strace }
 # if the banned variables and procedures are already traced.
 set banned_traced 0
 
+# Global array that holds the name of all global variables at the time
+# a test script is started.  After the test script has completed any
+# global not in this list is deleted.
+array set gdb_known_globals {}
+
+# Setup the GDB_KNOWN_GLOBALS array with the names of all current
+# global variables.
+proc gdb_setup_known_globals {} {
+    global gdb_known_globals
+
+    array set gdb_known_globals {}
+    foreach varname [info globals] {
+	set gdb_known_globals($varname) 1
+    }
+}
+
+# Cleanup the global namespace.  Any global not in the
+# GDB_KNOWN_GLOBALS array is unset, this ensures we don't "leak"
+# globals from one test script to another.
+proc gdb_cleanup_globals {} {
+    global gdb_known_globals gdb_persistent_globals
+
+    foreach varname [info globals] {
+	if {![info exists gdb_known_globals($varname)]} {
+	    if { [info exists gdb_persistent_globals($varname)] } {
+		continue
+	    }
+	    verbose -log "gdb_cleanup_globals: deleting $varname"
+	    uplevel #0 unset $varname
+	}
+    }
+}
+
 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
@@ -5196,13 +5267,16 @@ proc gdb_init { test_file_name } {
     global gdb_instances
     set gdb_instances 0
 
-    return [default_gdb_init $test_file_name]
+    set result [default_gdb_init $test_file_name]
+    gdb_setup_known_globals
+    return $result
 }
 
 proc gdb_finish { } {
     global gdbserver_reconnect_p
     global gdb_prompt
     global cleanfiles
+    global known_globals
 
     # Exit first, so that the files are no longer in use.
     gdb_exit
@@ -5228,6 +5302,8 @@ proc gdb_finish { } {
 	}
 	set banned_traced 0
     }
+
+    gdb_cleanup_globals
 }
 
 global debug_format
@@ -6944,6 +7020,7 @@ proc gdb_stdin_log_init { } {
 
     set logfile [standard_output_file_with_gdb_instance gdb.in]
     set in_file [open $logfile w]
+    gdb_persistent_global in_file
 }
 
 # Write to the file for logging gdb input.
diff --git a/gdb/testsuite/lib/pascal.exp b/gdb/testsuite/lib/pascal.exp
index aad69a2de0..95e3e637aa 100644
--- a/gdb/testsuite/lib/pascal.exp
+++ b/gdb/testsuite/lib/pascal.exp
@@ -47,6 +47,10 @@ proc pascal_init {} {
     set pascal_compiler_is_fpc 0
     set gpc_compiler [transform gpc]
     set fpc_compiler [transform fpc]
+    gdb_persistent_global pascal_compiler_is_gpc
+    gdb_persistent_global pascal_compiler_is_fpc
+    gdb_persistent_global gpc_compiler
+    gdb_persistent_global fpc_compiler
 
     if ![is_remote host] {
 	if { [info exists env(GPC)] } {
diff --git a/gdb/testsuite/lib/tuiterm.exp b/gdb/testsuite/lib/tuiterm.exp
index 8c9f97af6e..8f82ea5f5c 100644
--- a/gdb/testsuite/lib/tuiterm.exp
+++ b/gdb/testsuite/lib/tuiterm.exp
@@ -27,7 +27,9 @@ proc spawn {args} {
     if { [info exists spawn_out] } {
 	set gdb_spawn_name $spawn_out(slave,name)
     } else {
-	unset gdb_spawn_name
+	if { [info exists gdb_spawn_name] } {
+	    unset gdb_spawn_name
+	}
     }
     return $result
 }