323 lines
8.9 KiB
Plaintext
323 lines
8.9 KiB
Plaintext
# Copyright 2017-2018 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
|