| # Copyright 2017-2021 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} { |
| # 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 |
| 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 |