https://gcc.gnu.org/g:b599498e1842ef00a298d7c423a2dcd3859a3bca
commit r15-5574-gb599498e1842ef00a298d7c423a2dcd3859a3bca Author: David Malcolm <dmalc...@redhat.com> Date: Thu Nov 21 14:36:16 2024 -0500 testsuite: add print-stack.exp I wrote this support file to help me debug Tcl issues in the testsuite. Adding a call to: print_stack_backtrace somewhere in a .exp file (along with "load_lib print-stack.exp") leads to the interpreter printing a backtrace in a form that e.g. Emacs can consume, with filename:linenum: lines, and quoting the line of .exp source code. Fer example, adding a print_stack_backtrace to scansarif.exp in run-sarif-pytest I get this output: VVV START OF BACKTRACE VVV /home/david/coding/gcc-newgit/src/gcc/testsuite/lib/scansarif.exp:142: frame 16 in proc print_stack_backtrace 142 | print_stack_backtrace <proc>: frame 15 in proc run-sarif-pytest <eval>: frame 14 in proc dg-final-proc /usr/share/dejagnu/dg.exp:851: frame 13 in proc dg-final-proc 851 | if {[catch "dg-final-proc $prog" errmsg]} { <eval>: frame 12 in proc saved-dg-test /home/david/coding/gcc-newgit/src/gcc/testsuite/lib/gcc-dg.exp:1080: frame 11 in proc saved-dg-test 1080 | if { [ catch { eval saved-dg-test $args } errmsg ] } { /usr/share/dejagnu/dg.exp:559: frame 10 in proc dg-test 559 | dg-test $testcase $options ${default-extra-options} /home/david/coding/gcc-newgit/src/gcc/testsuite/gcc.dg/sarif-output/sarif-output.exp:28: frame 9 28 | dg-runtest [lsort [glob -nocomplain $srcdir/$subdir/*.c]] "" "" <eval>: frame 8 <eval>: frame 7 /usr/share/dejagnu/runtest.exp:1460: frame 6 1460 | if { [catch "uplevel #0 source $test_file_name"] == 1 } { /usr/share/dejagnu/runtest.exp:1886: frame 5 in proc dg-runtest 1886 | runtest $test_name /usr/share/dejagnu/runtest.exp:1845: frame 4 in proc dg-runtest 1845 | foreach test_name [lsort [find ${dir} *.exp]] { /usr/share/dejagnu/runtest.exp:1788: frame 3 in proc dg-runtest 1788 | foreach dir "${test_top_dirs}" { /usr/share/dejagnu/runtest.exp:1669: frame 2 in proc dg-runtest 1669 | foreach pass $multipass { /usr/share/dejagnu/runtest.exp:1619: frame 1 in proc dg-runtest 1619 | foreach current_target $target_list { ^^^ END OF BACKTRACE ^^^ and can click on the lines in Emacs's compilation buffer to take me to the relevant places. I found this made it *much* easier to debug my .exp files. That said, I'm uncomfortable with Tcl, and so (a) there may be a better way of doing this (b) I may have made mistakes gcc/testsuite/ChangeLog: * lib/print-stack.exp: New file. Signed-off-by: David Malcolm <dmalc...@redhat.com> Diff: --- gcc/testsuite/lib/print-stack.exp | 62 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 62 insertions(+) diff --git a/gcc/testsuite/lib/print-stack.exp b/gcc/testsuite/lib/print-stack.exp new file mode 100644 index 000000000000..d83b9c89d388 --- /dev/null +++ b/gcc/testsuite/lib/print-stack.exp @@ -0,0 +1,62 @@ +# Copyright (C) 2024 Free Software Foundation, Inc. +# Contributed by David Malcolm <dmalc...@redhat.com>. + +# 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 GCC; see the file COPYING3. If not see +# <http://www.gnu.org/licenses/>. + +# Get the 1-based line for LINENUM from FILENAME as a string + +proc get_line { filename linenum } { + set f [open $filename] + set lines [split [read $f] \n] + close $f + return [lindex $lines [expr $linenum - 1] ] +} + +# Print a backtrace of the Tcl interpreter's stack, showing +# frames, levels, source file and line where available. +# +# This isn't used anywhere, but is occasionally very helpful +# to use when debugging. + +proc print_stack_backtrace {} { + set current_frame_level [info frame] + puts "VVV START OF BACKTRACE VVV" + for {set i [expr $current_frame_level - 1]} {$i > 0} {incr i -1} { + set frame [info frame $i] + if { [dict exists $frame "level"] } { + set level_num [dict get $frame "level"] + set relative_level_offset [expr 1 - $level_num] + set level [info level $relative_level_offset] + set procname [lindex $level 0] + # TODO: args = rest of $level, but this can be very long + } else { + set procname "" + } + set suffix "" + if { $procname != "" } { + set suffix " in proc $procname" + } + if { [dict get $frame "type"] == "source" } { + set fname [dict get $frame "file"] + set line [dict get $frame "line"] + puts " $fname:$line: frame $i$suffix" + puts " $line | [get_line $fname $line]" + } else { + set type [dict get $frame "type"] + puts " <$type>: frame $i$suffix" + } + } + puts "^^^ END OF BACKTRACE ^^^" +}