From 78564d3f6c131db76a01de9492690a812e5e9141 Mon Sep 17 00:00:00 2001 From: Tom de Vries Date: Wed, 19 Jun 2024 09:56:44 +0200 Subject: [gdb/testsuite] Add string cat for tcl version < 8.6.2 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 --- gdb/testsuite/gdb.testsuite/string-cat.exp | 15 ++++++++++++ gdb/testsuite/lib/gdb.exp | 37 ++++++++++++++++++++++++------ 2 files changed, 45 insertions(+), 7 deletions(-) create mode 100644 gdb/testsuite/gdb.testsuite/string-cat.exp diff --git a/gdb/testsuite/gdb.testsuite/string-cat.exp b/gdb/testsuite/gdb.testsuite/string-cat.exp new file mode 100644 index 0000000..057aeb2 --- /dev/null +++ b/gdb/testsuite/gdb.testsuite/string-cat.exp @@ -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 . + +gdb_assert { [string cat "foo" "bar"] == "foobar" } diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp index 590cd45..dfe19c9 100644 --- a/gdb/testsuite/lib/gdb.exp +++ b/gdb/testsuite/lib/gdb.exp @@ -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. # -- cgit v1.1