From: Tom Tromey Date: Thu, 22 Jun 2023 15:17:26 +0000 (-0600) Subject: Add Ada scope test for DAP X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=405a9dd06417a9272442b8818a867f6c008b7a48;p=binutils-gdb.git Add Ada scope test for DAP 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. --- 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;