]> git.ipfire.org Git - thirdparty/binutils-gdb.git/blame - gdb/testsuite/gdb.ada/mi_var_access.exp
Update copyright year range in header of all files managed by GDB
[thirdparty/binutils-gdb.git] / gdb / testsuite / gdb.ada / mi_var_access.exp
CommitLineData
1d506c26 1# Copyright 2020-2024 Free Software Foundation, Inc.
3ae7ab99
TT
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
16load_lib "ada.exp"
17
74dcf082 18require allow_ada_tests
3ae7ab99
TT
19
20standard_ada_testfile mi_access
21
22load_lib mi-support.exp
23set MIFLAGS "-i=mi"
24
25if {[gdb_compile_ada "${srcfile}" "${binfile}" executable debug] != "" } {
26 return -1
27}
28
b75d55d4 29mi_clean_restart $binfile
3ae7ab99 30
b75d55d4 31if {[mi_runto_main] < 0} {
3ae7ab99
TT
32 return 0
33}
34
35set bp_location [gdb_get_line_number "STOP" ${testdir}/mi_access.adb]
36mi_continue_to_line \
37 "mi_access.adb:$bp_location" \
38 "stop at start of mi_access"
39
40# The bug was that creating a varobj for A_String_Access would crash.
a2d9ce47
CL
41# The value of NUMCHILD may vary on different systems. Use generic $decimal
42# to match possible values.
43set re_ok "\\^done,name=\"A_String_Access\",numchild=\"$decimal\",.*"
c5a72a8d 44set re_error "\\^error,msg=\"Value out of range\.\".*"
3ae7ab99 45mi_gdb_test "-var-create A_String_Access * A_String_Access" \
c5a72a8d 46 "($re_ok|$re_error)" \
3ae7ab99 47 "Create varobj"
02c6f3f1
TT
48
49set bp_location [gdb_get_line_number "STOP2" ${testdir}/mi_access.adb]
50mi_continue_to_line \
51 "mi_access.adb:$bp_location" \
52 "stop at stop 2"
53
a2d9ce47
CL
54# If the VAROBJ_UPDATE_RESULT.TYPE is true, the new_type and new_num_children
55# strings and values will be printed. This currently happens on PowerPC but
56# not X86-64.
57set re_default [string_to_regexp {^done,changelist=[{name="A_String_Access",in_scope="true",type_changed="false",has_more="0"}]}]
58set re_varobj_update_result_type [string_to_regexp {^done,changelist=[{name="A_String_Access",in_scope="true",type_changed="true",new_type="pck.string_access",new_num_children="1",has_more="0"}]}]
02c6f3f1 59mi_gdb_test "-var-update A_String_Access" \
a2d9ce47 60 "($re_default|$re_varobj_update_result_type)" \
02c6f3f1
TT
61 "update at stop 2"
62
63mi_gdb_test "-var-list-children A_String_Access" \
64 [string_to_regexp {^done,numchild="1",children=[child={name="A_String_Access.A_String_Access.all",exp="A_String_Access.all",numchild="3",type="array (3 .. 5) of character",thread-id="1"}],has_more="0"}] \
65 "list children at stop 2"
66
67set bp_location [gdb_get_line_number "STOP3" ${testdir}/mi_access.adb]
68mi_continue_to_line \
69 "mi_access.adb:$bp_location" \
70 "stop at stop 3"
71
72mi_gdb_test "-var-update A_String_Access" \
73 [string_to_regexp {^done,changelist=[{name="A_String_Access",in_scope="true",type_changed="true",new_type="pck.string_access",new_num_children="0",has_more="0"}]}] \
74 "update at stop 3"