From patchwork Thu Aug 1 00:51:19 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: David Malcolm X-Patchwork-Id: 1967372 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@legolas.ozlabs.org Authentication-Results: legolas.ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=redhat.com header.i=@redhat.com header.a=rsa-sha256 header.s=mimecast20190719 header.b=WpnXHYcO; dkim-atps=neutral Authentication-Results: legolas.ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=2620:52:3:1:0:246e:9693:128c; helo=server2.sourceware.org; envelope-from=gcc-patches-bounces~incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=patchwork.ozlabs.org) Received: from server2.sourceware.org (server2.sourceware.org [IPv6:2620:52:3:1:0:246e:9693:128c]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature ECDSA (secp384r1) server-digest SHA384) (No client certificate requested) by legolas.ozlabs.org (Postfix) with ESMTPS id 4WZ9SP33WMz1ybX for ; Thu, 1 Aug 2024 10:53:25 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 9E953385B50B for ; Thu, 1 Aug 2024 00:53:23 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from us-smtp-delivery-124.mimecast.com (us-smtp-delivery-124.mimecast.com [170.10.133.124]) by sourceware.org (Postfix) with ESMTP id 612CA385DC1B for ; Thu, 1 Aug 2024 00:51:29 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 612CA385DC1B Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=redhat.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=redhat.com ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 612CA385DC1B Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=170.10.133.124 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1722473491; cv=none; b=rDissnoJQ0VjdeVLqwmxOgpw0B2VJ8wPjigPxSvMnuAsI0zEeKFZ3SjmfMZAI2IN/30iDb8uoeRwpFUZbjp8I+uQHwfl6xebMxFgnjRzYEWHE5+qvwayE6t+P0ynD4S/TMAdW5Y8Rb51+XohAviPOL1FyNB1w/OB2uSE084os54= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1722473491; c=relaxed/simple; bh=5r2er75undY++WhqX1LwLPV5IBqP2q69nfPdzRQ0m3g=; h=DKIM-Signature:From:To:Subject:Date:Message-Id:MIME-Version; b=tElEC45+V/XQjjFbW8R25oxlMS3lQxRuzqx+SzPd+XNzi64YTn2YAgbvLUf6U1ZiO26yzIrigDKo7rX4IcUZO57K0bjOL0kxHt6z3lF3YeEHEx0+8mVrZ47/+iZs0+0qACShcYzCXScfPnkrwWdL4VB0iqd6A4lJY14aeC8kj3E= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=redhat.com; s=mimecast20190719; t=1722473489; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:cc:mime-version:mime-version:content-type:content-type: content-transfer-encoding:content-transfer-encoding; bh=wm2HEAq4bofsNPEoJJGFDnoRhpx7XDbpkALdgsKgGkc=; b=WpnXHYcOJ/SWBNiNG096F0N0I5qEZWkA3bAFY8secqgl2r0O3LC1HH1HoQ6VgvLv+tDss9 T49LXvJa4HLskaFWsoAydk77T8KTxW9U5y0Mz7X0NKWqwmdf0eI6XF+SoTrK6DlXuMb2Gv NvfrXZE+dmyk7bWAnh+GB1G3hzaJ5fs= Received: from mx-prod-mc-04.mail-002.prod.us-west-2.aws.redhat.com (ec2-54-186-198-63.us-west-2.compute.amazonaws.com [54.186.198.63]) by relay.mimecast.com with ESMTP with STARTTLS (version=TLSv1.3, cipher=TLS_AES_256_GCM_SHA384) id us-mta-138-qiwJojjZOIuWqNDwyoSjYg-1; Wed, 31 Jul 2024 20:51:27 -0400 X-MC-Unique: qiwJojjZOIuWqNDwyoSjYg-1 Received: from mx-prod-int-02.mail-002.prod.us-west-2.aws.redhat.com (mx-prod-int-02.mail-002.prod.us-west-2.aws.redhat.com [10.30.177.15]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (2048 bits) server-digest SHA256) (No client certificate requested) by mx-prod-mc-04.mail-002.prod.us-west-2.aws.redhat.com (Postfix) with ESMTPS id C1AA71955D42 for ; Thu, 1 Aug 2024 00:51:26 +0000 (UTC) Received: from t14s.localdomain.com (unknown [10.22.33.183]) by mx-prod-int-02.mail-002.prod.us-west-2.aws.redhat.com (Postfix) with ESMTP id E6D071955D42; Thu, 1 Aug 2024 00:51:25 +0000 (UTC) From: David Malcolm To: gcc-patches@gcc.gnu.org Cc: David Malcolm Subject: [PATCH] testsuite: add print-stack.exp Date: Wed, 31 Jul 2024 20:51:19 -0400 Message-Id: <20240801005119.1003942-1-dmalcolm@redhat.com> MIME-Version: 1.0 X-Scanned-By: MIMEDefang 3.0 on 10.30.177.15 X-Mimecast-Spam-Score: 0 X-Mimecast-Originator: redhat.com X-Spam-Status: No, score=-11.7 required=5.0 tests=BAYES_00, DKIMWL_WL_HIGH, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, GIT_PATCH_0, KAM_SHORT, RCVD_IN_DNSWL_NONE, RCVD_IN_MSPIKE_H4, RCVD_IN_MSPIKE_WL, SPF_HELO_NONE, SPF_NONE, TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces~incoming=patchwork.ozlabs.org@gcc.gnu.org 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 : frame 15 in proc run-sarif-pytest : 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]} { : 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]] "" "" : frame 8 : 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 OK for trunk? gcc/testsuite/ChangeLog: * lib/print-stack.exp: New file. Signed-off-by: David Malcolm --- gcc/testsuite/lib/print-stack.exp | 59 +++++++++++++++++++++++++++++++ 1 file changed, 59 insertions(+) create mode 100644 gcc/testsuite/lib/print-stack.exp diff --git a/gcc/testsuite/lib/print-stack.exp b/gcc/testsuite/lib/print-stack.exp new file mode 100644 index 00000000000..5688d0a63de --- /dev/null +++ b/gcc/testsuite/lib/print-stack.exp @@ -0,0 +1,59 @@ +# Copyright (C) 2024 Free Software Foundation, Inc. +# Contributed by David Malcolm . + +# 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 +# . + +# 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. + +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 ^^^" +}