1 # Copyright 2017-2024 Free Software Foundation, Inc.
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.
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.
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/>.
16 # Test nested class definitions with the type printer.
18 # This test works by constructing a tree to represent "struct S10" in
19 # the corresponding source file. It then walks the nodes of this tree
20 # to construct input suitable for passing to cp_test_ptype_class.
22 require allow_cplus_tests
24 load_lib "cp-support.exp"
28 if {[prepare_for_testing "failed to prepare" $testfile $srcfile \
33 # Build the node given by ID (a number representing the struct S[ID] in
36 # For each node, stored as ::nodes(ID,ARG), where ARG is
38 # fields - list of fields [no children]
39 # children - list of types [children]
41 proc build_node {id} {
44 # For any node, FIELDS is always the types i(N), e(N), u(N)
45 # CHILDREN is a list of nodes called [E(N), U(N)] S(N+1)
47 # The root (10) also has S(N+11), S(N+21), S(N+31), S(N+41)
49 set nodes($id,fields) [list "int i$id" "E$id e$id" "U$id u$id"]
50 set nodes($id,children) {}
56 for {set i 0} {$i < $limit} {incr i} {
57 set n [expr {1 + $id + $i * 10}]
59 # We don't build nodes which are multiples of 10
60 # (the source only uses that at the root struct).
61 # We also don't create nodes not in the source file
63 if {[expr {$n % 10}] != 0 && $n < 60} {
64 lappend nodes($id,children) $n
69 # A helper procedure to indent the log output by LVL. This is used for
70 # debugging the tree, if ever necessary.
73 for {set i 0} {$i < $lvl} {incr i} {
78 # For the given CHILD name and PARENT_LIST, return the fully qualified
79 # name of the child type.
81 proc qual_name {child parent_list} {
82 if {[string range $child 0 2] != "int" && [llength $parent_list]} {
83 return "[join $parent_list ::]::$child"
89 # Output the test source to the log.
92 # Output the structure.
93 test_nested_limit 10 true
96 send_log "int\nmain \(\)\n\{\n"
98 for {set i 10} {$i < 60} {incr i} {
99 if {$i > 10 && [expr {$i % 10}] == 0} {
104 send_log " [qual_name S$i $plist] s$i;\n"
108 send_log " return 0;\n"
112 # Output to the log and/or create the result list for the fields of node ID.
114 proc make_fields {result_var id parent_list indent_lvl log} {
115 upvar $result_var result
118 foreach type $nodes($id,fields) {
119 set s "[qual_name $type $parent_list];"
124 lappend result [list "field" "public" "$s"]
128 # Output to the log and/or create the result list for the union type in
131 proc make_union {result_var id parent_list indent_lvl log} {
132 upvar $result_var result
134 set s "[qual_name U$id $parent_list]"
137 lappend result [list "type" "public" "union" $s [list $a $c]]
140 send_log "union $s \{\n"
141 indent [expr {$indent_lvl + 1}]
143 indent [expr {$indent_lvl + 1}]
150 # Output to the log and/or create the result list for the enum type in
153 proc make_enum {result_var id parent_list indent_lvl log} {
154 upvar $result_var result
156 set s "[qual_name E$id $parent_list]"
157 set a "[qual_name A$id $parent_list]"
158 set b "[qual_name B$id $parent_list]"
159 set c "[qual_name C$id $parent_list]"
160 lappend result [list "type" "public" "enum" $s [list $a $b $c]]
164 send_log "enum $s \{$a, $b, $c\};\n"
168 # Output to the log and/or create the result list for the node given by ID.
170 # LIMIT describes the number of nested types to output (corresponding to
171 # the "set print type nested-type-limit" command).
172 # PARENT_LIST is the list of parent nodes already seen.
173 # INDENT_LVL is the indentation level (used when LOG is true).
175 proc node_result {result_var id limit parent_list indent_lvl log} {
176 upvar $result_var result
178 # Start a new type list.
180 set s "[qual_name $my_name $parent_list]"
181 set my_result [list "type" "public" "struct" $s]
185 send_log "struct $my_name \{\n"
187 # Add this node to the parent list so that its name appears in
188 # qualified names, but only if we are not logging. [See immediately
190 lappend parent_list "$my_name"
193 # `ptype' outputs fields before type definitions, but in order to
194 # output compile-ready code, these must be output in reverse.
197 # Output field list to a local children list.
199 make_fields children_list $id $parent_list \
200 [expr {$indent_lvl + 1}] $log
202 # Output type definitions to the local children list.
203 # The first number of ID gives us the depth of the node.
204 if {[string index $id 1] < $limit || $limit < 0} {
205 make_enum children_list $id $parent_list \
206 [expr {$indent_lvl + 1}] $log
207 make_union children_list $id $parent_list \
208 [expr {$indent_lvl + 1}] $log
211 # Output type definitions to the local children list.
212 # The first number of ID gives us the depth of the node.
213 if {[string index $id 1] < $limit || $limit < 0} {
214 make_enum children_list $id $parent_list \
215 [expr {$indent_lvl + 1}] $log
216 make_union children_list $id $parent_list \
217 [expr {$indent_lvl + 1}] $log
221 # Output field list to a local children list.
223 make_fields children_list $id $parent_list \
224 [expr {$indent_lvl + 1}] $log
228 # Output the children to the local children list.
230 if {[info exists nodes($id,children)]} {
231 foreach c $nodes($id,children) {
232 if {[string index $c 1] <= $limit || $limit < 0} {
233 node_result children_list $c $limit $parent_list \
234 [expr {$indent_lvl + 1}] $log
239 # Add this node's children to its result and add its result to
240 # its parent's results.
241 lappend my_result $children_list
242 lappend result $my_result
250 # Test nested type definitions. LIMIT specifies how many nested levels
251 # of definitions to test. If LOG is true, output the tree to the log in
252 # a human-readable format mimicing the source code.
254 # Only test when not logging. Generating source code usable by the
255 # test is not quite the same as how GDB outputs it.
257 proc test_nested_limit {limit log} {
261 # Set the number of nested definitions to print.
262 gdb_test_no_output "set print type nested-type-limit $limit"
264 # Check the output of "show type print nested-type-limit"
270 gdb_test "show print type nested-type-limit" \
271 "Will print $lstr nested types defined in a class" \
272 "show print type nested-type-limit ($limit)"
274 send_log "Tree to $limit levels:\n"
277 # Generate the result list.
278 node_result result 10 $limit {} 0 $log
281 # The only output we check for is the contents of the struct,
282 # ignoring the leading "type = struct S10 {" and trailing "}" of
283 # the outermost node.
284 set result [lindex $result 0]
285 lassign $result type access key name children
286 cp_test_ptype_class $name "ptype $name (limit = $limit)" $key \
291 # Build a tree of nodes describing the structures in the source file.
293 # An array holding all the nodes
296 for {set i 1} {$i < 6} {incr i} {
297 for {set j 1} {$j < 10} {incr j} {
302 # Check relevant commands.
304 # By default, we do not print nested type definitions.
305 gdb_test "show print type nested-type-limit" \
306 "Will not print nested types defined in a class" \
307 "show default print type nested-type-limit"
309 # -1 means we print all nested types
310 test_nested_limit -1 false
312 # Test the output of "show print type nested-type-limit" and
313 # ptype on the test source.
315 for {set i 1} {$i < 9} {incr i} {
316 test_nested_limit $i false
319 # To output the test code to the log, uncomment the following line:
322 unset -nocomplain nodes result