gdb/testsuite/gdb.cp/nested-types.exp - binutils-gdb - Git at Google

 # 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
	# 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