gdb/testsuite/gdb.dap/ada-arrays.exp

   1 # Copyright 2023-2024 Free Software Foundation, Inc.
   2 #
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 3 of the License, or
   6 # (at your option) any later version.
   7 #
   8 # This program is distributed in the hope that it will be useful,
   9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 # GNU General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License
  14 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15
  16 load_lib "ada.exp"
  17 load_lib dap-support.exp
  18
  19 require allow_dap_tests
  20 require allow_ada_tests
  21
  22 standard_ada_testfile main
  23 set cfile "cstuff"
  24 set csrcfile ${srcdir}/${subdir}/${testdir}/${cfile}.c
  25 set cobject [standard_output_file ${cfile}.o]
  26
  27 gdb_compile "${csrcfile}" "${cobject}" object [list debug]
  28 if {[gdb_compile_ada "${srcfile}" "${binfile}" executable debug] != ""} {
  29   return -1
  30 }
  31
  32 if {[dap_launch $testfile] == ""} {
  33     return
  34 }
  35
  36 # Stop in a C frame, but examine values in an Ada frame, to make sure
  37 # cross-language scenarios work correctly.
  38 set line [gdb_get_line_number "STOP" $testdir/cstuff.c]
  39 set obj [dap_check_request_and_response "set breakpoint by line number" \
  40              setBreakpoints \
  41              [format {o source [o path [%s]] breakpoints [a [o line [i %d]]]} \
  42                   [list s cstuff.c] $line]]
  43 set line_bpno [dap_get_breakpoint_number $obj]
  44
  45 dap_check_request_and_response "start inferior" configurationDone
  46 dap_wait_for_event_and_check "inferior started" thread "body reason" started
  47
  48 dap_wait_for_event_and_check "stopped at line breakpoint" stopped \
  49     "body reason" breakpoint \
  50     "body hitBreakpointIds" $line_bpno
  51
  52 set bt [lindex [dap_check_request_and_response "backtrace" stackTrace \
  53                     {o threadId [i 1]}] \
  54             0]
  55 # The Ada frame is frame 1.
  56 set frame_id [dict get [lindex [dict get $bt body stackFrames] 1] id]
  57
  58 set scopes [dap_check_request_and_response "get scopes" scopes \
  59                 [format {o frameId [i %d]} $frame_id]]
  60 set scopes [dict get [lindex $scopes 0] body scopes]
  61
  62 gdb_assert {[llength $scopes] == 2} "two scopes"
  63
  64 lassign $scopes scope ignore
  65 gdb_assert {[dict get $scope name] == "Arguments"} "scope is arguments"
  66 gdb_assert {[dict get $scope presentationHint] == "arguments"} \
  67     "arguments presentation hint"
  68 gdb_assert {[dict get $scope namedVariables] == 3} "three vars in scope"
  69
  70 set num [dict get $scope variablesReference]
  71 set refs [lindex [dap_check_request_and_response "fetch arguments" \
  72                       "variables" \
  73                       [format {o variablesReference [i %d]} $num]] \
  74               0]
  75
  76 # Helper to check the contents of a single array-like object.  VAR is
  77 # the variable entry.  NAME is the name of the variable, pulled out
  78 # for convenience.# ARGS are the expected child values.
  79 proc check_array_contents {var name args} {
  80     set len [llength $args]
  81     gdb_assert {[dict get $var indexedVariables] == $len} \
  82         "check length of $name variable"
  83
  84     set num [dict get $var variablesReference]
  85     set refs [lindex [dap_check_request_and_response \
  86                           "fetch contents of $name" \
  87                           "variables" \
  88                           [format {o variablesReference [i %d]} $num]] \
  89                   0]
  90
  91     foreach subvar [dict get $refs body variables] subvalue $args {
  92         set subname [dict get $subvar name]
  93         gdb_assert {[dict get $subvar value] == $subvalue} \
  94             "check value of $name entry $subname"
  95     }
  96 }
  97
  98 foreach var [dict get $refs body variables] {
  99     set name [dict get $var name]
 100     switch $name {
 101         "the_buffer" {
 102             check_array_contents $var $name 1 2 3 4
 103         }
 104
 105         "the_ar" {
 106             check_array_contents $var $name 5 6 7 8 9
 107         }
 108
 109         "hello" {
 110             # Note that the expected value looks strange here -- there
 111             # are too many backslashes.  This is a TON issue, as the
 112             # JSON looks ok: "value": "\"hello\"".
 113             gdb_assert {[dict get $var value] == "\\\"hello\\\""} \
 114                 "value of hello variable"
 115         }
 116
 117         default {
 118             fail "unknown variable $name"
 119         }
 120     }
 121 }
 122
 123 dap_shutdown