gdb/testsuite/gdb.cp/nested-types.exp

   1 # Copyright 2017-2022 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 # Test nested class definitions with the type printer.
  17 #
  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.
  21
  22 if {[skip_cplus_tests]} { continue }
  23
  24 load_lib "cp-support.exp"
  25
  26 standard_testfile .cc
  27
  28 if {[prepare_for_testing "failed to prepare" $testfile $srcfile \
  29          {debug c++}]} {
  30     return -1
  31 }
  32
  33 # Build the node given by ID (a number representing the struct S[ID] in
  34 # the source file).
  35 #
  36 # For each node, stored as ::nodes(ID,ARG), where ARG is
  37 #
  38 # fields   - list of fields [no children]
  39 # children - list of types [children]
  40
  41 proc build_node {id} {
  42     global nodes
  43
  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)
  46     #
  47     # The root (10) also has S(N+11), S(N+21), S(N+31), S(N+41)
  48
  49     set nodes($id,fields) [list "int i$id" "E$id e$id" "U$id u$id"]
  50     set nodes($id,children) {}
  51     if {$id == 10} {
  52         set limit 5
  53     } else {
  54         set limit 1
  55     }
  56     for {set i 0} {$i < $limit} {incr i} {
  57         set n [expr {1 + $id + $i * 10}]
  58
  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
  62         # (id >= 60).
  63         if {[expr {$n % 10}] != 0 && $n < 60} {
  64             lappend nodes($id,children) $n
  65         }
  66     }
  67 }
  68
  69 # A helper procedure to indent the log output by LVL.  This is used for
  70 # debugging the tree, if ever necessary.
  71
  72 proc indent {lvl} {
  73     for {set i 0} {$i < $lvl} {incr i} {
  74         send_log "  "
  75     }
  76 }
  77
  78 # For the given CHILD name and PARENT_LIST, return the fully qualified
  79 # name of the child type.
  80
  81 proc qual_name {child parent_list} {
  82     if {[string range $child 0 2] != "int" && [llength $parent_list]} {
  83         return "[join $parent_list ::]::$child"
  84     } else {
  85         return "$child"
  86     }
  87 }
  88
  89 # Output the test source to the log.
  90
  91 proc make_source {} {
  92     # Output the structure.
  93     test_nested_limit 10 true
  94
  95     # Output main().
  96     send_log "int\nmain \(\)\n\{\n"
  97     set plist {}
  98     for {set i 10} {$i < 60} {incr i} {
  99         if {$i > 10 && [expr {$i % 10}] == 0} {
 100             incr i
 101             set plist {"S10"}
 102             send_log "\n"
 103         }
 104         send_log "  [qual_name S$i $plist] s$i;\n"
 105         lappend plist "S$i"
 106     }
 107
 108     send_log "  return 0;\n"
 109     send_log "\}\n"
 110 }
 111
 112 # Output to the log and/or create the result list for the fields of node ID.
 113
 114 proc make_fields {result_var id parent_list indent_lvl log} {
 115     upvar $result_var result
 116     global nodes
 117
 118     foreach type $nodes($id,fields) {
 119         set s "[qual_name $type $parent_list];"
 120         if {$log} {
 121             indent $indent_lvl
 122             send_log "$s\n"
 123         }
 124         lappend result [list "field" "public" "$s"]
 125     }
 126 }
 127
 128 # Output to the log and/or create the result list for the union type in
 129 # node ID.
 130
 131 proc make_union {result_var id parent_list indent_lvl log} {
 132     upvar $result_var result
 133
 134     set s "[qual_name U$id $parent_list]"
 135     set a "int a;"
 136     set c "char c;"
 137     lappend result [list "type" "public" "union" $s [list $a $c]]
 138     if {$log} {
 139         indent $indent_lvl
 140         send_log "union $s \{\n"
 141         indent [expr {$indent_lvl + 1}]
 142         send_log "$a\n"
 143         indent [expr {$indent_lvl + 1}]
 144         send_log "$c\n"
 145         indent $indent_lvl
 146         send_log "\};\n"
 147     }
 148 }
 149
 150 # Output to the log and/or create the result list for the enum type in
 151 # node ID.
 152
 153 proc make_enum {result_var id parent_list indent_lvl log} {
 154     upvar $result_var result
 155
 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]]
 161
 162     if {$log} {
 163         indent $indent_lvl
 164         send_log "enum $s \{$a, $b, $c\};\n"
 165     }
 166 }
 167
 168 # Output to the log and/or create the result list for the node given by ID.
 169 #
 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).
 174
 175 proc node_result {result_var id limit parent_list indent_lvl log} {
 176     upvar $result_var result
 177
 178     # Start a new type list.
 179     set my_name "S$id"
 180     set s "[qual_name $my_name $parent_list]"
 181     set my_result [list "type" "public" "struct" $s]
 182
 183     if {$log} {
 184         indent $indent_lvl
 185         send_log "struct $my_name \{\n"
 186     } else {
 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
 189         # below.]
 190         lappend parent_list "$my_name"
 191     }
 192
 193     # `ptype' outputs fields before type definitions, but in order to
 194     # output compile-ready code, these must be output in reverse.
 195
 196     if {!$log} {
 197         # Output field list to a local children list.
 198         set children_list {}
 199         make_fields children_list $id $parent_list \
 200             [expr {$indent_lvl + 1}] $log
 201
 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
 209         }
 210     } else {
 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
 218             send_log "\n"
 219         }
 220
 221         # Output field list to a local children list.
 222         set children_list {}
 223         make_fields children_list $id $parent_list \
 224             [expr {$indent_lvl + 1}] $log
 225         send_log "\n"
 226     }
 227
 228     # Output the children to the local children list.
 229     global nodes
 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
 235             }
 236         }
 237     }
 238
 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
 243
 244     if {$log} {
 245         indent $indent_lvl
 246         send_log "\};\n"
 247     }
 248 }
 249
 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.
 253 #
 254 # Only test when not logging.  Generating source code usable by the
 255 # test is not quite the same as how GDB outputs it.
 256
 257 proc test_nested_limit {limit log} {
 258     set result {}
 259
 260     if {!$log} {
 261         # Set the number of nested definitions to print.
 262         gdb_test_no_output "set print type nested-type-limit $limit"
 263
 264         # Check the output of "show type print nested-type-limit"
 265         if {$limit < 0} {
 266             set lstr "unlimited"
 267         } else {
 268             set lstr $limit
 269         }
 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)"
 273     } else {
 274         send_log "Tree to $limit levels:\n"
 275     }
 276
 277     # Generate the result list.
 278     node_result result 10 $limit {} 0 $log
 279
 280     if {!$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 \
 287             $name $children
 288     }
 289 }
 290
 291 # Build a tree of nodes describing the structures in the source file.
 292
 293 # An array holding all the nodes
 294 array set nodes {}
 295 build_node 10
 296 for {set i 1} {$i < 6} {incr i} {
 297     for {set j 1} {$j < 10} {incr j} {
 298         build_node $i$j
 299     }
 300 }
 301
 302 # Check relevant commands.
 303
 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"
 308
 309 # -1 means we print all nested types
 310 test_nested_limit -1 false
 311
 312 # Test the output of "show print type nested-type-limit" and
 313 # ptype on the test source.
 314
 315 for {set i 1} {$i < 9} {incr i} {
 316     test_nested_limit $i false
 317 }
 318
 319 # To output the test code to the log, uncomment the following line:
 320 #make_source
 321
 322 unset -nocomplain nodes result