Re: [PATCH] Record nested types

[Keith Seitz <keiths at redhat dot com>]

On 11/28/2017 06:39 AM, Pedro Alves wrote:
>>> W00t, lots of repetition.  OOC, did you consider using the preprocessor
>>> to build the types?
>>
>> Preprocessor? I used the logging feature of the test script to generate the struct. [When the log is enabled, it sends the entire struct (up to the nested type limit) to gdb.log.]
> 
> Ah, that's even better.  Could you add a comment at the top of
> the .cc file, so that the next person that needs to change/extend
> the file doesn't try to do it manually?

In fact, I've added a proc in the .exp file to generate the source code (sans GPL), but as I usually prefer, this only runs manually to generate the (entire) source file now. I've updated the .cc with the output of this new "make_source" procedure. [I've appended the diff between previous version of .exp below.]

> Nope, that's fine; I had assumed you had typed the whole thing!  :-P

:-)

>> I've rewritten this whole thing a little more clearly based on your suggestions.
>>
>>>
>>>   # stack pop $sid1;    # returns "b"
>>>   # stack pop $sid1;    # returns "a"
>>>   # stack pop $sid1;    # returns ""
>>>
>>> Though off hand I'd assume that poping from an empty
>>> stack would be an error instead.  But perhaps that's more
>>> common in TCL?  Or does it not work to push an empty
>>> element, like:
>>>
>>>   # stack push $sid1 ""
>>>
>>> ?
>>
>> Yeah, with the submitted patch as-is, empty string elements cannot be pushed onto stacks/queues. [Well, they can, but without using the empty proc, one cannot tell the difference. I've therefore changed both stack and queue to error when an empty stack/queue is popped.
> 
> Thanks.
> 
> One thing that crossed my mind is that it would be really nice
> to have unit tests for these tcl data structures we come up with.
> E.g., add a new gdb.whatever/testsuite-selftests.exp or something
> like that, that runs just as any other GDB testcase, but that instead
> of spawning GDB, it exercises the new APIs, and calls pass/fail
> accordingly.  That'd serve both to unsure test coverage of the whole API,
> and also as kind of API documentation, as folks that want to know how
> to use the API would find easy/isolated examples there.
> 
> Anyway, that's a IWBN; it can be done separately and I don't want
> to delay this patch further.

I'll add a TODO for that. This certainly can't hurt. [The good news is, data-structures.exp is completely independent of our testsuite. To double-check everything, I just loaded it into a vanilla tclsh.]


>> -/* Add a typedef defined in the scope of the FIP's class.  */
>> +/* Can the type given by DIE define another type?  */
>> +
>> +static bool
>> +type_can_define_types (const struct die_info *die)
>> +{
>> +  switch (die->tag)
>> +    {
>> +    case DW_TAG_typedef:
>> +    case DW_TAG_class_type:
>> +    case  DW_TAG_structure_type:
> 
> Spurious double space above.

Fixed.

>> +# A namespace/commands to support a queue.
>> +#
>> +# To create a queue, call ::Queue::new, recording the returned queue ID
>> +# for future calls to manipulate the queue object.
>> +#
>> +# Example:
>> +#
>> +# set qid [::Queue::new]
>> +# queue push $qid a
>> +# queue push $qid b
>> +# queue empty $qid;  # returns false
>> +# queue pop $qid;    # returns "b"
>> +# queue pop $qid;    # returns "a"
> 
> I assume the first pop returns "a" instead.  :-P
> 

Oh boy. Cut-n-paste strikes again!

If you'd like me to submit in full again, please let me know. Otherwise, I've appended the diff for nested-types.exp with changes necessary to get "output source file" working. I apparently broke it along the way.

Keith

diff --git a/gdb/testsuite/gdb.cp/nested-types.exp b/gdb/testsuite/gdb.cp/nested-types.exp
index 2b540e9907..6d387dd6be 100644
--- a/gdb/testsuite/gdb.cp/nested-types.exp
+++ b/gdb/testsuite/gdb.cp/nested-types.exp
@@ -86,6 +86,29 @@ proc qual_name {child parent_list} {
     }
 }
 
+# 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} {
@@ -159,25 +182,47 @@ proc node_result {result_var id limit parent_list indent_lvl log} {
 
     if {$log} {
 	indent $indent_lvl
-	send_log "struct $s \{\n"
+	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.  Again, ptype and
+	# actual source code are not exactly interchangeable.
+	lappend parent_list "$my_name"
     }
 
-    # Add this node to the parent list so that its name appears in
-    # qualified names.
-    lappend parent_list "$my_name"
-
-    # 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} {
-	if {$log} {
+    # ptype outputs fields before type definitions, but in order to
+    # properly log the struct, we must output these 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"
 	}
-	make_enum children_list $id $parent_list [expr {$indent_lvl + 1}] $log
-	make_union children_list $id $parent_list [expr {$indent_lvl + 1}] $log
+
+	# 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.
@@ -205,35 +250,42 @@ proc node_result {result_var id limit parent_list indent_lvl log} {
 # 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 {}
 
-    # Set the number of nested definitions to print.
-    gdb_test_no_output "set print type nested-type-limit $limit"
+    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"
+	# 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 {
-	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)"
-
-    # Generate the result list and test it.
-    if {$log} {
 	send_log "Tree to $limit levels:\n"
     }
+
+    # Generate the result list.
     node_result result 10 $limit {} 0 $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
+    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.
@@ -264,4 +316,7 @@ 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