[3/3,gdb/testsuite] Warn about leaked global array

Message ID 20200519163004.GA9045@delia
State New
Headers show
Series
  • [1/3,gdb/testsuite] Fix global array cp_class_table_history leak
Related show

Commit Message

Tom de Vries May 19, 2020, 4:30 p.m.
Hi,

A variable name cannot be used both as scalar and array without an
intermediate unset.  Trying to do so will result in tcl errors, for
example, for:
...
  set var "bla"
  set var(1) "bla"
...
we get:
...
  can't set "var(1)": variable isn't array
...
and for the reverse statement order we get:
...
  can't set "var": variable is array
...

So, since a global name in one test-case can leak to another
test-case, setting a global name in one test-case can result in
a tcl error in another test-case that reuses the name in a different
way.

Warn about leaking a global array from a test-case.

Also, add a possibility to skip the warning in a given test-case using
variable gdb_skip_check_global_vars, and use it in gdb.mi/mi2-var-child.exp
and gdb.mi/mi-var-cp.exp.

Tested on x86_64-linux.

Any comments?

Thanks,
- Tom

[gdb/testsuite] Warn about leaked global array

gdb/testsuite/ChangeLog:

2020-05-18  Tom de Vries  <tdevries@suse.de>

	PR testsuite/25996
	* lib/gdb.exp (global_array_exists, global_unset, save_global_vars)
	(check_global_vars): New proc.
	(gdb_init): Call save_global_vars.
	(gdb_finish): Call check_global_vars.
	* gdb.mi/mi-var-cp.exp: Set gdb_skip_check_global_vars.
	* gdb.mi/mi2-var-child.exp: Same.

---
 gdb/testsuite/gdb.mi/mi-var-cp.exp     |  3 ++
 gdb/testsuite/gdb.mi/mi2-var-child.exp |  3 ++
 gdb/testsuite/lib/gdb.exp              | 94 ++++++++++++++++++++++++++++++++++
 3 files changed, 100 insertions(+)

Comments

Tom Tromey May 22, 2020, 8:15 p.m. | #1
>>>>> "Tom" == Tom de Vries <tdevries@suse.de> writes:


Tom> So, since a global name in one test-case can leak to another
Tom> test-case, setting a global name in one test-case can result in
Tom> a tcl error in another test-case that reuses the name in a different
Tom> way.

Tom> Warn about leaking a global array from a test-case.

This seems fine to me.

Tom> Also, add a possibility to skip the warning in a given test-case using
Tom> variable gdb_skip_check_global_vars, and use it in gdb.mi/mi2-var-child.exp
Tom> and gdb.mi/mi-var-cp.exp.

Is that because these tests are still buggy in this way, or something
deeper?

Tom
Tom de Vries June 2, 2020, 1:08 p.m. | #2
On 22-05-2020 22:15, Tom Tromey wrote:
>>>>>> "Tom" == Tom de Vries <tdevries@suse.de> writes:

> 

> Tom> So, since a global name in one test-case can leak to another

> Tom> test-case, setting a global name in one test-case can result in

> Tom> a tcl error in another test-case that reuses the name in a different

> Tom> way.

> 

> Tom> Warn about leaking a global array from a test-case.

> 

> This seems fine to me.

> 

> Tom> Also, add a possibility to skip the warning in a given test-case using

> Tom> variable gdb_skip_check_global_vars, and use it in gdb.mi/mi2-var-child.exp

> Tom> and gdb.mi/mi-var-cp.exp.

> 

> Is that because these tests are still buggy in this way, or something

> deeper?


The former.

Thanks,
- Tom
Andrew Burgess June 2, 2020, 3:38 p.m. | #3
* Tom de Vries <tdevries@suse.de> [2020-05-19 18:30:06 +0200]:

> Hi,

> 

> A variable name cannot be used both as scalar and array without an

> intermediate unset.  Trying to do so will result in tcl errors, for

> example, for:

> ...

>   set var "bla"

>   set var(1) "bla"

> ...

> we get:

> ...

>   can't set "var(1)": variable isn't array

> ...

> and for the reverse statement order we get:

> ...

>   can't set "var": variable is array

> ...

> 

> So, since a global name in one test-case can leak to another

> test-case, setting a global name in one test-case can result in

> a tcl error in another test-case that reuses the name in a different

> way.

> 

> Warn about leaking a global array from a test-case.

> 

> Also, add a possibility to skip the warning in a given test-case using

> variable gdb_skip_check_global_vars, and use it in gdb.mi/mi2-var-child.exp

> and gdb.mi/mi-var-cp.exp.

> 

> Tested on x86_64-linux.

> 

> Any comments?


If we're going to add code to loop over all globals anyway, then why
not, instead of warning about bad cases, and then wrapping tests in a
namespace, just have this code "fix" the leaked globals by deleting
them?

My thinking is that any global that exists when we start a test should
continue to exist at the end of the test.  Any other global should
just be unset when the test script finishes.

If there really is some global state that is lazily created by a
particular test script then (a) this seems like a bug anyway, and (b)
this is easy to fix by giving it an earlier creation / initialisation.

In this way, folk can just write test scripts, dump their junk all
over the global namespace as they like, and we'll just clean up for
them.

Thoughts?

Thanks,
Andrew




> 

> Thanks,

> - Tom

> 

> [gdb/testsuite] Warn about leaked global array

> 

> gdb/testsuite/ChangeLog:

> 

> 2020-05-18  Tom de Vries  <tdevries@suse.de>

> 

> 	PR testsuite/25996

> 	* lib/gdb.exp (global_array_exists, global_unset, save_global_vars)

> 	(check_global_vars): New proc.

> 	(gdb_init): Call save_global_vars.

> 	(gdb_finish): Call check_global_vars.

> 	* gdb.mi/mi-var-cp.exp: Set gdb_skip_check_global_vars.

> 	* gdb.mi/mi2-var-child.exp: Same.

> 

> ---

>  gdb/testsuite/gdb.mi/mi-var-cp.exp     |  3 ++

>  gdb/testsuite/gdb.mi/mi2-var-child.exp |  3 ++

>  gdb/testsuite/lib/gdb.exp              | 94 ++++++++++++++++++++++++++++++++++

>  3 files changed, 100 insertions(+)

> 

> diff --git a/gdb/testsuite/gdb.mi/mi-var-cp.exp b/gdb/testsuite/gdb.mi/mi-var-cp.exp

> index 8c6a624f80..dc32ddc346 100644

> --- a/gdb/testsuite/gdb.mi/mi-var-cp.exp

> +++ b/gdb/testsuite/gdb.mi/mi-var-cp.exp

> @@ -23,6 +23,9 @@ if [mi_gdb_start] {

>      continue

>  }

>  

> +# FIXME.  See check_global_vars in lib/gdb.exp.

> +set gdb_skip_check_global_vars 1

> +

>  standard_testfile .cc

>  

>  if [get_compiler_info "c++"] {

> diff --git a/gdb/testsuite/gdb.mi/mi2-var-child.exp b/gdb/testsuite/gdb.mi/mi2-var-child.exp

> index e32858fbd3..b96ac41815 100644

> --- a/gdb/testsuite/gdb.mi/mi2-var-child.exp

> +++ b/gdb/testsuite/gdb.mi/mi2-var-child.exp

> @@ -27,6 +27,9 @@ if [mi_gdb_start] {

>      continue

>  }

>  

> +# FIXME.  See check_global_vars in lib/gdb.exp.

> +set gdb_skip_check_global_vars 1

> +

>  standard_testfile var-cmd.c

>  

>  if  { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable {debug}] != "" } {

> diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp

> index f7d20bd94f..a0d558c943 100644

> --- a/gdb/testsuite/lib/gdb.exp

> +++ b/gdb/testsuite/lib/gdb.exp

> @@ -5048,6 +5048,98 @@ proc standard_testfile {args} {

>      }

>  }

>  

> +# Returns 1 if GLOBALVARNAME is a global array.

> +

> +proc global_array_exists { globalvarname } {

> +    # Introduce local alias of global variable $globalvarname.  Using

> +    # "global $globalvarname" instead is simpler, but this may result in a

> +    # clash with local name "globalvarname".

> +    upvar #0 $globalvarname globalvar

> +    return [array exists globalvar]

> +}

> +

> +# Unset global variable GLOBALVARNAME.

> +

> +proc global_unset { globalvarname } {

> +    # Introduce local alias of global variable $globalvarname.

> +    upvar #0 $globalvarname globalvar

> +    unset globalvar

> +}

> +

> +# Save global vars to variable gdb_global_vars.

> +

> +proc save_global_vars { test_file_name } {

> +    # Save for the warning.

> +    global gdb_test_file_name

> +    set gdb_test_file_name $test_file_name

> +

> +    # Sample state before running test.

> +    global gdb_global_vars

> +    set gdb_global_vars [info globals]

> +

> +    global gdb_skip_check_global_vars

> +    if { [info exists gdb_skip_check_global_vars]} {

> +	unset gdb_skip_check_global_vars

> +    }

> +}

> +

> +# Check global variables not in gdb_global_vars.

> +

> +proc check_global_vars { } {

> +    global gdb_skip_check_global_vars

> +    if { [info exists gdb_skip_check_global_vars]} {

> +	return

> +    }

> +    # Sample state after running test.

> +    global gdb_global_vars

> +    set vars [info globals]

> +

> +    set skip [list "expect_out" "spawn_out" "auto_index"]

> +

> +    foreach var $vars {

> +	if { ![global_array_exists $var] } {

> +	    continue

> +	}

> +

> +	set found [lsearch -exact $gdb_global_vars $var]

> +	if { $found != -1 } {

> +	    # Already present before running test.

> +	    continue

> +	}

> +

> +	set found [lsearch -exact $skip $var]

> +	if { $found != -1 } {

> +	    continue

> +	}

> +

> +	# A variable name cannot be used both as scalar and array without an

> +	# intermediate unset.  Trying to do so will result in tcl errors, for

> +	# example, for:

> +	#   set var "bla"

> +	#   set var(1) "bla"

> +	# we get:

> +	#   can't set "var(1)": variable isn't array

> +	# and for the reverse statement order we get:

> +	#   can't set "var": variable is array

> +	#

> +	# So, since a global name in one test-case can leak to another

> +	# test-case, setting a global name in one test-case can result in

> +	# a tcl error in another test-case that reuses the name in a different

> +	# way.

> +	#

> +	# Warn about leaking a global array from the test-case.

> +	#

> +	# For a description on how to fix this, see "Wrapping test-cases in

> +	# Tcl namespaces" in gdb/testsuite/README.

> +	global gdb_test_file_name

> +	warning "$gdb_test_file_name.exp defined global array $var"

> +

> +	# If the variable remains set, we won't warn for the next test where

> +	# it's leaked, so unset.

> +	global_unset $var

> +    }

> +}

> +

>  # The default timeout used when testing GDB commands.  We want to use

>  # the same timeout as the default dejagnu timeout, unless the user has

>  # already provided a specific value (probably through a site.exp file).

> @@ -5177,10 +5269,12 @@ proc gdb_init { test_file_name } {

>      global gdb_instances

>      set gdb_instances 0

>  

> +    save_global_vars $test_file_name

>      return [default_gdb_init $test_file_name]

>  }

>  

>  proc gdb_finish { } {

> +    check_global_vars

>      global gdbserver_reconnect_p

>      global gdb_prompt

>      global cleanfiles
Andrew Burgess June 2, 2020, 3:52 p.m. | #4
* Andrew Burgess <andrew.burgess@embecosm.com> [2020-06-02 16:38:30 +0100]:

> * Tom de Vries <tdevries@suse.de> [2020-05-19 18:30:06 +0200]:

> 

> > Hi,

> > 

> > A variable name cannot be used both as scalar and array without an

> > intermediate unset.  Trying to do so will result in tcl errors, for

> > example, for:

> > ...

> >   set var "bla"

> >   set var(1) "bla"

> > ...

> > we get:

> > ...

> >   can't set "var(1)": variable isn't array

> > ...

> > and for the reverse statement order we get:

> > ...

> >   can't set "var": variable is array

> > ...

> > 

> > So, since a global name in one test-case can leak to another

> > test-case, setting a global name in one test-case can result in

> > a tcl error in another test-case that reuses the name in a different

> > way.

> > 

> > Warn about leaking a global array from a test-case.

> > 

> > Also, add a possibility to skip the warning in a given test-case using

> > variable gdb_skip_check_global_vars, and use it in gdb.mi/mi2-var-child.exp

> > and gdb.mi/mi-var-cp.exp.

> > 

> > Tested on x86_64-linux.

> > 

> > Any comments?

> 

> If we're going to add code to loop over all globals anyway, then why

> not, instead of warning about bad cases, and then wrapping tests in a

> namespace, just have this code "fix" the leaked globals by deleting

> them?

> 

> My thinking is that any global that exists when we start a test should

> continue to exist at the end of the test.  Any other global should

> just be unset when the test script finishes.

> 

> If there really is some global state that is lazily created by a

> particular test script then (a) this seems like a bug anyway, and (b)

> this is easy to fix by giving it an earlier creation / initialisation.

> 

> In this way, folk can just write test scripts, dump their junk all

> over the global namespace as they like, and we'll just clean up for

> them.

> 

> Thoughts?


Here's a really quick patch implementing the idea above.  It needs
cleaning up and commenting, etc, but it passes the testsuite with no
regressions, and taking a look at its debug output, I can see it
deleting some of the problem global arrays that are causing issues.

What do you think of this approach?

Thanks,
Andrew

----

diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp
index 444cea01c36..c983c9cc172 100644
--- a/gdb/testsuite/lib/gdb.exp
+++ b/gdb/testsuite/lib/gdb.exp
@@ -5094,7 +5094,11 @@ set banned_procedures { strace }
 # if the banned variables and procedures are already traced.
 set banned_traced 0
 
+array set known_globals {}
+
 proc gdb_init { test_file_name } {
+    global known_globals
+
     # 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.
@@ -5196,13 +5200,27 @@ 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]
+
+    foreach varname [info globals] {
+	set known_globals($varname) 1
+    }
+
+    return $result
 }
 
 proc gdb_finish { } {
     global gdbserver_reconnect_p
     global gdb_prompt
     global cleanfiles
+    global known_globals
+
+    foreach varname [info globals] {
+	if {![info exists known_globals($varname)]} {
+	    verbose -log "APB: Deleting '$varname'"
+	    upvar 0 unset $varname
+	}
+    }
 
     # Exit first, so that the files are no longer in use.
     gdb_exit
Tom de Vries June 2, 2020, 4:31 p.m. | #5
On 02-06-2020 17:52, Andrew Burgess wrote:
> * Andrew Burgess <andrew.burgess@embecosm.com> [2020-06-02 16:38:30 +0100]:

> 

>> * Tom de Vries <tdevries@suse.de> [2020-05-19 18:30:06 +0200]:

>>

>>> Hi,

>>>

>>> A variable name cannot be used both as scalar and array without an

>>> intermediate unset.  Trying to do so will result in tcl errors, for

>>> example, for:

>>> ...

>>>   set var "bla"

>>>   set var(1) "bla"

>>> ...

>>> we get:

>>> ...

>>>   can't set "var(1)": variable isn't array

>>> ...

>>> and for the reverse statement order we get:

>>> ...

>>>   can't set "var": variable is array

>>> ...

>>>

>>> So, since a global name in one test-case can leak to another

>>> test-case, setting a global name in one test-case can result in

>>> a tcl error in another test-case that reuses the name in a different

>>> way.

>>>

>>> Warn about leaking a global array from a test-case.

>>>

>>> Also, add a possibility to skip the warning in a given test-case using

>>> variable gdb_skip_check_global_vars, and use it in gdb.mi/mi2-var-child.exp

>>> and gdb.mi/mi-var-cp.exp.

>>>

>>> Tested on x86_64-linux.

>>>

>>> Any comments?

>>

>> If we're going to add code to loop over all globals anyway, then why

>> not, instead of warning about bad cases, and then wrapping tests in a

>> namespace, just have this code "fix" the leaked globals by deleting

>> them?

>>

>> My thinking is that any global that exists when we start a test should

>> continue to exist at the end of the test.  Any other global should

>> just be unset when the test script finishes.

>>

>> If there really is some global state that is lazily created by a

>> particular test script then (a) this seems like a bug anyway, and (b)

>> this is easy to fix by giving it an earlier creation / initialisation.

>>

>> In this way, folk can just write test scripts, dump their junk all

>> over the global namespace as they like, and we'll just clean up for

>> them.

>>

>> Thoughts?

> 

> Here's a really quick patch implementing the idea above.  It needs

> cleaning up and commenting, etc, but it passes the testsuite with no

> regressions, and taking a look at its debug output, I can see it

> deleting some of the problem global arrays that are causing issues.

> 

> What do you think of this approach?

> 

> Thanks,

> Andrew

> 

> ----

> 

> diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp

> index 444cea01c36..c983c9cc172 100644

> --- a/gdb/testsuite/lib/gdb.exp

> +++ b/gdb/testsuite/lib/gdb.exp

> @@ -5094,7 +5094,11 @@ set banned_procedures { strace }

>  # if the banned variables and procedures are already traced.

>  set banned_traced 0

>  

> +array set known_globals {}

> +

>  proc gdb_init { test_file_name } {

> +    global known_globals

> +

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

> @@ -5196,13 +5200,27 @@ 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]

> +

> +    foreach varname [info globals] {

> +	set known_globals($varname) 1

> +    }

> +

> +    return $result

>  }

>  

>  proc gdb_finish { } {

>      global gdbserver_reconnect_p

>      global gdb_prompt

>      global cleanfiles

> +    global known_globals

> +

> +    foreach varname [info globals] {

> +	if {![info exists known_globals($varname)]} {

> +	    verbose -log "APB: Deleting '$varname'"

> +	    upvar 0 unset $varname

> +	}

> +    }


I'm not against the approach as such (I remember also trying this out
initially).

I don't think this use of upvar does any unset though.

Thanks,
- Tom
Andrew Burgess June 2, 2020, 5:01 p.m. | #6
* Tom de Vries <tdevries@suse.de> [2020-06-02 18:31:39 +0200]:

> On 02-06-2020 17:52, Andrew Burgess wrote:

> > * Andrew Burgess <andrew.burgess@embecosm.com> [2020-06-02 16:38:30 +0100]:

> > 

> >> * Tom de Vries <tdevries@suse.de> [2020-05-19 18:30:06 +0200]:

> >>

> >>> Hi,

> >>>

> >>> A variable name cannot be used both as scalar and array without an

> >>> intermediate unset.  Trying to do so will result in tcl errors, for

> >>> example, for:

> >>> ...

> >>>   set var "bla"

> >>>   set var(1) "bla"

> >>> ...

> >>> we get:

> >>> ...

> >>>   can't set "var(1)": variable isn't array

> >>> ...

> >>> and for the reverse statement order we get:

> >>> ...

> >>>   can't set "var": variable is array

> >>> ...

> >>>

> >>> So, since a global name in one test-case can leak to another

> >>> test-case, setting a global name in one test-case can result in

> >>> a tcl error in another test-case that reuses the name in a different

> >>> way.

> >>>

> >>> Warn about leaking a global array from a test-case.

> >>>

> >>> Also, add a possibility to skip the warning in a given test-case using

> >>> variable gdb_skip_check_global_vars, and use it in gdb.mi/mi2-var-child.exp

> >>> and gdb.mi/mi-var-cp.exp.

> >>>

> >>> Tested on x86_64-linux.

> >>>

> >>> Any comments?

> >>

> >> If we're going to add code to loop over all globals anyway, then why

> >> not, instead of warning about bad cases, and then wrapping tests in a

> >> namespace, just have this code "fix" the leaked globals by deleting

> >> them?

> >>

> >> My thinking is that any global that exists when we start a test should

> >> continue to exist at the end of the test.  Any other global should

> >> just be unset when the test script finishes.

> >>

> >> If there really is some global state that is lazily created by a

> >> particular test script then (a) this seems like a bug anyway, and (b)

> >> this is easy to fix by giving it an earlier creation / initialisation.

> >>

> >> In this way, folk can just write test scripts, dump their junk all

> >> over the global namespace as they like, and we'll just clean up for

> >> them.

> >>

> >> Thoughts?

> > 

> > Here's a really quick patch implementing the idea above.  It needs

> > cleaning up and commenting, etc, but it passes the testsuite with no

> > regressions, and taking a look at its debug output, I can see it

> > deleting some of the problem global arrays that are causing issues.

> > 

> > What do you think of this approach?

> > 

> > Thanks,

> > Andrew

> > 

> > ----

> > 

> > diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp

> > index 444cea01c36..c983c9cc172 100644

> > --- a/gdb/testsuite/lib/gdb.exp

> > +++ b/gdb/testsuite/lib/gdb.exp

> > @@ -5094,7 +5094,11 @@ set banned_procedures { strace }

> >  # if the banned variables and procedures are already traced.

> >  set banned_traced 0

> >  

> > +array set known_globals {}

> > +

> >  proc gdb_init { test_file_name } {

> > +    global known_globals

> > +

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

> > @@ -5196,13 +5200,27 @@ 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]

> > +

> > +    foreach varname [info globals] {

> > +	set known_globals($varname) 1

> > +    }

> > +

> > +    return $result

> >  }

> >  

> >  proc gdb_finish { } {

> >      global gdbserver_reconnect_p

> >      global gdb_prompt

> >      global cleanfiles

> > +    global known_globals

> > +

> > +    foreach varname [info globals] {

> > +	if {![info exists known_globals($varname)]} {

> > +	    verbose -log "APB: Deleting '$varname'"

> > +	    upvar 0 unset $varname

> > +	}

> > +    }

> 

> I'm not against the approach as such (I remember also trying this out

> initially).

> 

> I don't think this use of upvar does any unset though.


*cough* yeah, I knew that.

Fixed, and _confirmed_ that it's deleting the globals this time, not
just reporting what it would delete.

Still passes regression tests.

Thanks,
Andrew

---

diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp
index 444cea01c36..46cb744bac4 100644
--- a/gdb/testsuite/lib/gdb.exp
+++ b/gdb/testsuite/lib/gdb.exp
@@ -5094,7 +5094,11 @@ set banned_procedures { strace }
 # if the banned variables and procedures are already traced.
 set banned_traced 0
 
+array set known_globals {}
+
 proc gdb_init { test_file_name } {
+    global known_globals
+
     # 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.
@@ -5196,13 +5200,20 @@ 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]
+
+    foreach varname [info globals] {
+	set known_globals($varname) 1
+    }
+
+    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 +5239,13 @@ proc gdb_finish { } {
 	}
 	set banned_traced 0
     }
+
+    foreach varname [info globals] {
+	if {![info exists known_globals($varname)]} {
+	    verbose -log "APB: Deleting '$varname'"
+	    uplevel #0 unset $varname
+	}
+    }
 }
 
 global debug_format
Andrew Burgess June 2, 2020, 8:18 p.m. | #7
* Andrew Burgess <andrew.burgess@embecosm.com> [2020-06-02 18:01:39 +0100]:

> * Tom de Vries <tdevries@suse.de> [2020-06-02 18:31:39 +0200]:

> 

> > On 02-06-2020 17:52, Andrew Burgess wrote:

> > > * Andrew Burgess <andrew.burgess@embecosm.com> [2020-06-02 16:38:30 +0100]:

> > > 

> > >> * Tom de Vries <tdevries@suse.de> [2020-05-19 18:30:06 +0200]:

> > >>

> > >>> Hi,

> > >>>

> > >>> A variable name cannot be used both as scalar and array without an

> > >>> intermediate unset.  Trying to do so will result in tcl errors, for

> > >>> example, for:

> > >>> ...

> > >>>   set var "bla"

> > >>>   set var(1) "bla"

> > >>> ...

> > >>> we get:

> > >>> ...

> > >>>   can't set "var(1)": variable isn't array

> > >>> ...

> > >>> and for the reverse statement order we get:

> > >>> ...

> > >>>   can't set "var": variable is array

> > >>> ...

> > >>>

> > >>> So, since a global name in one test-case can leak to another

> > >>> test-case, setting a global name in one test-case can result in

> > >>> a tcl error in another test-case that reuses the name in a different

> > >>> way.

> > >>>

> > >>> Warn about leaking a global array from a test-case.

> > >>>

> > >>> Also, add a possibility to skip the warning in a given test-case using

> > >>> variable gdb_skip_check_global_vars, and use it in gdb.mi/mi2-var-child.exp

> > >>> and gdb.mi/mi-var-cp.exp.

> > >>>

> > >>> Tested on x86_64-linux.

> > >>>

> > >>> Any comments?

> > >>

> > >> If we're going to add code to loop over all globals anyway, then why

> > >> not, instead of warning about bad cases, and then wrapping tests in a

> > >> namespace, just have this code "fix" the leaked globals by deleting

> > >> them?

> > >>

> > >> My thinking is that any global that exists when we start a test should

> > >> continue to exist at the end of the test.  Any other global should

> > >> just be unset when the test script finishes.

> > >>

> > >> If there really is some global state that is lazily created by a

> > >> particular test script then (a) this seems like a bug anyway, and (b)

> > >> this is easy to fix by giving it an earlier creation / initialisation.

> > >>

> > >> In this way, folk can just write test scripts, dump their junk all

> > >> over the global namespace as they like, and we'll just clean up for

> > >> them.

> > >>

> > >> Thoughts?

> > > 

> > > Here's a really quick patch implementing the idea above.  It needs

> > > cleaning up and commenting, etc, but it passes the testsuite with no

> > > regressions, and taking a look at its debug output, I can see it

> > > deleting some of the problem global arrays that are causing issues.

> > > 

> > > What do you think of this approach?

> > > 

> > > Thanks,

> > > Andrew

> > > 

> > > ----

> > > 

> > > diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp

> > > index 444cea01c36..c983c9cc172 100644

> > > --- a/gdb/testsuite/lib/gdb.exp

> > > +++ b/gdb/testsuite/lib/gdb.exp

> > > @@ -5094,7 +5094,11 @@ set banned_procedures { strace }

> > >  # if the banned variables and procedures are already traced.

> > >  set banned_traced 0

> > >  

> > > +array set known_globals {}

> > > +

> > >  proc gdb_init { test_file_name } {

> > > +    global known_globals

> > > +

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

> > > @@ -5196,13 +5200,27 @@ 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]

> > > +

> > > +    foreach varname [info globals] {

> > > +	set known_globals($varname) 1

> > > +    }

> > > +

> > > +    return $result

> > >  }

> > >  

> > >  proc gdb_finish { } {

> > >      global gdbserver_reconnect_p

> > >      global gdb_prompt

> > >      global cleanfiles

> > > +    global known_globals

> > > +

> > > +    foreach varname [info globals] {

> > > +	if {![info exists known_globals($varname)]} {

> > > +	    verbose -log "APB: Deleting '$varname'"

> > > +	    upvar 0 unset $varname

> > > +	}

> > > +    }

> > 

> > I'm not against the approach as such (I remember also trying this out

> > initially).

> > 

> > I don't think this use of upvar does any unset though.

> 

> *cough* yeah, I knew that.

> 

> Fixed, and _confirmed_ that it's deleting the globals this time, not

> just reporting what it would delete.


Here's a cleaned up version for consideration.

Thanks,
Andrew

---

commit f21ca01deceab0fbbfc22e960c1ee5178cb4a496
Author: Andrew Burgess <andrew.burgess@embecosm.com>
Date:   Tue Jun 2 21:11:10 2020 +0100

    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.
    
    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:
    
            * lib/gdb.exp (gdb_known_globals): New global.
            (gdb_setup_known_globals): New proc.
            (gdb_cleanup_globals): New proc.

diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp
index 444cea01c36..66de9d6be3f 100644
--- a/gdb/testsuite/lib/gdb.exp
+++ b/gdb/testsuite/lib/gdb.exp
@@ -5094,6 +5094,35 @@ 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
+
+    foreach varname [info globals] {
+	if {![info exists gdb_known_globals($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 +5225,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 +5260,8 @@ proc gdb_finish { } {
 	}
 	set banned_traced 0
     }
+
+    gdb_cleanup_globals
 }
 
 global debug_format
Tom de Vries June 3, 2020, 8:47 a.m. | #8
On 02-06-2020 22:18, Andrew Burgess wrote:
> * Andrew Burgess <andrew.burgess@embecosm.com> [2020-06-02 18:01:39 +0100]:

> 

>> * Tom de Vries <tdevries@suse.de> [2020-06-02 18:31:39 +0200]:

>>

>>> On 02-06-2020 17:52, Andrew Burgess wrote:

>>>> * Andrew Burgess <andrew.burgess@embecosm.com> [2020-06-02 16:38:30 +0100]:

>>>>

>>>>> * Tom de Vries <tdevries@suse.de> [2020-05-19 18:30:06 +0200]:

>>>>>

>>>>>> Hi,

>>>>>>

>>>>>> A variable name cannot be used both as scalar and array without an

>>>>>> intermediate unset.  Trying to do so will result in tcl errors, for

>>>>>> example, for:

>>>>>> ...

>>>>>>   set var "bla"

>>>>>>   set var(1) "bla"

>>>>>> ...

>>>>>> we get:

>>>>>> ...

>>>>>>   can't set "var(1)": variable isn't array

>>>>>> ...

>>>>>> and for the reverse statement order we get:

>>>>>> ...

>>>>>>   can't set "var": variable is array

>>>>>> ...

>>>>>>

>>>>>> So, since a global name in one test-case can leak to another

>>>>>> test-case, setting a global name in one test-case can result in

>>>>>> a tcl error in another test-case that reuses the name in a different

>>>>>> way.

>>>>>>

>>>>>> Warn about leaking a global array from a test-case.

>>>>>>

>>>>>> Also, add a possibility to skip the warning in a given test-case using

>>>>>> variable gdb_skip_check_global_vars, and use it in gdb.mi/mi2-var-child.exp

>>>>>> and gdb.mi/mi-var-cp.exp.

>>>>>>

>>>>>> Tested on x86_64-linux.

>>>>>>

>>>>>> Any comments?

>>>>>

>>>>> If we're going to add code to loop over all globals anyway, then why

>>>>> not, instead of warning about bad cases, and then wrapping tests in a

>>>>> namespace, just have this code "fix" the leaked globals by deleting

>>>>> them?

>>>>>

>>>>> My thinking is that any global that exists when we start a test should

>>>>> continue to exist at the end of the test.  Any other global should

>>>>> just be unset when the test script finishes.

>>>>>

>>>>> If there really is some global state that is lazily created by a

>>>>> particular test script then (a) this seems like a bug anyway, and (b)

>>>>> this is easy to fix by giving it an earlier creation / initialisation.

>>>>>

>>>>> In this way, folk can just write test scripts, dump their junk all

>>>>> over the global namespace as they like, and we'll just clean up for

>>>>> them.

>>>>>

>>>>> Thoughts?

>>>>

>>>> Here's a really quick patch implementing the idea above.  It needs

>>>> cleaning up and commenting, etc, but it passes the testsuite with no

>>>> regressions, and taking a look at its debug output, I can see it

>>>> deleting some of the problem global arrays that are causing issues.

>>>>

>>>> What do you think of this approach?

>>>>

>>>> Thanks,

>>>> Andrew

>>>>

>>>> ----

>>>>

>>>> diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp

>>>> index 444cea01c36..c983c9cc172 100644

>>>> --- a/gdb/testsuite/lib/gdb.exp

>>>> +++ b/gdb/testsuite/lib/gdb.exp

>>>> @@ -5094,7 +5094,11 @@ set banned_procedures { strace }

>>>>  # if the banned variables and procedures are already traced.

>>>>  set banned_traced 0

>>>>  

>>>> +array set known_globals {}

>>>> +

>>>>  proc gdb_init { test_file_name } {

>>>> +    global known_globals

>>>> +

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

>>>> @@ -5196,13 +5200,27 @@ 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]

>>>> +

>>>> +    foreach varname [info globals] {

>>>> +	set known_globals($varname) 1

>>>> +    }

>>>> +

>>>> +    return $result

>>>>  }

>>>>  

>>>>  proc gdb_finish { } {

>>>>      global gdbserver_reconnect_p

>>>>      global gdb_prompt

>>>>      global cleanfiles

>>>> +    global known_globals

>>>> +

>>>> +    foreach varname [info globals] {

>>>> +	if {![info exists known_globals($varname)]} {

>>>> +	    verbose -log "APB: Deleting '$varname'"

>>>> +	    upvar 0 unset $varname

>>>> +	}

>>>> +    }

>>>

>>> I'm not against the approach as such (I remember also trying this out

>>> initially).

>>>

>>> I don't think this use of upvar does any unset though.

>>

>> *cough* yeah, I knew that.

>>

>> Fixed, and _confirmed_ that it's deleting the globals this time, not

>> just reporting what it would delete.

> 

> Here's a cleaned up version for consideration.

> 


I ran this through the testsuite.  There seems to be some problems left,
see incomplete dump below.

Thanks,
- Tom

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
ERROR: (timeout) GDB never initialized after 10 seconds.
ERROR: can't read "mi_gdb_prompt": no such variable
    while executing
"expect {
-i exp96 -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
ERROR: (timeout) GDB never initialized after 10 seconds.
ERROR: can't read "mi_gdb_prompt": no such variable
    while executing
"expect {
-i exp96 -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
ERROR: (timeout) GDB never initialized after 10 seconds.
ERROR: can't read "mi_gdb_prompt": no such variable
    while executing
"expect {
-i exp97 -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
ERROR: (timeout) GDB never initialized after 10 seconds.
ERROR: can't read "mi_gdb_prompt": no such variable
    while executing
"expect {
-i exp97 -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
ERROR: (timeout) GDB never initialized after 10 seconds.
ERROR: can't read "mi_gdb_prompt": no such variable
    while executing
"expect {
-i exp97 -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
ERROR: (timeout) GDB never initialized after 10 seconds.
ERROR: can't read "mi_gdb_prompt": no such variable
    while executing
"expect {
-i exp97 -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
ERROR: (timeout) GDB never initialized after 10 seconds.
ERROR: can't read "mi_gdb_prompt": no such variable
    while executing
"expect {
-i exp97 -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
ERROR: (timeout) GDB never initialized after 10 seconds.
ERROR: can't read "mi_gdb_prompt": no such variable
    while executing
"expect {
-i exp97 -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
ERROR: (timeout) GDB never initialized after 10 seconds.
ERROR: can't read "mi_gdb_prompt": no such variable
    while executing
"expect {
-i exp97 -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
ERROR: (timeout) GDB never initialized after 10 seconds.
ERROR: can't read "mi_gdb_prompt": no such variable
    while executing
"expect {
-i exp97 -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
ERROR: (timeout) GDB never initialized after 10 seconds.
ERROR: can't read "mi_gdb_prompt": no such variable
    while executing
"expect {
-i exp97 -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
ERROR: (timeout) GDB never initialized after 10 seconds.
ERROR: can't read "mi_gdb_prompt": no such variable
    while executing
"expect {
-i exp97 -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
ERROR: (timeout) GDB never initialized after 10 seconds.
ERROR: can't read "mi_gdb_prompt": no such variable
    while executing
"expect {
-i exp97 -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
ERROR: (timeout) GDB never initialized after 10 seconds.
ERROR: can't read "mi_gdb_prompt": no such variable
    while executing
"expect {
-i exp97 -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
ERROR: (timeout) GDB never initialized after 10 seconds.
ERROR: can't read "mi_gdb_prompt": no such variable
    while executing
"expect {
-i exp97 -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
ERROR: (timeout) GDB never initialized after 10 seconds.
ERROR: can't read "mi_gdb_prompt": no such variable
    while executing
"expect {
-i exp97 -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
ERROR: (timeout) GDB never initialized after 10 seconds.
ERROR: can't read "mi_gdb_prompt": no such variable
    while executing
"expect {
-i exp97 -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
ERROR: (timeout) GDB never initialized after 10 seconds.
ERROR: can't read "mi_gdb_prompt": no such variable
    while executing
"expect {
-i exp97 -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
ERROR: (timeout) GDB never initialized after 10 seconds.
ERROR: tcl error sourcing
/data/gdb_versions/devel/src/gdb/testsuite/gdb.base/jit-elf.exp.
ERROR: can't read "jit_load_address": no such variable
    while executing
"expr $jit_load_address + $jit_load_increment * [expr $i-1]"
    (procedure "compile_and_download_n_jit_so" line 12)
    invoked from within
"compile_and_download_n_jit_so \
                      $jit_solib_basename $jit_solib_srcfile 2"
    (file
"/data/gdb_versions/devel/src/gdb/testsuite/gdb.base/jit-elf.exp" line 134)
    invoked from within
"source /data/gdb_versions/devel/src/gdb/testsuite/gdb.base/jit-elf.exp"
    ("uplevel" body line 1)
    invoked from within
"uplevel #0 source
/data/gdb_versions/devel/src/gdb/testsuite/gdb.base/jit-elf.exp"
    invoked from within
"catch "uplevel #0 source $test_file_name""
FAIL: gdb.btrace/reconnect.exp: first: record btrace enable
FAIL: gdb.btrace/reconnect.exp: first: stepi 19 (the program is no
longer running)
FAIL: gdb.btrace/reconnect.exp: first: info record
FAIL: gdb.btrace/reconnect.exp: first: disconnect
FAIL: gdb.btrace/reconnect.exp: second: info record
FAIL: gdb.btrace/reconnect.exp: second: record stop
FAIL: gdb.btrace/reconnect.exp: second: disconnect
FAIL: gdb.btrace/reconnect.exp: third: info record
ERROR: tcl error sourcing
/data/gdb_versions/devel/src/gdb/testsuite/gdb.cp/derivation.exp.
ERROR: can't read "debug_cp_test_ptype_class": no such variable
    while executing
"if {$debug_cp_test_ptype_class} {
        verbose -log $msg
    }"
    (procedure "cp_ptype_class_verbose" line 4)
    invoked from within
"cp_ptype_class_verbose "next line element: \"$elem\"""
    (procedure "cp_support_internal::next_line" line 12)
    invoked from within
"cp_support_internal::next_line $line_queue"
    (procedure "cp_test_ptype_class" line 183)
    invoked from within
"cp_test_ptype_class \
    "a_instance" "" "class" "A" \
    {
        { field  public "A::value_type a;" }
        { field  public "A::value_type aa;" }
        { method p..."
    (file
"/data/gdb_versions/devel/src/gdb/testsuite/gdb.cp/derivation.exp" line 80)
    invoked from within
"source /data/gdb_versions/devel/src/gdb/testsuite/gdb.cp/derivation.exp"
    ("uplevel" body line 1)
    invoked from within
"uplevel #0 source
/data/gdb_versions/devel/src/gdb/testsuite/gdb.cp/derivation.exp"
    invoked from within
"catch "uplevel #0 source $test_file_name""
ERROR: tcl error sourcing
/data/gdb_versions/devel/src/gdb/testsuite/gdb.cp/inherit.exp.
ERROR: can't read "debug_cp_test_ptype_class": no such variable
    while executing
"if {$debug_cp_test_ptype_class} {
        verbose -log $msg
    }"
    (procedure "cp_ptype_class_verbose" line 4)
    invoked from within
"cp_ptype_class_verbose "next line element: \"$elem\"""
    (procedure "cp_support_internal::next_line" line 12)
    invoked from within
"cp_support_internal::next_line $line_queue"
    (procedure "cp_test_ptype_class" line 183)
    invoked from within
"cp_test_ptype_class  "A" "ptype A (FIXME)" "class" "A"  {
            { field public "int a;" }
            { field public "int x;" }
        }"
    (procedure "test_ptype_si" line 8)
    invoked from within
"test_ptype_si"
    (procedure "do_tests" line 10)
    invoked from within
"do_tests"
    (file
"/data/gdb_versions/devel/src/gdb/testsuite/gdb.cp/inherit.exp" line 722)
    invoked from within
"source /data/gdb_versions/devel/src/gdb/testsuite/gdb.cp/inherit.exp"
    ("uplevel" body line 1)
    invoked from within
"uplevel #0 source
/data/gdb_versions/devel/src/gdb/testsuite/gdb.cp/inherit.exp"
    invoked from within
"catch "uplevel #0 source $test_file_name""
ERROR: tcl error sourcing
/data/gdb_versions/devel/src/gdb/testsuite/gdb.cp/nested-types.exp.
ERROR: can't read "debug_cp_test_ptype_class": no such variable
    while executing
"if {$debug_cp_test_ptype_class} {
        verbose -log $msg
    }"
    (procedure "cp_ptype_class_verbose" line 4)
    invoked from within
"cp_ptype_class_verbose "next line element: \"$elem\"""
    (procedure "cp_support_internal::next_line" line 12)
    invoked from within
"cp_support_internal::next_line $line_queue"
    (procedure "cp_test_ptype_class" line 183)
    invoked from within
"cp_test_ptype_class $name "ptype $name (limit = $limit)" $key  $name
$children"
    ("uplevel" body line 2)
    invoked from within
"uplevel 1 $body"
    invoked from within
"with_timeout_factor 1 {
            cp_test_ptype_class $name "ptype $name (limit = $limit)"
$key  $name $children
        }"
    ("uplevel" body line 1)
    invoked from within
"uplevel [list with_timeout_factor $factor $body]"
    (procedure "with_read1_timeout_factor" line 8)
    invoked from within
"with_read1_timeout_factor $read1_timeout_factor {
            cp_test_ptype_class $name "ptype $name (limit = $limit)"
$key  $name $children
        }"
    (procedure "test_nested_limit" line 33)
    invoked from within
"test_nested_limit -1 false"
    (file
"/data/gdb_versions/devel/src/gdb/testsuite/gdb.cp/nested-types.exp"
line 317)
    invoked from within
"source /data/gdb_versions/devel/src/gdb/testsuite/gdb.cp/nested-types.exp"
    ("uplevel" body line 1)
    invoked from within
"uplevel #0 source
/data/gdb_versions/devel/src/gdb/testsuite/gdb.cp/nested-types.exp"
    invoked from within
"catch "uplevel #0 source $test_file_name""
FAIL: gdb.cp/no-dmgl-verbose.exp: setting breakpoint at 'f(std::string)'
ERROR: tcl error sourcing
/data/gdb_versions/devel/src/gdb/testsuite/gdb.cp/ptype-flags.exp.
ERROR: can't read "debug_cp_test_ptype_class": no such variable
    while executing
"if {$debug_cp_test_ptype_class} {
        verbose -log $msg
    }"
    (procedure "cp_ptype_class_verbose" line 4)
    invoked from within
"cp_ptype_class_verbose "next line element: \"$elem\"""
    (procedure "cp_support_internal::next_line" line 12)
    invoked from within
"cp_support_internal::next_line $line_queue"
    (procedure "cp_test_ptype_class" line 183)
    invoked from within
"cp_test_ptype_class value $name "class" "Holder<int>" $contents  "" {}
$flags"
    (procedure "do_check" line 26)
    invoked from within
"do_check "basic test""
    (file
"/data/gdb_versions/devel/src/gdb/testsuite/gdb.cp/ptype-flags.exp" line 65)
    invoked from within
"source /data/gdb_versions/devel/src/gdb/testsuite/gdb.cp/ptype-flags.exp"
    ("uplevel" body line 1)
    invoked from within
"uplevel #0 source
/data/gdb_versions/devel/src/gdb/testsuite/gdb.cp/ptype-flags.exp"
    invoked from within
"catch "uplevel #0 source $test_file_name""
ERROR: tcl error sourcing
/data/gdb_versions/devel/src/gdb/testsuite/gdb.cp/rvalue-ref-overload.exp.
ERROR: can't read "debug_cp_test_ptype_class": no such variable
    while executing
"if {$debug_cp_test_ptype_class} {
        verbose -log $msg
    }"
    (procedure "cp_ptype_class_verbose" line 4)
    invoked from within
"cp_ptype_class_verbose "next line element: \"$elem\"""
    (procedure "cp_support_internal::next_line" line 12)
    invoked from within
"cp_support_internal::next_line $line_queue"
    (procedure "cp_test_ptype_class" line 183)
    invoked from within
"cp_test_ptype_class "foo_rr_instance1" "" "class" "foo" \
    {
        { method public "foo(void);" }
        { method public "foo(foo_lval_ref);" }
        { method publ..."
    (file
"/data/gdb_versions/devel/src/gdb/testsuite/gdb.cp/rvalue-ref-overload.exp"
line 44)
    invoked from within
"source
/data/gdb_versions/devel/src/gdb/testsuite/gdb.cp/rvalue-ref-overload.exp"
    ("uplevel" body line 1)
    invoked from within
"uplevel #0 source
/data/gdb_versions/devel/src/gdb/testsuite/gdb.cp/rvalue-ref-overload.exp"
    invoked from within
"catch "uplevel #0 source $test_file_name""
ERROR: tcl error sourcing
/data/gdb_versions/devel/src/gdb/testsuite/gdb.cp/virtfunc.exp.
ERROR: can't read "debug_cp_test_ptype_class": no such variable
    while executing
"if {$debug_cp_test_ptype_class} {
        verbose -log $msg
    }"
    (procedure "cp_ptype_class_verbose" line 4)
    invoked from within
"cp_ptype_class_verbose "next line element: \"$elem\"""
    (procedure "cp_support_internal::next_line" line 12)
    invoked from within
"cp_support_internal::next_line $line_queue"
    (procedure "cp_test_ptype_class" line 183)
    invoked from within
"cp_test_ptype_class  "VA" "" "class" "VA"  {
            { field public "int va;" }
        }"
    (procedure "test_ptype_of_classes" line 5)
    invoked from within
"test_ptype_of_classes"
    (procedure "do_tests" line 9)
    invoked from within
"do_tests"
    (file
"/data/gdb_versions/devel/src/gdb/testsuite/gdb.cp/virtfunc.exp" line 292)
    invoked from within
"source /data/gdb_versions/devel/src/gdb/testsuite/gdb.cp/virtfunc.exp"
    ("uplevel" body line 1)
    invoked from within
"uplevel #0 source
/data/gdb_versions/devel/src/gdb/testsuite/gdb.cp/virtfunc.exp"
    invoked from within
"catch "uplevel #0 source $test_file_name""
Tom de Vries June 3, 2020, 9:38 a.m. | #9
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.

Thanks,
- Tom
Simon Marchi via Gdb-patches June 3, 2020, 9:49 a.m. | #10
On 6/2/20 4:38 PM, Andrew Burgess wrote:

> If we're going to add code to loop over all globals anyway, then why

> not, instead of warning about bad cases, and then wrapping tests in a

> namespace, just have this code "fix" the leaked globals by deleting

> them?

> 

> My thinking is that any global that exists when we start a test should

> continue to exist at the end of the test.  Any other global should

> just be unset when the test script finishes.

> 

> If there really is some global state that is lazily created by a

> particular test script then (a) this seems like a bug anyway, and (b)

> this is easy to fix by giving it an earlier creation / initialisation.

> 

> In this way, folk can just write test scripts, dump their junk all

> over the global namespace as they like, and we'll just clean up for

> them.

> 

> Thoughts?


Hmm, I thought of this when I saw Tom's detection patch the first time,
but dismissed it, perhaps too quickly, thinking that it wouldn't
be safe.  You mention global state lazily created by test scripts, but I was
thinking of lazy initialized globals within Dejagnu itself, or whatever Tcl
library we might end up using the future, which might need to be carried
over from testcase to testcase.  Imagine, this in a Dejagnu function:

proc fail {} {
   global number_of_fails

   # Hadn't been set before.  (valid since Tcl 8.5; otherwise, imagine it wrapped in 'info exits')
   incr number_of_fails
}

This is obviously not the real "fail", it is just to
show the point, or the risk.  I imagined there might be similar
functions in random Dejagnu boards.

(
Now that I look, it seems like Dejagnu wants to be sure to initialize
all global variables it uses in runtest.exp:

 # Initialize a few global variables used by all tests.
 # `reset_vars' resets several of these, we define them here to document their
 # existence.  In fact, it would be nice if all globals used by some interface
 # of dejagnu proper were documented here.

And I guess we can always initialize some ourselves, if we find that missing.
)

So if people think the benefits outweigh the risks, then I guess
we should give it a go.

BTW, global variables alone aren't the full scope of the
bleeding between testcases.  There's also the case of
testcases overriding procedures, like gdb.base/dbx.exp,
but those are perhaps rare enough that we can continue
handling it "manually" as before.

Thanks,
Pedro Alves
Tom de Vries June 3, 2020, 10:09 a.m. | #11
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.


This naive solution seems to work.

Perhaps we can override load_lib to do the same, automatically.

Thanks,
- Tom

diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp
index 66de9d6be3..e75842c83e 100644
--- a/gdb/testsuite/lib/gdb.exp
+++ b/gdb/testsuite/lib/gdb.exp
@@ -5099,6 +5099,13 @@ set banned_traced 0
 # global not in this list is deleted.
 array set gdb_known_globals {}

+array set gdb_persistent_globals {}
+
+proc gdb_persistent_global { varname } {
+    global gdb_persistent_globals
+    set gdb_persistent_globals($varname) 1
+}
+
 # Setup the GDB_KNOWN_GLOBALS array with the names of all current
 # global variables.
 proc gdb_setup_known_globals {} {
@@ -5114,10 +5121,14 @@ proc gdb_setup_known_globals {} {
 # 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
+    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
        }
     }--
diff --git a/gdb/testsuite/lib/mi-support.exp
b/gdb/testsuite/lib/mi-support.exp
index 1e59919ab4..2804cfc308 100644
--- a/gdb/testsuite/lib/mi-support.exp
+++ b/gdb/testsuite/lib/mi-support.exp
@@ -25,6 +25,7 @@ global mi_gdb_prompt
 if ![info exists mi_gdb_prompt] then {
     set mi_gdb_prompt "\[(\]gdb\[)\] \r\n"
 }
+gdb_persistent_global mi_gdb_prompt

 global mi_inferior_tty_name

@@ -39,11 +40,16 @@ global gdb_main_spawn_id
 global mi_spawn_id

 set MIFLAGS "-i=mi"
+gdb_persistent_global MIFLAGS

 set thread_selected_re "=thread-selected,id=\"\[0-9\]+\"\r\n"
+gdb_persistent_global thread_selected_re
 set gdbindex_warning_re "&\"warning: Skipping \[^\r\n\]+ \.gdb_index
section in \[^\r\n\]+\"\r\n(?:&\"\\\\n\"\r\n
)?"
+gdb_persistent_global gdbindex_warning_re
 set library_loaded_re
"=library-loaded\[^\n\]+\"\r\n(?:$gdbindex_warning_re)?"
+gdb_persistent_global library_loaded_re
 set breakpoint_re
"=(?:breakpoint-created|breakpoint-deleted)\[^\n\]+\"\r\n"
+gdb_persistent_global breakpoint_re

 #
 # mi_gdb_exit -- exit the GDB, killing the target program if necessary
Tom de Vries June 3, 2020, 10:24 a.m. | #12
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.

> 

> This naive solution seems to work.

> 

> Perhaps we can override load_lib to do the same, automatically.

> 


That seems to work, I'll test this through.

Thanks,
- Tom

diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp
index 66de9d6be3..bca47b96f2 100644
--- a/gdb/testsuite/lib/gdb.exp
+++ b/gdb/testsuite/lib/gdb.exp
@@ -25,6 +25,39 @@ if {$tool == ""} {
     exit 2
 }

+rename load_lib saved_load_lib
+
+array set gdb_persistent_globals {}
+
+proc gdb_persistent_global { varname } {
+    global gdb_persistent_globals
+    set gdb_persistent_globals($varname) 1
+}
+
+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
@@ -5114,10 +5147,14 @@ proc gdb_setup_known_globals {} {
 # 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
+    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
        }
     }
Andrew Burgess June 3, 2020, 12:54 p.m. | #13
* 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.

Thanks,
Andrew

> > 

> > This naive solution seems to work.

> > 

> > Perhaps we can override load_lib to do the same, automatically.

> > 

> 

> That seems to work, I'll test this through.

> 

> Thanks,

> - Tom

> 

> diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp

> index 66de9d6be3..bca47b96f2 100644

> --- a/gdb/testsuite/lib/gdb.exp

> +++ b/gdb/testsuite/lib/gdb.exp

> @@ -25,6 +25,39 @@ if {$tool == ""} {

>      exit 2

>  }

> 

> +rename load_lib saved_load_lib

> +

> +array set gdb_persistent_globals {}

> +

> +proc gdb_persistent_global { varname } {

> +    global gdb_persistent_globals

> +    set gdb_persistent_globals($varname) 1

> +}

> +

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

> @@ -5114,10 +5147,14 @@ proc gdb_setup_known_globals {} {

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

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

>         }

>      }

>
Tom de Vries June 3, 2020, 3:35 p.m. | #14
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
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
 }
Simon Marchi via Gdb-patches June 4, 2020, 11:16 a.m. | #15
On 6/3/20 4:35 PM, Tom de Vries wrote:
> @@ -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


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


Can we make gdb_persistent_global proc also do the "global $var"
in the caller's scope, so that it could be used to replace
the "global" statement?  With that, you would only have to declare
the variable once, and this hunk here would instead be:

diff --git c/gdb/testsuite/lib/pascal.exp w/gdb/testsuite/lib/pascal.exp
index aad69a2de0..ff11864294 100644
--- c/gdb/testsuite/lib/pascal.exp
+++ w/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

Thanks,
Pedro Alves
Tom de Vries June 4, 2020, 11:40 a.m. | #16
On 03-06-2020 11:49, Pedro Alves wrote:
> On 6/2/20 4:38 PM, Andrew Burgess wrote:

> 

>> If we're going to add code to loop over all globals anyway, then why

>> not, instead of warning about bad cases, and then wrapping tests in a

>> namespace, just have this code "fix" the leaked globals by deleting

>> them?

>>

>> My thinking is that any global that exists when we start a test should

>> continue to exist at the end of the test.  Any other global should

>> just be unset when the test script finishes.

>>

>> If there really is some global state that is lazily created by a

>> particular test script then (a) this seems like a bug anyway, and (b)

>> this is easy to fix by giving it an earlier creation / initialisation.

>>

>> In this way, folk can just write test scripts, dump their junk all

>> over the global namespace as they like, and we'll just clean up for

>> them.

>>

>> Thoughts?

> 

> Hmm, I thought of this when I saw Tom's detection patch the first time,

> but dismissed it, perhaps too quickly, thinking that it wouldn't

> be safe.  You mention global state lazily created by test scripts, but I was

> thinking of lazy initialized globals within Dejagnu itself, or whatever Tcl

> library we might end up using the future, which might need to be carried

> over from testcase to testcase.  Imagine, this in a Dejagnu function:

> 

> proc fail {} {

>    global number_of_fails

> 

>    # Hadn't been set before.  (valid since Tcl 8.5; otherwise, imagine it wrapped in 'info exits')

>    incr number_of_fails

> }

> 

> This is obviously not the real "fail", it is just to

> show the point, or the risk.  I imagined there might be similar

> functions in random Dejagnu boards.

> 


Agreed, that is a risk.

A less aggressive approach is also possible though: only prevent leaked
global arrays, and leave the rest of the global state unmodified.

> (

> Now that I look, it seems like Dejagnu wants to be sure to initialize

> all global variables it uses in runtest.exp:

> 

>  # Initialize a few global variables used by all tests.

>  # `reset_vars' resets several of these, we define them here to document their

>  # existence.  In fact, it would be nice if all globals used by some interface

>  # of dejagnu proper were documented here.

> 

> And I guess we can always initialize some ourselves, if we find that missing.

> )

>


Right, or, in terms of the latest proposed patch, call
gdb_persistent_global with the varname as argument.

> So if people think the benefits outweigh the risks, then I guess

> we should give it a go.

> 


I guess it's worth a try, it could be easily reverted if it cause
trouble.  If it causes trouble, it will take somebody's time, but OTOH
it will also take time to manually fix up test-cases to prevent the
originally proposed warning.

> BTW, global variables alone aren't the full scope of the

> bleeding between testcases.  There's also the case of

> testcases overriding procedures, like gdb.base/dbx.exp,

> but those are perhaps rare enough that we can continue

> handling it "manually" as before.


AFAICT, that test-case does an effort to undo the override, though I'm
not sure how certain it is that the undo will be executed.

Also, while working on the latest proposed patch, I also ran into
trouble related to the renaming of spawn in lib/tuiterm.exp. I wonder if
to address this we could wrap every tui test-case in
...
tui_env {
   ...
}
...
and letting the tui_env proc deal with renaming and restoring the spawn.
 We could even automate this in gdb_init/gdb_finish by calling
gdb_init_$subdir/gdb_finish_$subdir and handling it there.

Thanks,
- Tom
Tom de Vries June 4, 2020, 12:29 p.m. | #17
On 04-06-2020 13:16, Pedro Alves wrote:
> On 6/3/20 4:35 PM, Tom de Vries wrote:

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

> 

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

> 

> Can we make gdb_persistent_global proc also do the "global $var"

> in the caller's scope, so that it could be used to replace

> the "global" statement?  With that, you would only have to declare

> the variable once, and this hunk here would instead be:


Done, currently re-testing.

Thanks,
- Tom
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, 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.
	* lib/tuiterm.exp (spawn): Don't assume gdb_spawn_name is set.

---
 gdb/testsuite/lib/gdb.exp     | 92 ++++++++++++++++++++++++++++++++++++++++++-
 gdb/testsuite/lib/pascal.exp  |  8 ++--
 gdb/testsuite/lib/tuiterm.exp |  4 +-
 3 files changed, 97 insertions(+), 7 deletions(-)

diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp
index 444cea01c3..65dd31f1ab 100644
--- a/gdb/testsuite/lib/gdb.exp
+++ b/gdb/testsuite/lib/gdb.exp
@@ -25,6 +25,57 @@ 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 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
@@ -5196,13 +5279,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 +5314,8 @@ proc gdb_finish { } {
 	}
 	set banned_traced 0
     }
+
+    gdb_cleanup_globals
 }
 
 global debug_format
@@ -6935,7 +7023,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 } {
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
 }

Patch

diff --git a/gdb/testsuite/gdb.mi/mi-var-cp.exp b/gdb/testsuite/gdb.mi/mi-var-cp.exp
index 8c6a624f80..dc32ddc346 100644
--- a/gdb/testsuite/gdb.mi/mi-var-cp.exp
+++ b/gdb/testsuite/gdb.mi/mi-var-cp.exp
@@ -23,6 +23,9 @@  if [mi_gdb_start] {
     continue
 }
 
+# FIXME.  See check_global_vars in lib/gdb.exp.
+set gdb_skip_check_global_vars 1
+
 standard_testfile .cc
 
 if [get_compiler_info "c++"] {
diff --git a/gdb/testsuite/gdb.mi/mi2-var-child.exp b/gdb/testsuite/gdb.mi/mi2-var-child.exp
index e32858fbd3..b96ac41815 100644
--- a/gdb/testsuite/gdb.mi/mi2-var-child.exp
+++ b/gdb/testsuite/gdb.mi/mi2-var-child.exp
@@ -27,6 +27,9 @@  if [mi_gdb_start] {
     continue
 }
 
+# FIXME.  See check_global_vars in lib/gdb.exp.
+set gdb_skip_check_global_vars 1
+
 standard_testfile var-cmd.c
 
 if  { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable {debug}] != "" } {
diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp
index f7d20bd94f..a0d558c943 100644
--- a/gdb/testsuite/lib/gdb.exp
+++ b/gdb/testsuite/lib/gdb.exp
@@ -5048,6 +5048,98 @@  proc standard_testfile {args} {
     }
 }
 
+# Returns 1 if GLOBALVARNAME is a global array.
+
+proc global_array_exists { globalvarname } {
+    # Introduce local alias of global variable $globalvarname.  Using
+    # "global $globalvarname" instead is simpler, but this may result in a
+    # clash with local name "globalvarname".
+    upvar #0 $globalvarname globalvar
+    return [array exists globalvar]
+}
+
+# Unset global variable GLOBALVARNAME.
+
+proc global_unset { globalvarname } {
+    # Introduce local alias of global variable $globalvarname.
+    upvar #0 $globalvarname globalvar
+    unset globalvar
+}
+
+# Save global vars to variable gdb_global_vars.
+
+proc save_global_vars { test_file_name } {
+    # Save for the warning.
+    global gdb_test_file_name
+    set gdb_test_file_name $test_file_name
+
+    # Sample state before running test.
+    global gdb_global_vars
+    set gdb_global_vars [info globals]
+
+    global gdb_skip_check_global_vars
+    if { [info exists gdb_skip_check_global_vars]} {
+	unset gdb_skip_check_global_vars
+    }
+}
+
+# Check global variables not in gdb_global_vars.
+
+proc check_global_vars { } {
+    global gdb_skip_check_global_vars
+    if { [info exists gdb_skip_check_global_vars]} {
+	return
+    }
+    # Sample state after running test.
+    global gdb_global_vars
+    set vars [info globals]
+
+    set skip [list "expect_out" "spawn_out" "auto_index"]
+
+    foreach var $vars {
+	if { ![global_array_exists $var] } {
+	    continue
+	}
+
+	set found [lsearch -exact $gdb_global_vars $var]
+	if { $found != -1 } {
+	    # Already present before running test.
+	    continue
+	}
+
+	set found [lsearch -exact $skip $var]
+	if { $found != -1 } {
+	    continue
+	}
+
+	# A variable name cannot be used both as scalar and array without an
+	# intermediate unset.  Trying to do so will result in tcl errors, for
+	# example, for:
+	#   set var "bla"
+	#   set var(1) "bla"
+	# we get:
+	#   can't set "var(1)": variable isn't array
+	# and for the reverse statement order we get:
+	#   can't set "var": variable is array
+	#
+	# So, since a global name in one test-case can leak to another
+	# test-case, setting a global name in one test-case can result in
+	# a tcl error in another test-case that reuses the name in a different
+	# way.
+	#
+	# Warn about leaking a global array from the test-case.
+	#
+	# For a description on how to fix this, see "Wrapping test-cases in
+	# Tcl namespaces" in gdb/testsuite/README.
+	global gdb_test_file_name
+	warning "$gdb_test_file_name.exp defined global array $var"
+
+	# If the variable remains set, we won't warn for the next test where
+	# it's leaked, so unset.
+	global_unset $var
+    }
+}
+
 # The default timeout used when testing GDB commands.  We want to use
 # the same timeout as the default dejagnu timeout, unless the user has
 # already provided a specific value (probably through a site.exp file).
@@ -5177,10 +5269,12 @@  proc gdb_init { test_file_name } {
     global gdb_instances
     set gdb_instances 0
 
+    save_global_vars $test_file_name
     return [default_gdb_init $test_file_name]
 }
 
 proc gdb_finish { } {
+    check_global_vars
     global gdbserver_reconnect_p
     global gdb_prompt
     global cleanfiles