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 Tom de Vries * lib/gdb.exp (gdb_known_globals, gdb_persistent_globals): New global. (gdb_persistent_global, gdb_persistent_global_no_decl): 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. --- gdb/testsuite/lib/gdb.exp | 90 +++++++++++++++++++++++++++++++++++++++++++- gdb/testsuite/lib/pascal.exp | 8 ++-- 2 files changed, 93 insertions(+), 5 deletions(-) diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp index e7fce6fee0..f502eb157d 100644 --- a/gdb/testsuite/lib/gdb.exp +++ b/gdb/testsuite/lib/gdb.exp @@ -28,6 +28,57 @@ if {$tool == ""} { # List of procs to run in gdb_finish. set gdb_finish_hooks [list] +# Variable in which we keep track of globals that are allowed to be live +# across test-cases. +array set gdb_persistent_globals {} + +# Mark variable names in ARG as a persistent global, and declare them as +# global in the calling context. Can be used to rewrite "global var_a var_b" +# into "gdb_persistent_global var_a var_b". +proc gdb_persistent_global { args } { + global gdb_persistent_globals + foreach varname $args { + uplevel 1 global $varname + set gdb_persistent_globals($varname) 1 + } +} + +# Mark variable names in ARG as a persistent global. +proc gdb_persistent_global_no_decl { args } { + global gdb_persistent_globals + foreach varname $args { + 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_no_decl $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 +5145,38 @@ 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 + } + 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 @@ -5198,6 +5281,8 @@ proc gdb_init { test_file_name } { set res [default_gdb_init $test_file_name] + gdb_setup_known_globals + # Dejagnu overrides proc unknown. The dejagnu version may trigger in a # test-case but abort the entire test run. To fix this, we install a # local version here, which reverts dejagnu's override, and restore @@ -5215,6 +5300,7 @@ proc gdb_finish { } { global gdbserver_reconnect_p global gdb_prompt global cleanfiles + global known_globals # Restore dejagnu's version of proc unknown. rename ::unknown "" @@ -5250,6 +5336,8 @@ proc gdb_finish { } { $gdb_finish_hook } set gdb_finish_hooks [list] + + gdb_cleanup_globals } global debug_format @@ -6957,7 +7045,7 @@ proc gdbserver_debug_enabled { } { # Open the file for logging gdb input proc gdb_stdin_log_init { } { - global in_file + gdb_persistent_global in_file if {[info exists in_file]} { # Close existing file. diff --git a/gdb/testsuite/lib/pascal.exp b/gdb/testsuite/lib/pascal.exp index aad69a2de0..ff11864294 100644 --- a/gdb/testsuite/lib/pascal.exp +++ b/gdb/testsuite/lib/pascal.exp @@ -33,10 +33,10 @@ set pascal_init_done 0 proc pascal_init {} { global pascal_init_done - global pascal_compiler_is_gpc - global pascal_compiler_is_fpc - global gpc_compiler - global fpc_compiler + gdb_persistent_global pascal_compiler_is_gpc + gdb_persistent_global pascal_compiler_is_fpc + gdb_persistent_global gpc_compiler + gdb_persistent_global fpc_compiler global env if { $pascal_init_done == 1 } {