[gdb/testsuite] Allow procs with default value args in with_override

Currently proc with_override does not work with procs with default value args.

Fix this, and add a test-case excercising this scenario.

Tested on x86_64-linux.
This commit is contained in:
Tom de Vries 2023-06-13 12:24:17 +02:00
parent 40bea10383
commit cc313a1d84
2 changed files with 99 additions and 2 deletions

View file

@ -0,0 +1,81 @@
# Copyright 2023 Free Software Foundation, Inc.
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
# Check with_override proc.
proc foo {} {
return 0
}
proc foo1 {} {
return 1
}
proc foo2 {} {
return 2
}
with_test_prefix no-args {
with_test_prefix before {
gdb_assert { [foo] == 0 }
}
with_override foo foo1 {
with_test_prefix foo1 {
gdb_assert { [foo] == 1 }
}
with_override foo foo2 {
with_test_prefix foo2 {
gdb_assert { [foo] == 2 }
}
}
}
with_test_prefix after {
gdb_assert { [foo] == 0 }
}
}
proc foo { {a 0} } {
return [expr $a + 1]
}
proc foo_plus_1 { {a 0} } {
return [expr $a + 2]
}
with_test_prefix default-arg {
with_test_prefix before {
gdb_assert { [foo] == 1 }
gdb_assert { [foo 0] == 1 }
gdb_assert { [foo 1] == 2 }
}
with_override foo foo_plus_1 {
with_test_prefix foo_plus_1 {
gdb_assert { [foo] == 2 }
gdb_assert { [foo 0] == 2 }
gdb_assert { [foo 1] == 3 }
}
}
with_test_prefix after {
gdb_assert { [foo] == 1 }
gdb_assert { [foo 0] == 1 }
gdb_assert { [foo 1] == 2 }
}
}

View file

@ -9062,6 +9062,22 @@ proc hex_in_list { val hexlist } {
return [expr $index != -1]
}
# As info args, but also add the default values.
proc info_args_with_defaults { name } {
set args {}
foreach arg [info args $name] {
if { [info default $name $arg default_value] } {
lappend args [list $arg $default_value]
} else {
lappend args $arg
}
}
return $args
}
# Override proc NAME to proc OVERRIDE for the duration of the execution of
# BODY.
@ -9081,7 +9097,7 @@ proc with_override { name override body } {
# Save the old proc, if it exists.
if { [info procs $name] != "" } {
set old_args [info args $name]
set old_args [info_args_with_defaults $name]
set old_body [info body $name]
set existed true
} else {
@ -9089,7 +9105,7 @@ proc with_override { name override body } {
}
# Install the override.
set new_args [info args $override]
set new_args [info_args_with_defaults $override]
set new_body [info body $override]
eval proc $name {$new_args} {$new_body}