This is the mail archive of the
gdb-patches@sourceware.org
mailing list for the GDB project.
[patch] testsuite: Fix Tcl < 7.5 regression [Re: [PATCH] sigall.exp and friends: centralize signals list.]
- From: Jan Kratochvil <jan dot kratochvil at redhat dot com>
- To: Pedro Alves <palves at redhat dot com>
- Cc: gdb-patches at sourceware dot org
- Date: Wed, 25 Jul 2012 15:47:40 +0200
- Subject: [patch] testsuite: Fix Tcl < 7.5 regression [Re: [PATCH] sigall.exp and friends: centralize signals list.]
- References: <20120719143526.8328.28449.stgit@brno.lan>
On Thu, 19 Jul 2012 16:35:26 +0200, Pedro Alves wrote:
> Tested x86_64 Fedora 17, and applied.
[...]
> --- a/gdb/testsuite/gdb.reverse/sigall-precsave.exp
> +++ b/gdb/testsuite/gdb.reverse/sigall-precsave.exp
> +foreach sig [lreverse $signals] {
> + test_one_sig_reverse $sig
> +}
--- 20120719Build-gdbcvs-epel5/epel-5-x86_64/out/gdb-m32.sum 2012-07-19 07:08:00.075100625 +0200
+++ 20120720Build-gdbcvs-epel5/epel-5-x86_64/out/gdb-m32.sum 2012-07-20 07:56:27.967798598 +0200
-Running gdb/testsuite/gdb.reverse/sigall-reverse.exp ...
-PASS: gdb.reverse/sigall-reverse.exp: Turn on process record
[...]
+ERROR: (DejaGnu) proc "lreverse {
+ ABRT
[...]
+ TERM
+}" does not exist.
I will check it in today.
That 'info procs' is in fact not needed, 'proc lreverse' definition is a nop
with new Tcl (=it does not replace the built-in proc of the same name).
But I have rather put the conditional there.
Thanks,
Jan
gdb/testsuite/
2012-07-25 Jan Kratochvil <jan.kratochvil@redhat.com>
Fix compatibility with Tcl before 7.5.
* lib/future.exp (lreverse): New function if it does not exist.
diff --git a/gdb/testsuite/lib/future.exp b/gdb/testsuite/lib/future.exp
index bf47988..26e668f 100644
--- a/gdb/testsuite/lib/future.exp
+++ b/gdb/testsuite/lib/future.exp
@@ -521,3 +521,16 @@ if {$use_gdb_compile} {
catch {rename default_target_compile {}}
rename gdb_default_target_compile default_target_compile
}
+
+
+# Provide 'lreverse' missing in Tcl before 7.5.
+
+if {[info procs lreverse] == ""} {
+ proc lreverse { arg } {
+ set retval {}
+ while { [llength $retval] < [llength $arg] } {
+ lappend retval [lindex $arg end-[llength $retval]]
+ }
+ return $retval
+ }
+}