From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mail-io1-xd36.google.com (mail-io1-xd36.google.com [IPv6:2607:f8b0:4864:20::d36]) by sourceware.org (Postfix) with ESMTPS id C34F83858426 for ; Thu, 22 Jun 2023 16:19:33 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org C34F83858426 Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com Received: by mail-io1-xd36.google.com with SMTP id ca18e2360f4ac-780ca92d8f5so39354939f.0 for ; Thu, 22 Jun 2023 09:19:33 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1687450773; x=1690042773; h=to:in-reply-to:references:message-id:content-transfer-encoding :mime-version:subject:date:from:from:to:cc:subject:date:message-id :reply-to; bh=lGd0TOFg49v8FcngKfRw6wx9nRtoLyg0Nc1q8BWZre4=; b=HcimEuzj8Def4NapTyDfczkGkWqrfIyB0jVIqUOBX7cao0x4LorKNfUrgLpBr7fgaj 9UTsVktnBZDytjxXm0Dt5f2EY9p7B9TeE3k/IbauBx4fBJ6tYN6j39KmwjyCbjKEZdKu NjO6XSXIYSCedFoS4XfcuLiOy08wTTx/zSALTq9HleRWMd7Pci9DEwR+J85camFfdqBg Hi/zbQGzDnH4ziYQhzxHI72hc86ZMwaID2w8hNl492mbhxGBayMF53Ac8wqADTbTWedz AZsHs11vEfv4Q/ntVlCWUVUYh86ak2XJt40ZR0JUsiblt0k6LQhZp1wZx8oG87Y5LnKe GteQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20221208; t=1687450773; x=1690042773; h=to:in-reply-to:references:message-id:content-transfer-encoding :mime-version:subject:date:from:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=lGd0TOFg49v8FcngKfRw6wx9nRtoLyg0Nc1q8BWZre4=; b=g1D3d4gMsPssnzP3aC79hHRUSCW4QkjpKIvoLg0KCz4dW0U+u9N9Mug892/P2la2L+ TACX0b17iIG4VGV+Co3Jx7g5azkvN8J5sKnSd9d+0mCmU4uq105gBh/6QUQwVP88BEQT yEYwT+SoPCeGn7EqJXbYiDrq0BQSfESyDcg1lRC6BGKeV4j+XsMIx7oK48wCkI4XkX5K 2lA2mg/n2JhckGrCK7t43Hz7j85rWgH+8BSgtMgvFzHpwWsAITcgDDkaOEqN16cecdkI o/9+Vv/Mw+2za5ptka62CC/XRYdmBhEuPyRHGomVwCxHymWn6S8s4oBIs1Xen4vzWzeE zN4Q== X-Gm-Message-State: AC+VfDxU90Cugxwqfc2w1tH0pat/lGeMYWQKl8B9NOAXPmyP8ytJbMWq k5qYbiFa6KbcT/bwwc4wAp7/PRUCY/uT3YD4EeOjUg== X-Google-Smtp-Source: ACHHUZ7DpJ7hKBleVxK8guB6bNw0A9au6T/7+ymvYtNjblPowPYg5Iop+wNpq5Rv4gj0R0Y0l9g+nw== X-Received: by 2002:a5d:9f05:0:b0:780:c787:637d with SMTP id q5-20020a5d9f05000000b00780c787637dmr3215110iot.17.1687450772835; Thu, 22 Jun 2023 09:19:32 -0700 (PDT) Received: from localhost.localdomain (75-166-136-83.hlrn.qwest.net. [75.166.136.83]) by smtp.gmail.com with ESMTPSA id y8-20020a6bd808000000b0077ac2261248sm2201987iob.5.2023.06.22.09.19.32 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 22 Jun 2023 09:19:32 -0700 (PDT) From: Tom Tromey Date: Thu, 22 Jun 2023 10:19:33 -0600 Subject: [PATCH v2 7/7] Add Ada scope test for DAP MIME-Version: 1.0 Content-Type: text/plain; charset="utf-8" Content-Transfer-Encoding: 7bit Message-Id: <20230614-dap-frame-decor-v2-7-10628dfa6b60@adacore.com> References: <20230614-dap-frame-decor-v2-0-10628dfa6b60@adacore.com> In-Reply-To: <20230614-dap-frame-decor-v2-0-10628dfa6b60@adacore.com> To: gdb-patches@sourceware.org X-Mailer: b4 0.12.2 X-Spam-Status: No, score=-11.5 required=5.0 tests=BAYES_00,DKIM_SIGNED,DKIM_VALID,DKIM_VALID_AU,DKIM_VALID_EF,GIT_PATCH_0,KAM_SHORT,RCVD_IN_DNSWL_NONE,SPF_HELO_NONE,SPF_PASS,TXREP,T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org List-Id: This adds a DAP test for fetching scopes and variables with an Ada program. This test is the reason that the FrameVars code does not check is_constant on the symbols it returns. Note that this test also shows that string-printing is incorrect in Ada. This is a known bug but I'm still considering how to fix it. --- gdb/testsuite/gdb.dap/ada-scopes.exp | 84 +++++++++++++++++++++++++++++++ gdb/testsuite/gdb.dap/ada-scopes/pack.adb | 23 +++++++++ gdb/testsuite/gdb.dap/ada-scopes/pack.ads | 21 ++++++++ gdb/testsuite/gdb.dap/ada-scopes/prog.adb | 26 ++++++++++ 4 files changed, 154 insertions(+) diff --git a/gdb/testsuite/gdb.dap/ada-scopes.exp b/gdb/testsuite/gdb.dap/ada-scopes.exp new file mode 100644 index 00000000000..75d51f96ab4 --- /dev/null +++ b/gdb/testsuite/gdb.dap/ada-scopes.exp @@ -0,0 +1,84 @@ +# Copyright 2023 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 . + +load_lib ada.exp +load_lib dap-support.exp + +require allow_ada_tests allow_dap_tests + +standard_ada_testfile prog + +if {[gdb_compile_ada "${srcfile}" "${binfile}" executable \ + {debug additional_flags=-gnata}] != ""} { + return -1 +} + +if {[dap_launch $binfile] == ""} { + return +} + +set line [gdb_get_line_number "STOP"] +set obj [dap_check_request_and_response "set breakpoint" \ + setBreakpoints \ + [format {o source [o path [%s]] \ + breakpoints [a [o line [i %d]]]} \ + [list s $srcfile] $line]] +set fn_bpno [dap_get_breakpoint_number $obj] + +dap_check_request_and_response "start inferior" configurationDone + +dap_wait_for_event_and_check "stopped at breakpoint" stopped \ + "body reason" breakpoint \ + "body hitBreakpointIds" $fn_bpno + +set bt [lindex [dap_check_request_and_response "backtrace" stackTrace \ + {o threadId [i 1]}] \ + 0] +set frame_id [dict get [lindex [dict get $bt body stackFrames] 0] id] + +set scopes [dap_check_request_and_response "get scopes" scopes \ + [format {o frameId [i %d]} $frame_id]] +set scopes [dict get [lindex $scopes 0] body scopes] + +# This is what the implementation does, so we can assume it, but check +# just in case something changes. +lassign $scopes scope _ignore +gdb_assert {[dict get $scope name] == "Locals"} "scope is locals" + +gdb_assert {[dict get $scope namedVariables] == 2} "two vars in scope" + +set num [dict get $scope variablesReference] +set refs [lindex [dap_check_request_and_response "fetch variables" \ + "variables" \ + [format {o variablesReference [i %d] count [i 2]} \ + $num]] \ + 0] + +foreach var [dict get $refs body variables] { + set name [dict get $var name] + + switch $name { + "value" { + gdb_assert {[dict get $var value] == "three"} "check value of value" + } + "my_string" { + } + default { + fail "unknown variable $name" + } + } +} + +dap_shutdown diff --git a/gdb/testsuite/gdb.dap/ada-scopes/pack.adb b/gdb/testsuite/gdb.dap/ada-scopes/pack.adb new file mode 100644 index 00000000000..a97a8293b0e --- /dev/null +++ b/gdb/testsuite/gdb.dap/ada-scopes/pack.adb @@ -0,0 +1,23 @@ +-- Copyright 2023 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 . + +package body Pack is + + procedure Do_Nothing (A : System.Address) is + begin + null; + end Do_Nothing; + +end Pack; diff --git a/gdb/testsuite/gdb.dap/ada-scopes/pack.ads b/gdb/testsuite/gdb.dap/ada-scopes/pack.ads new file mode 100644 index 00000000000..3a6721d62d2 --- /dev/null +++ b/gdb/testsuite/gdb.dap/ada-scopes/pack.ads @@ -0,0 +1,21 @@ +-- Copyright 2023 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 . + +with System; +package Pack is + + procedure Do_Nothing (A : System.Address); + +end Pack; diff --git a/gdb/testsuite/gdb.dap/ada-scopes/prog.adb b/gdb/testsuite/gdb.dap/ada-scopes/prog.adb new file mode 100644 index 00000000000..5f6ccd5ee66 --- /dev/null +++ b/gdb/testsuite/gdb.dap/ada-scopes/prog.adb @@ -0,0 +1,26 @@ +-- Copyright 2023 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 . + +with Pack; use Pack; + +procedure Foo is + type Enum_Type is (one, two, three); + Value : Enum_Type := three; + + My_String : constant String := "Hello World"; +begin + Do_Nothing (Value'address); + Do_Nothing (My_String'address); -- STOP +end Foo; -- 2.40.1