1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
|
# Copyright 2017-2019 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 <http://www.gnu.org/licenses/>.
# Test nested class definitions with the type printer.
#
# This test works by constructing a tree to represent "struct S10" in
# the corresponding source file. It then walks the nodes of this tree
# to construct input suitable for passing to cp_test_ptype_class.
if {[skip_cplus_tests]} { continue }
load_lib "cp-support.exp"
standard_testfile .cc
if {[prepare_for_testing "failed to prepare" $testfile $srcfile \
{debug c++}]} {
return -1
}
# Build the node given by ID (a number representing the struct S[ID] in
# the source file).
#
# For each node, stored as ::nodes(ID,ARG), where ARG is
#
# fields - list of fields [no children]
# children - list of types [children]
proc build_node {id} {
global nodes
# For any node, FIELDS is always the types i(N), e(N), u(N)
# CHILDREN is a list of nodes called [E(N), U(N)] S(N+1)
#
# The root (10) also has S(N+11), S(N+21), S(N+31), S(N+41)
set nodes($id,fields) [list "int i$id" "E$id e$id" "U$id u$id"]
set nodes($id,children) {}
if {$id == 10} {
set limit 5
} else {
set limit 1
}
for {set i 0} {$i < $limit} {incr i} {
set n [expr {1 + $id + $i * 10}]
# We don't build nodes which are multiples of 10
# (the source only uses that at the root struct).
# We also don't create nodes not in the source file
# (id >= 60).
if {[expr {$n % 10}] != 0 && $n < 60} {
lappend nodes($id,children) $n
}
}
}
# A helper procedure to indent the log output by LVL. This is used for
# debugging the tree, if ever necessary.
proc indent {lvl} {
for {set i 0} {$i < $lvl} {incr i} {
send_log " "
}
}
# For the given CHILD name and PARENT_LIST, return the fully qualified
# name of the child type.
proc qual_name {child parent_list} {
if {[string range $child 0 2] != "int" && [llength $parent_list]} {
return "[join $parent_list ::]::$child"
} else {
return "$child"
}
}
# Output the test source to the log.
proc make_source {} {
# Output the structure.
test_nested_limit 10 true
# Output main().
send_log "int\nmain \(\)\n\{\n"
set plist {}
for {set i 10} {$i < 60} {incr i} {
if {$i > 10 && [expr {$i % 10}] == 0} {
incr i
set plist {"S10"}
send_log "\n"
}
send_log " [qual_name S$i $plist] s$i;\n"
lappend plist "S$i"
}
send_log " return 0;\n"
send_log "\}\n"
}
# Output to the log and/or create the result list for the fields of node ID.
proc make_fields {result_var id parent_list indent_lvl log} {
upvar $result_var result
global nodes
foreach type $nodes($id,fields) {
set s "[qual_name $type $parent_list];"
if {$log} {
indent $indent_lvl
send_log "$s\n"
}
lappend result [list "field" "public" "$s"]
}
}
# Output to the log and/or create the result list for the union type in
# node ID.
proc make_union {result_var id parent_list indent_lvl log} {
upvar $result_var result
set s "[qual_name U$id $parent_list]"
set a "int a;"
set c "char c;"
lappend result [list "type" "public" "union" $s [list $a $c]]
if {$log} {
indent $indent_lvl
send_log "union $s \{\n"
indent [expr {$indent_lvl + 1}]
send_log "$a\n"
indent [expr {$indent_lvl + 1}]
send_log "$c\n"
indent $indent_lvl
send_log "\};\n"
}
}
# Output to the log and/or create the result list for the enum type in
# node ID.
proc make_enum {result_var id parent_list indent_lvl log} {
upvar $result_var result
set s "[qual_name E$id $parent_list]"
set a "[qual_name A$id $parent_list]"
set b "[qual_name B$id $parent_list]"
set c "[qual_name C$id $parent_list]"
lappend result [list "type" "public" "enum" $s [list $a $b $c]]
if {$log} {
indent $indent_lvl
send_log "enum $s \{$a, $b, $c\};\n"
}
}
# Output to the log and/or create the result list for the node given by ID.
#
# LIMIT describes the number of nested types to output (corresponding to
# the "set print type nested-type-limit" command).
# PARENT_LIST is the list of parent nodes already seen.
# INDENT_LVL is the indentation level (used when LOG is true).
proc node_result {result_var id limit parent_list indent_lvl log} {
upvar $result_var result
# Start a new type list.
set my_name "S$id"
set s "[qual_name $my_name $parent_list]"
set my_result [list "type" "public" "struct" $s]
if {$log} {
indent $indent_lvl
send_log "struct $my_name \{\n"
} else {
# Add this node to the parent list so that its name appears in
# qualified names, but only if we are not logging. [See immediately
# below.]
lappend parent_list "$my_name"
}
# `ptype' outputs fields before type definitions, but in order to
# output compile-ready code, these must be output in reverse.
if {!$log} {
# Output field list to a local children list.
set children_list {}
make_fields children_list $id $parent_list \
[expr {$indent_lvl + 1}] $log
# Output type definitions to the local children list.
# The first number of ID gives us the depth of the node.
if {[string index $id 1] < $limit || $limit < 0} {
make_enum children_list $id $parent_list \
[expr {$indent_lvl + 1}] $log
make_union children_list $id $parent_list \
[expr {$indent_lvl + 1}] $log
}
} else {
# Output type definitions to the local children list.
# The first number of ID gives us the depth of the node.
if {[string index $id 1] < $limit || $limit < 0} {
make_enum children_list $id $parent_list \
[expr {$indent_lvl + 1}] $log
make_union children_list $id $parent_list \
[expr {$indent_lvl + 1}] $log
send_log "\n"
}
# Output field list to a local children list.
set children_list {}
make_fields children_list $id $parent_list \
[expr {$indent_lvl + 1}] $log
send_log "\n"
}
# Output the children to the local children list.
global nodes
if {[info exists nodes($id,children)]} {
foreach c $nodes($id,children) {
if {[string index $c 1] <= $limit || $limit < 0} {
node_result children_list $c $limit $parent_list \
[expr {$indent_lvl + 1}] $log
}
}
}
# Add this node's children to its result and add its result to
# its parent's results.
lappend my_result $children_list
lappend result $my_result
if {$log} {
indent $indent_lvl
send_log "\};\n"
}
}
# Test nested type definitions. LIMIT specifies how many nested levels
# of definitions to test. If LOG is true, output the tree to the log in
# a human-readable format mimicing the source code.
#
# Only test when not logging. Generating source code usable by the
# test is not quite the same as how GDB outputs it.
proc test_nested_limit {limit log} {
set result {}
if {!$log} {
# Set the number of nested definitions to print.
gdb_test_no_output "set print type nested-type-limit $limit"
# Check the output of "show type print nested-type-limit"
if {$limit < 0} {
set lstr "unlimited"
} else {
set lstr $limit
}
gdb_test "show print type nested-type-limit" \
"Will print $lstr nested types defined in a class" \
"show print type nested-type-limit ($limit)"
} else {
send_log "Tree to $limit levels:\n"
}
# Generate the result list.
node_result result 10 $limit {} 0 $log
if {!$log} {
if {$limit < 0 || $limit >= 8 } {
set read1_timeout_factor 10
} else {
set read1_timeout_factor 1
}
# The only output we check for is the contents of the struct,
# ignoring the leading "type = struct S10 {" and trailing "}" of
# the outermost node.
set result [lindex $result 0]
lassign $result type access key name children
with_read1_timeout_factor $read1_timeout_factor {
cp_test_ptype_class $name "ptype $name (limit = $limit)" $key \
$name $children
}
}
}
# Build a tree of nodes describing the structures in the source file.
# An array holding all the nodes
array set nodes {}
build_node 10
for {set i 1} {$i < 6} {incr i} {
for {set j 1} {$j < 10} {incr j} {
build_node $i$j
}
}
# Check relevant commands.
# By default, we do not print nested type definitions.
gdb_test "show print type nested-type-limit" \
"Will not print nested types defined in a class" \
"show default print type nested-type-limit"
# -1 means we print all nested types
test_nested_limit -1 false
# Test the output of "show print type nested-type-limit" and
# ptype on the test source.
for {set i 1} {$i < 9} {incr i} {
test_nested_limit $i false
}
# To output the test code to the log, uncomment the following line:
#make_source
unset -nocomplain nodes result
|