mi-info-sources.exp revision 1.1.1.2 1 1.1.1.2 christos # Copyright 2021-2024 Free Software Foundation, Inc.
2 1.1 christos
3 1.1 christos # This program is free software; you can redistribute it and/or modify
4 1.1 christos # it under the terms of the GNU General Public License as published by
5 1.1 christos # the Free Software Foundation; either version 3 of the License, or
6 1.1 christos # (at your option) any later version.
7 1.1 christos #
8 1.1 christos # This program is distributed in the hope that it will be useful,
9 1.1 christos # but WITHOUT ANY WARRANTY; without even the implied warranty of
10 1.1 christos # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 1.1 christos # GNU General Public License for more details.
12 1.1 christos #
13 1.1 christos # You should have received a copy of the GNU General Public License
14 1.1 christos # along with this program. If not, see <http://www.gnu.org/licenses/>.
15 1.1 christos
16 1.1 christos # Test the -file-list-exec-source-files command.
17 1.1 christos
18 1.1 christos load_lib mi-support.exp
19 1.1 christos set MIFLAGS "-i=mi"
20 1.1 christos
21 1.1 christos standard_testfile .c -base.c
22 1.1 christos
23 1.1 christos if {[build_executable $testfile.exp $testfile \
24 1.1 christos [list $srcfile $srcfile2] debug]} {
25 1.1 christos untested $testfile.exp
26 1.1 christos return -1
27 1.1 christos }
28 1.1 christos
29 1.1 christos mi_clean_restart $binfile
30 1.1 christos
31 1.1 christos set readnow_p [mi_readnow]
32 1.1 christos
33 1.1 christos mi_runto_main
34 1.1 christos
35 1.1 christos # Unload symbols for shared libraries to prevent
36 1.1 christos # 'ERROR: internal buffer is full'.
37 1.1 christos mi_gdb_test "nosharedlibrary" ".*\\^done" "nosharedlibrary"
38 1.1 christos
39 1.1 christos # Helper to build expected MI output pattern for a list. NAME is the
40 1.1 christos # name of the list (which can be the empty string) and args is one
41 1.1 christos # or more strings representing the fields of the list, which will be
42 1.1 christos # joined with a comma.
43 1.1 christos #
44 1.1 christos # If any of the fields in args matches ".*" then the comma before and
45 1.1 christos # after are dropped from the final pattern.
46 1.1 christos proc mi_list { name args } {
47 1.1 christos set str ""
48 1.1 christos
49 1.1 christos if { $name != "" } {
50 1.1 christos set str "${name}="
51 1.1 christos }
52 1.1 christos
53 1.1 christos set pattern ""
54 1.1 christos foreach a $args {
55 1.1 christos if { [string length $pattern] > 0 } {
56 1.1 christos if { [string range $pattern end-1 end] != ".*" \
57 1.1 christos && [string range $a 0 1] != ".*" } {
58 1.1 christos set pattern "${pattern},"
59 1.1 christos }
60 1.1 christos }
61 1.1 christos set pattern "${pattern}${a}"
62 1.1 christos }
63 1.1 christos set str "$str\\\[${pattern}\\\]"
64 1.1 christos return ${str}
65 1.1 christos }
66 1.1 christos
67 1.1 christos # Helper to build expected MI output pattern for a tuple. NAME is the
68 1.1 christos # name of the tuple (which can be the empty string) and args is one
69 1.1 christos # or more strings representing the fields of the tuple, which will be
70 1.1 christos # joined with a comma.
71 1.1 christos #
72 1.1 christos # If any of the fields in args matches ".*" then the comma before and
73 1.1 christos # after are dropped from the final pattern.
74 1.1 christos proc mi_tuple { name args } {
75 1.1 christos set str ""
76 1.1 christos
77 1.1 christos if { $name != "" } {
78 1.1 christos set str "${name}="
79 1.1 christos }
80 1.1 christos
81 1.1 christos set pattern ""
82 1.1 christos foreach a $args {
83 1.1 christos if { [string length $pattern] > 0 } {
84 1.1 christos if { [string range $pattern end-1 end] != ".*" \
85 1.1 christos && [string range $a 0 1] != ".*" } {
86 1.1 christos set pattern "${pattern},"
87 1.1 christos }
88 1.1 christos }
89 1.1 christos set pattern "${pattern}${a}"
90 1.1 christos }
91 1.1 christos set str "$str\\{${pattern}\\}"
92 1.1 christos return ${str}
93 1.1 christos }
94 1.1 christos
95 1.1 christos # Helper to build expected MI output pattern for a single field. NAME
96 1.1 christos # is the name of the field, and PATTERN matches the fields contents.
97 1.1 christos # This proc will add quotes around PATTERN.
98 1.1 christos proc mi_field { name pattern } {
99 1.1 christos set str ""
100 1.1 christos
101 1.1 christos if { $name != "" } {
102 1.1 christos set str "${name}="
103 1.1 christos }
104 1.1 christos
105 1.1 christos set str "$str\"${pattern}\""
106 1.1 christos return ${str}
107 1.1 christos }
108 1.1 christos
109 1.1 christos # Run tests on '-file-list-exec-source-files'. DEBUG_FULLY_READ is either the string
110 1.1 christos # "true" or "false" and indicates if the GDB will have read all the
111 1.1 christos # debug for the test program or not yet.
112 1.1 christos proc check_info_sources { debug_fully_read } {
113 1.1 christos
114 1.1 christos with_test_prefix "debug_read=${debug_fully_read}" {
115 1.1 christos
116 1.1 christos if { $debug_fully_read } {
117 1.1 christos set p1 \
118 1.1 christos [mi_list "files" \
119 1.1 christos ".*" \
120 1.1 christos [mi_tuple "" \
121 1.1.1.2 christos [mi_field "file" "\[^\"\]*mi-info-sources-base\\.c"] \
122 1.1.1.2 christos [mi_field "fullname" "\[^\"\]+mi-info-sources-base\\.c"] \
123 1.1 christos [mi_field "debug-fully-read" "${debug_fully_read}"]] \
124 1.1 christos ".*"]
125 1.1 christos set p2 \
126 1.1 christos [mi_list "files" \
127 1.1 christos ".*" \
128 1.1 christos [mi_tuple "" \
129 1.1.1.2 christos [mi_field "file" "\[^\"\]*mi-info-sources\\.c"] \
130 1.1.1.2 christos [mi_field "fullname" "\[^\"\]+mi-info-sources\\.c"] \
131 1.1 christos [mi_field "debug-fully-read" "true"]] \
132 1.1 christos ".*"]
133 1.1 christos } else {
134 1.1 christos set p1 \
135 1.1 christos [mi_list "files" \
136 1.1 christos ".*" \
137 1.1 christos [mi_tuple "" \
138 1.1.1.2 christos [mi_field "file" "\[^\"\]*mi-info-sources\\.c"] \
139 1.1.1.2 christos [mi_field "fullname" "\[^\"\]+mi-info-sources\\.c"] \
140 1.1 christos [mi_field "debug-fully-read" "true"]] \
141 1.1 christos ".*"]
142 1.1 christos set p2 \
143 1.1 christos [mi_list "files" \
144 1.1 christos ".*" \
145 1.1 christos [mi_tuple "" \
146 1.1.1.2 christos [mi_field "file" "\[^\"\]*mi-info-sources-base\\.c"] \
147 1.1.1.2 christos [mi_field "fullname" "\[^\"\]+mi-info-sources-base\\.c"] \
148 1.1 christos [mi_field "debug-fully-read" "${debug_fully_read}"]] \
149 1.1 christos ".*"]
150 1.1 christos }
151 1.1 christos
152 1.1 christos mi_gdb_test "-file-list-exec-source-files" ".*\\^done,${p1}" \
153 1.1 christos "-file-list-exec-source-files, src1"
154 1.1 christos mi_gdb_test "-file-list-exec-source-files" ".*\\^done,${p2}" \
155 1.1 christos "-file-list-exec-source-files, src2"
156 1.1 christos
157 1.1 christos set p [mi_list "files" \
158 1.1 christos [mi_tuple "" \
159 1.1.1.2 christos [mi_field "file" "\[^\"\]*mi-info-sources-base\\.c"] \
160 1.1.1.2 christos [mi_field "fullname" "\[^\"\]+mi-info-sources-base\\.c"] \
161 1.1 christos [mi_field "debug-fully-read" "${debug_fully_read}"]]]
162 1.1 christos mi_gdb_test "-file-list-exec-source-files --basename -- base" ".*\\^done,${p}" \
163 1.1 christos "-file-list-exec-source-files --basename -- base"
164 1.1 christos
165 1.1 christos # Figure out the value for the 'debug-info' field.
166 1.1 christos if {${debug_fully_read} == "true"} {
167 1.1 christos set debug_info "fully-read"
168 1.1 christos } else {
169 1.1 christos set debug_info "partially-read"
170 1.1 christos }
171 1.1 christos
172 1.1 christos set p [mi_list "files" \
173 1.1 christos [mi_tuple "" \
174 1.1.1.2 christos [mi_field "filename" "\[^\"\]+mi-info-sources(\.debug)?"] \
175 1.1 christos [mi_field "debug-info" "${debug_info}"] \
176 1.1 christos [mi_list "sources" \
177 1.1 christos ".*" \
178 1.1 christos [mi_tuple "" \
179 1.1.1.2 christos [mi_field "file" "\[^\"\]*mi-info-sources\\.c"] \
180 1.1.1.2 christos [mi_field "fullname" "\[^\"\]+mi-info-sources\\.c"] \
181 1.1 christos [mi_field "debug-fully-read" "true"]] \
182 1.1 christos ".*"]]]
183 1.1 christos mi_gdb_test "-file-list-exec-source-files --group-by-objfile" \
184 1.1 christos ".*\\^done,${p}" \
185 1.1 christos "-file-list-exec-source-files --group-by-objfile, look for mi-info-sources.c"
186 1.1 christos
187 1.1 christos set p [mi_list "files" \
188 1.1 christos [mi_tuple "" \
189 1.1.1.2 christos [mi_field "filename" "\[^\"\]+mi-info-sources(\.debug)?"] \
190 1.1 christos [mi_field "debug-info" "${debug_info}"] \
191 1.1 christos [mi_list "sources" \
192 1.1 christos ".*" \
193 1.1 christos [mi_tuple "" \
194 1.1.1.2 christos [mi_field "file" "\[^\"\]*mi-info-sources-base\\.c"] \
195 1.1.1.2 christos [mi_field "fullname" "\[^\"\]+mi-info-sources-base\\.c"] \
196 1.1 christos [mi_field "debug-fully-read" "${debug_fully_read}"]] \
197 1.1 christos ".*"]]]
198 1.1 christos mi_gdb_test "-file-list-exec-source-files --group-by-objfile" \
199 1.1 christos ".*\\^done,${p}" \
200 1.1 christos "-file-list-exec-source-files --group-by-objfile, look for mi-info-sources-base.c"
201 1.1 christos }
202 1.1 christos }
203 1.1 christos
204 1.1 christos if { ! $readnow_p } {
205 1.1 christos check_info_sources "false"
206 1.1 christos }
207 1.1 christos
208 1.1 christos mi_continue_to "some_other_func"
209 1.1 christos
210 1.1 christos # Force "fully-read".
211 1.1 christos mi_gdb_test "maint expand-symtabs"
212 1.1 christos
213 1.1 christos check_info_sources "true"
214