FreeChainXenon/binutils-gdb
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

[gdb/testsuite] Add string cat for tcl version < 8.6.2

Browse source 
I noticed that we started using "string cat", which has been available since
tcl version 8.6.2.

Add a local implementation for use with older tcl versions.

Tested on x86_64-linux.

Approved-By: Andrew Burgess <aburgess@redhat.com>
This commit is contained in:
Tom de Vries 2024-06-19 09:56:44 +02:00
parent be23e44263
commit 78564d3f6c
2 changed files with 45 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
gdb/testsuite/gdb.testsuite/string-cat.exp Normal file
View file

@ -0,0 +1,15 @@
# Copyright 2024 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/>.
gdb_assert { [string cat "foo" "bar"] == "foobar" }

37
gdb/testsuite/lib/gdb.exp
View file

@ -1607,13 +1607,23 @@ proc python_version_at_least { major minor } {
<= [list $python_version_major $python_version_minor]]
}
# Return 1 if tcl version used is at least MAJOR.MINOR
proc tcl_version_at_least { major minor } {
global tcl_version
regexp {^([0-9]+)\.([0-9]+)$} $tcl_version \
dummy tcl_version_major tcl_version_minor
return [version_compare [list $major $minor] \
<= [list $tcl_version_major $tcl_version_minor]]
# Return 1 if tcl version used is at least MAJOR.MINOR.PATCHLEVEL.
proc tcl_version_at_least { major minor {patchlevel 0} } {
global tcl_patchLevel
regexp {^([0-9]+)\.([0-9]+)\.([0-9]+)$} \
$tcl_patchLevel dummy \
tcl_version_major tcl_version_minor tcl_version_patchlevel
return \
[version_compare \
[list \
$major \
$minor \
$patchlevel] \
<= \
[list \
$tcl_version_major \
$tcl_version_minor \
$tcl_version_patchlevel]]
}
if { [tcl_version_at_least 8 5] == 0 } {
@ -1648,6 +1658,19 @@ if { [tcl_version_at_least 8 6] == 0 } {
}
}
if { [tcl_version_at_least 8 6 2] == 0 } {
# string cat was added in tcl 8.6.2. Only add if missing.
rename string tcl_proc_string
proc string { what args } {
if { $what == "cat" } {
return [join $args ""]
}
return [tcl_proc_string $what {*}$args]
}
}
# gdb_test_no_output [-prompt PROMPT_REGEXP] [-nopass] COMMAND [MESSAGE]
# Send a command to GDB and verify that this command generated no output.
#