gdb/testsuite/lib/cp-support.exp

   1 # This test code is part of GDB, the GNU debugger.
   2
   3 # Copyright 2003-2023 Free Software Foundation, Inc.
   4
   5 # This program is free software; you can redistribute it and/or modify
   6 # it under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation; either version 3 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # This program is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 # GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  17
  18 load_lib "data-structures.exp"
  19
  20 # Controls whether detailed logging for cp_test_ptype_class is enabled.
  21 # By default, it is not.  Enable it to assist with troubleshooting
  22 # failed cp_test_ptype_class tests.  [Users can simply add the statement
  23 # "set debug_cp_ptype_test_class true" after this file is loaded.]
  24
  25 set ::debug_cp_test_ptype_class false
  26
  27 # Auxiliary function to check for known problems.
  28 #
  29 # EXPECTED_STRING is the string expected by the test.
  30 #
  31 # ACTUAL_STRING is the actual string output by gdb.
  32 #
  33 # ERRATA_TABLE is a list of lines of the form:
  34 #
  35 #  { expected-string broken-string {eval-block} }
  36 #
  37 # If there is a line for the given EXPECTED_STRING, and if the
  38 # ACTUAL_STRING output by gdb is the same as the BROKEN_STRING in the
  39 # table, then I eval the eval-block.
  40
  41 proc cp_check_errata { expected_string actual_string errata_table } {
  42     foreach erratum $errata_table {
  43         if { "$expected_string" == [lindex $erratum 0]
  44         &&   "$actual_string"   == [lindex $erratum 1] } then {
  45             eval [lindex $erratum 2]
  46         }
  47     }
  48 }
  49
  50 # A convenience procedure for outputting debug info for cp_test_ptype_class
  51 # to the log.  Set the global variable "debug_cp_test_ptype_class"
  52 # to enable logging (to help with debugging failures).
  53
  54 proc cp_ptype_class_verbose {msg} {
  55     global debug_cp_test_ptype_class
  56
  57     if {$debug_cp_test_ptype_class} {
  58         verbose -log $msg
  59     }
  60 }
  61
  62 # A namespace to wrap internal procedures.
  63
  64 namespace eval ::cp_support_internal {
  65
  66     # A convenience procedure to return the next element of the queue.
  67     proc next_line {qid} {
  68         set elem {}
  69
  70         while {$elem == "" && ![queue empty $qid]} {
  71             # We make cp_test_ptype_class trim whitespace
  72             set elem [queue pop $qid]
  73         }
  74
  75         if {$elem == ""} {
  76             cp_ptype_class_verbose "next line element: no more lines"
  77         } else {
  78             cp_ptype_class_verbose "next line element: \"$elem\""
  79         }
  80         return $elem
  81     }
  82 }
  83
  84 # Test ptype of a class.  Return `true' if the test passes, false otherwise.
  85 #
  86 # Different C++ compilers produce different output.  To accommodate all
  87 # the variations listed below, I read the output of "ptype" and process
  88 # each line, matching it to the class description given in the
  89 # parameters.
  90 #
  91 # IN_EXP is the expression to use; the appropriate "ptype" invocation
  92 # is prepended to it.  IN_TESTNAME is the testname for
  93 # gdb_test_multiple.  If IN_TESTNAME is the empty string, then it
  94 # defaults to "ptype IN_EXP".
  95 #
  96 # IN_KEY is "class" or "struct".  For now, I ignore it, and allow either
  97 # "class" or "struct" in the output, as long as the access specifiers all
  98 # work out okay.
  99 #
 100 # IN_TAG is the class tag or structure tag.
 101 #
 102 # IN_CLASS_TABLE is a list of class information.  Each entry contains a
 103 # keyword and some values.  The keywords and their values are:
 104 #
 105 #   { base "base-declaration" }
 106 #
 107 #      the class has a base with the given declaration.
 108 #
 109 #   { vbase "name" }
 110 #
 111 #      the class has a virtual base pointer with the given name.  this
 112 #      is for gcc 2.95.3, which emits ptype entries for the virtual base
 113 #      pointers.  the vbase list includes both indirect and direct
 114 #      virtual base classes (indeed, a virtual base is usually
 115 #      indirect), so this information cannot be derived from the base
 116 #      declarations.
 117 #
 118 #   { field "access" "declaration" }
 119 #
 120 #      the class has a data field with the given access type and the
 121 #      given declaration.
 122 #
 123 #   { method "access" "declaration" }
 124 #
 125 #      the class has a member function with the given access type
 126 #      and the given declaration.
 127 #
 128 #   { typedef "access" "declaration" }
 129 #
 130 #      the class has a typedef with the given access type and the
 131 #      given declaration.
 132 #
 133 #   { type "access" "key" "name" children }
 134 #
 135 #      The class has a nested type definition with the given ACCESS.
 136 #      KEY is the keyword of the nested type ("enum", "union", "struct",
 137 #         "class").
 138 #      NAME is the (tag) name of the type.
 139 #      CHILDREN is a list of the type's children.  For struct and union keys,
 140 #        this is simply the same type of list that is normally passed to
 141 #        this procedure.  For enums the list of children should be the
 142 #        defined enumerators.  For unions it is a list of declarations.
 143 #        NOTE: The enum key will add a regexp to handle optional storage
 144 #        class specifiers (": unsigned int", e.g.).  The caller need not
 145 #        specify this.
 146 #
 147 # If you test the same class declaration more than once, you can specify
 148 # IN_CLASS_TABLE as "ibid".  "ibid" means: look for a previous class
 149 # table that had the same IN_KEY and IN_TAG, and re-use that table.
 150 #
 151 # IN_TAIL is the expected text after the close brace, specifically the "*"
 152 # in "struct { ... } *".  This is an optional parameter.  The default
 153 # value is "", for no tail.
 154 #
 155 # IN_ERRATA_TABLE is a list of errata entries.  See cp_check_errata for the
 156 # format of the errata table.  Note: the errata entries are not subject to
 157 # demangler syntax adjustment, so you have to make a bigger table
 158 # with lines for each output variation.
 159 #
 160 # IN_PTYPE_ARG are arguments to pass to ptype.  The default is "/r".
 161 #
 162 # RECURSIVE_QID is used internally to call this procedure recursively
 163 # when, e.g., testing nested type definitions.  The "ptype" command will
 164 # not be sent to GDB and the lines in the queue given by this argument will
 165 # be used instead.
 166 #
 167 # gdb can vary the output of ptype in several ways:
 168 #
 169 # . CLASS/STRUCT
 170 #
 171 #   The output can start with either "class" or "struct", depending on
 172 #   what the symbol table reader in gdb decides.  This is usually
 173 #   unrelated to the original source code.
 174 #
 175 #     dwarf-2  debug info distinguishes class/struct, but gdb ignores it
 176 #     stabs+   debug info does not distinguish class/struct
 177 #     hp       debug info distinguishes class/struct, and gdb honors it
 178 #
 179 #   I tried to accommodate this with regular expressions such as
 180 #   "((class|struct) A \{ public:|struct A \{)", but that turns into a
 181 #   hairy mess because of optional private virtual base pointers and
 182 #   optional public synthetic operators.  This is the big reason I gave
 183 #   up on regular expressions and started parsing the output.
 184 #
 185 # . REDUNDANT ACCESS SPECIFIER
 186 #
 187 #   In "class { private: ... }" or "struct { public: ... }", gdb might
 188 #   or might not emit a redundant initial access specifier, depending
 189 #   on the gcc version.
 190 #
 191 # . VIRTUAL BASE POINTERS
 192 #
 193 #   If a class has virtual bases, either direct or indirect, the class
 194 #   will have virtual base pointers.  With gcc 2.95.3, gdb prints lines
 195 #   for these virtual base pointers.  This does not happen with gcc
 196 #   3.3.4, gcc 3.4.1, or hp acc A.03.45.
 197 #
 198 #   I accept these lines.  These lines are optional; but if I see one of
 199 #   these lines, then I expect to see all of them.
 200 #
 201 #   Note: drow considers printing these lines to be a bug in gdb.
 202 #
 203 # . SYNTHETIC METHODS
 204 #
 205 #   A C++ compiler may synthesize some methods: an assignment
 206 #   operator, a copy constructor, a constructor, and a destructor.  The
 207 #   compiler might include debug information for these methods.
 208 #
 209 #     dwarf-2  gdb does not show these methods
 210 #     stabs+   gdb shows these methods
 211 #     hp       gdb does not show these methods
 212 #
 213 #   I accept these methods.  These lines are optional, and any or
 214 #   all of them might appear, mixed in anywhere in the regular methods.
 215 #
 216 #   With gcc v2, the synthetic copy-ctor and ctor have an additional
 217 #   "int" parameter at the beginning, the "in-charge" flag.
 218 #
 219 # . DEMANGLER SYNTAX VARIATIONS
 220 #
 221 #   Different demanglers produce "int foo(void)" versus "int foo()",
 222 #   "const A&" versus "const A &", and so on.
 223 #
 224 # TESTED WITH
 225 #
 226 #   gcc 2.95.3 -gdwarf-2
 227 #   gcc 2.95.3 -gstabs+
 228 #   gcc 3.3.4 -gdwarf-2
 229 #   gcc 3.3.4 -gstabs+
 230 #   gcc 3.4.1 -gdwarf-2
 231 #   gcc 3.4.1 -gstabs+
 232 #   gcc HEAD 20040731 -gdwarf-2
 233 #   gcc HEAD 20040731 -gstabs+
 234 #
 235 # TODO
 236 #
 237 # Tagless structs.
 238 #
 239 # "A*" versus "A *" and "A&" versus "A &" in user methods.
 240 #
 241 # -- chastain 2004-08-07
 242
 243 proc cp_test_ptype_class { in_exp in_testname in_key in_tag in_class_table
 244                            { in_tail "" } { in_errata_table { } }
 245                            { in_ptype_arg /r } { recursive_qid 0 } } {
 246     global gdb_prompt
 247     set wsopt "\[\r\n\t \]*"
 248     set hwsopt "\[\t \]*"
 249
 250     if {$recursive_qid == 0} {
 251         # The test name defaults to the command, but without the
 252         # arguments, for historical reasons.
 253
 254         if {"$in_testname" == ""} { set in_testname "ptype $in_exp" }
 255
 256         set in_command "ptype${in_ptype_arg} $in_exp"
 257     }
 258
 259     # Save class tables in a history array for reuse.
 260
 261     global cp_class_table_history
 262     if {$in_class_table == "ibid"} {
 263         if {![info exists cp_class_table_history("$in_key,$in_tag")]} {
 264             fail "$in_testname // bad ibid"
 265             return false
 266         }
 267         set in_class_table $cp_class_table_history("$in_key,$in_tag")
 268     } else {
 269         set cp_class_table_history("$in_key,$in_tag") $in_class_table
 270     }
 271
 272     # Split the class table into separate tables.
 273
 274     set list_bases   { }
 275     set list_vbases  { }
 276     set list_fields  { }
 277     set list_methods { }
 278     set list_typedefs { }
 279     set list_types    { }
 280     set list_enums    { }
 281     set list_unions   { }
 282
 283     foreach class_line $in_class_table {
 284         switch [lindex $class_line 0] {
 285             "base"   { lappend list_bases   [lindex $class_line 1] }
 286             "vbase"  { lappend list_vbases  [lindex $class_line 1] }
 287             "field"  { lappend list_fields  [lrange $class_line 1 2] }
 288             "method" { lappend list_methods [lrange $class_line 1 2] }
 289             "typedef" { lappend list_typedefs [lrange $class_line 1 2] }
 290             "type"    { lappend list_types [lrange $class_line 1 4] }
 291             default  {
 292                 fail "$in_testname // bad line in class table: $class_line"
 293                 return false
 294             }
 295         }
 296     }
 297
 298     # Construct a list of synthetic operators.
 299     # These are: { count ccess-type regular-expression }.
 300
 301     set list_synth { }
 302     lappend list_synth [list 0 "public" \
 303                             "$in_tag & operator=\\($in_tag const ?&\\);"]
 304     lappend list_synth [list 0 "public" \
 305                             "$in_tag\\((int,|) ?$in_tag const ?&\\);"]
 306     lappend list_synth [list 0 "public" \
 307                             "$in_tag\\((int|void|)\\);"]
 308
 309     # Partial regexp for parsing the struct/class header.
 310     set regexp_header "(struct|class)${hwsopt}(\[^ \t\]*)${hwsopt}"
 311     append regexp_header "(\\\[with .*\\\]${hwsopt})?((:\[^\{\]*)?)${hwsopt}\{"
 312     if {$recursive_qid == 0} {
 313         # Actually do the ptype.
 314         # For processing the output of ptype, we must get to the prompt.
 315         set parse_okay 0
 316         set state 0
 317         set actual_body ""
 318         gdb_test_multiple "$in_command" "$in_testname // parse failed" {
 319             -re "type = ${regexp_header}" {
 320                 if { $state == 0 } { set state 1 } else { set state -1 }
 321                 set actual_key          $expect_out(1,string)
 322                 set actual_tag          $expect_out(2,string)
 323                 set actual_base_string  $expect_out(4,string)
 324                 exp_continue
 325             }
 326             -re "^\r\n\}${hwsopt}(\[^\r\n\]*)(?=\r\n)" {
 327                 if { $state == 1 } { set state 2 } else { set state -2 }
 328                 set actual_tail $expect_out(1,string)
 329                 exp_continue
 330             }
 331             -re "^\r\n(\[^\r\n\]*)(?=\r\n)" {
 332                 if { $state != 1 } { set $state -3 }
 333                 if { $actual_body == "" } {
 334                     set actual_body $expect_out(1,string)
 335                 } else {
 336                     append actual_body "\n$expect_out(1,string)"
 337                 }
 338                 exp_continue
 339             }
 340             -re -wrap "" {
 341                 if { $state == 2 } {
 342                     set parse_okay 1
 343                 }
 344             }
 345         }
 346     } else {
 347         # The struct/class header by the first element in the line queue.
 348         # "Parse" that instead of the output of ptype.
 349         set header [cp_support_internal::next_line $recursive_qid]
 350         set parse_okay [regexp $regexp_header $header dummy actual_key \
 351                             actual_tag dummy actual_base_string]
 352
 353         if {$parse_okay} {
 354             cp_ptype_class_verbose \
 355                 "Parsing nested type definition (parse_okay=$parse_okay):"
 356             cp_ptype_class_verbose \
 357                 "\tactual_key=$actual_key, actual_tag=$actual_tag"
 358             cp_ptype_class_verbose "\tactual_base_string=$actual_base_string"
 359         }
 360
 361         # Cannot have a tail with a nested type definition.
 362         set actual_tail ""
 363     }
 364
 365     if { ! $parse_okay } {
 366         cp_ptype_class_verbose "*** parse failed ***"
 367         return false
 368     }
 369
 370     # Check the actual key.  It would be nice to require that it match
 371     # the input key, but gdb does not support that.  For now, accept any
 372     # $actual_key as long as the access property of each field/method
 373     # matches.
 374
 375     switch "$actual_key" {
 376         "class"  { set access "private" }
 377         "struct" { set access "public"  }
 378         default  {
 379             cp_check_errata "class"  "$actual_key" $in_errata_table
 380             cp_check_errata "struct" "$actual_key" $in_errata_table
 381             fail "$in_testname // wrong key: $actual_key"
 382             return false
 383         }
 384     }
 385
 386     # Check the actual tag.
 387
 388     if {"$actual_tag" != "$in_tag"} {
 389         cp_check_errata "$in_tag" "$actual_tag" $in_errata_table
 390         fail "$in_testname // wrong tag: $actual_tag"
 391         return false
 392     }
 393
 394     # Check the actual bases.
 395     # First parse them into a list.
 396
 397     set list_actual_bases { }
 398     if {"$actual_base_string" != ""} {
 399         regsub "^:${wsopt}" $actual_base_string "" actual_base_string
 400         set list_actual_bases [split $actual_base_string ","]
 401     }
 402
 403     # Check the base count.
 404
 405     if {[llength $list_actual_bases] < [llength $list_bases]} {
 406         fail "$in_testname // too few bases"
 407         return false
 408     }
 409     if {[llength $list_actual_bases] > [llength $list_bases]} {
 410         fail "$in_testname // too many bases"
 411         return false
 412     }
 413
 414     # Check each base.
 415
 416     foreach actual_base $list_actual_bases {
 417         set actual_base [string trim $actual_base]
 418         set base [lindex $list_bases 0]
 419         if {"$actual_base" != "$base"} {
 420             cp_check_errata "$base" "$actual_base" $in_errata_table
 421             fail "$in_testname // wrong base: $actual_base"
 422             return false
 423         }
 424         set list_bases [lreplace $list_bases 0 0]
 425     }
 426
 427     # Parse each line in the body.
 428
 429     set last_was_access 0
 430     set vbase_match 0
 431
 432     if {$recursive_qid == 0} {
 433         # Use a queue to hold the lines that will be checked.
 434         # This will allow processing below to remove lines from the input
 435         # more easily.
 436         set line_queue [::Queue::new]
 437         foreach l [split $actual_body "\r\n"] {
 438             set l [string trim $l]
 439             if {$l != ""} {
 440                 queue push $line_queue $l
 441             }
 442         }
 443     } else {
 444         set line_queue $recursive_qid
 445     }
 446
 447     while {![queue empty $line_queue]} {
 448
 449         # Get the next line.
 450
 451         set actual_line [cp_support_internal::next_line $line_queue]
 452         if {"$actual_line" == ""} { continue }
 453
 454         # Access specifiers.
 455
 456         if {[regexp "^(public|protected|private)${wsopt}:\$" "$actual_line" s0 s1]} {
 457             set access "$s1"
 458             if {$last_was_access} {
 459                 fail "$in_testname // redundant access specifier"
 460                 queue delete $line_queue
 461                 return false
 462             }
 463             set last_was_access 1
 464             continue
 465         } else {
 466             set last_was_access 0
 467         }
 468
 469         # Optional virtual base pointer.
 470
 471         if {[llength $list_vbases] > 0} {
 472             set vbase [lindex $list_vbases 0]
 473             if {[regexp "$vbase \\*(_vb.|_vb\\\$|__vb_)\[0-9\]*$vbase;" $actual_line]} {
 474                 if {"$access" != "private"} {
 475                     cp_check_errata "private" "$access" $in_errata_table
 476                     fail "$in_testname // wrong access specifier for virtual base: $access"
 477                     queue delete $line_queue
 478                     return false
 479                 }
 480                 set list_vbases [lreplace $list_vbases 0 0]
 481                 set vbase_match 1
 482                 continue
 483             }
 484         }
 485
 486         # Data field.
 487
 488         if {[llength $list_fields] > 0} {
 489             set field_access [lindex [lindex $list_fields 0] 0]
 490             set field_decl   [lindex [lindex $list_fields 0] 1]
 491             if {$recursive_qid > 0} {
 492                 cp_ptype_class_verbose "\tactual_line=$actual_line"
 493                 cp_ptype_class_verbose "\tfield_access=$field_access"
 494                 cp_ptype_class_verbose "\tfield_decl=$field_decl"
 495                 cp_ptype_class_verbose "\taccess=$access"
 496             }
 497             if {"$actual_line" == "$field_decl"} {
 498                 if {"$access" != "$field_access"} {
 499                     cp_check_errata "$field_access" "$access" $in_errata_table
 500                     fail "$in_testname // wrong access specifier for field: $access"
 501                     queue delete $line_queue
 502                     return false
 503                 }
 504                 set list_fields [lreplace $list_fields 0 0]
 505                 continue
 506             }
 507
 508             # Data fields must appear before synths and methods.
 509             cp_check_errata "$field_decl" "$actual_line" $in_errata_table
 510             fail "$in_testname // unrecognized line type 1: $actual_line"
 511             queue delete $line_queue
 512             return false
 513         }
 514
 515         # Method function.
 516
 517         if {[llength $list_methods] > 0} {
 518             set method_access [lindex [lindex $list_methods 0] 0]
 519             set method_decl   [lindex [lindex $list_methods 0] 1]
 520             if {"$actual_line" == "$method_decl"} {
 521                 if {"$access" != "$method_access"} {
 522                     cp_check_errata "$method_access" "$access" $in_errata_table
 523                     fail "$in_testname // wrong access specifier for method: $access"
 524                     queue delete $line_queue
 525                     return false
 526                 }
 527                 set list_methods [lreplace $list_methods 0 0]
 528                 continue
 529             }
 530
 531             # gcc 2.95.3 shows "foo()" as "foo(void)".
 532             regsub -all "\\(\\)" $method_decl "(void)" method_decl
 533             if {"$actual_line" == "$method_decl"} {
 534                 if {"$access" != "$method_access"} {
 535                     cp_check_errata "$method_access" "$access" $in_errata_table
 536                     fail "$in_testname // wrong access specifier for method: $access"
 537                     queue delete $line_queue
 538                     return false
 539                 }
 540                 set list_methods [lreplace $list_methods 0 0]
 541                 continue
 542             }
 543         }
 544
 545         # Typedef
 546
 547         if {[llength $list_typedefs] > 0} {
 548             set typedef_access [lindex [lindex $list_typedefs 0] 0]
 549             set typedef_decl [lindex [lindex $list_typedefs 0] 1]
 550             if {[string equal $actual_line $typedef_decl]} {
 551                 if {![string equal $access $typedef_access]} {
 552                     cp_check_errata $typedef_access $access $in_errata_table
 553                     fail "$in_testname // wrong access specifier for typedef: $access"
 554                     queue delete $line_queue
 555                     return false
 556                 }
 557                 set list_typedefs [lreplace $list_typedefs 0 0]
 558                 continue
 559             }
 560         }
 561
 562         # Nested type definitions
 563
 564         if {[llength $list_types] > 0} {
 565             cp_ptype_class_verbose "Nested type definition: "
 566             lassign [lindex $list_types 0] nested_access nested_key \
 567                 nested_name nested_children
 568             set msg "nested_access=$nested_access, nested_key=$nested_key, "
 569             append msg "nested_name=$nested_name, "
 570             append msg "[llength $nested_children] children"
 571             cp_ptype_class_verbose $msg
 572
 573             if {![string equal $access $nested_access]} {
 574                 cp_check_errata $nested_access $access $in_errata_table
 575                 set txt "$in_testname // wrong access specifier for "
 576                 append txt "nested type: $access"
 577                 fail $txt
 578                 queue delete $line_queue
 579                 return false
 580             }
 581
 582             switch $nested_key {
 583                 enum {
 584                     set expected_result \
 585                         "enum $nested_name (: (unsigned )?int )?\{"
 586                     foreach c $nested_children {
 587                         append expected_result "$c, "
 588                     }
 589                     set expected_result \
 590                         [string trimright $expected_result { ,}]
 591                     append expected_result "\};"
 592                     cp_ptype_class_verbose \
 593                         "Expecting enum result: $expected_result"
 594                     if {![regexp -- $expected_result $actual_line]} {
 595                         set txt "$in_testname // wrong nested type enum"
 596                         append txt " definition: $actual_line"
 597                         fail $txt
 598                         queue delete $line_queue
 599                         return false
 600                     }
 601                     cp_ptype_class_verbose "passed enum $nested_name"
 602                 }
 603
 604                 union {
 605                     set expected_result "union $nested_name \{"
 606                     cp_ptype_class_verbose \
 607                         "Expecting union result: $expected_result"
 608                     if {![string equal $expected_result $actual_line]} {
 609                         set txt "$in_testname // wrong nested type union"
 610                         append txt " definition: $actual_line"
 611                         fail $txt
 612                         queue delete $line_queue
 613                         return false
 614                     }
 615
 616                     # This will be followed by lines for each member of the
 617                     # union.
 618                     cp_ptype_class_verbose "matched union name"
 619                     foreach m $nested_children {
 620                         set actual_line \
 621                             [cp_support_internal::next_line $line_queue]
 622                         cp_ptype_class_verbose "Expecting union member: $m"
 623                         if {![string equal $m $actual_line]} {
 624                             set txt "$in_testname // unexpected union member: "
 625                             append txt $m
 626                             fail $txt
 627                             queue delete $line_queue
 628                             return false
 629                         }
 630                         cp_ptype_class_verbose "matched union child \"$m\""
 631                     }
 632
 633                     # Nested union types always end with a trailing curly brace.
 634                     set actual_line [cp_support_internal::next_line $line_queue]
 635                     if {![string equal $actual_line "\};"]} {
 636                         fail "$in_testname // missing closing curly brace"
 637                         queue delete $line_queue
 638                         return false
 639                     }
 640                     cp_ptype_class_verbose "passed union $nested_name"
 641                 }
 642
 643                 struct -
 644                 class {
 645                     cp_ptype_class_verbose \
 646                         "Expecting [llength $nested_children] children"
 647                     foreach c $nested_children {
 648                         cp_ptype_class_verbose "\t$c"
 649                     }
 650                     # Start by pushing the current line back into the queue
 651                     # so that the recursive call can parse the class/struct
 652                     # header.
 653                     queue unpush $line_queue $actual_line
 654                     cp_ptype_class_verbose \
 655                         "Recursing for type $nested_key $nested_name"
 656                     if {![cp_test_ptype_class $in_exp $in_testname $nested_key \
 657                               $nested_name $nested_children $in_tail \
 658                               $in_errata_table $in_ptype_arg $line_queue]} {
 659                         # The recursive call has already called `fail' and
 660                         # released the line queue.
 661                         return false
 662                     }
 663                     cp_ptype_class_verbose \
 664                         "passed nested type $nested_key $nested_name"
 665                 }
 666
 667                 default {
 668                     fail "$in_testname // invalid nested type key: $nested_key"
 669                     queue delete $line_queue
 670                     return false
 671                 }
 672             }
 673
 674             set list_types [lreplace $list_types 0 0]
 675             continue
 676         }
 677
 678         # Synthetic operators.  These are optional and can be mixed in
 679         # with the methods in any order, but duplicates are wrong.
 680         #
 681         # This test must come after the user methods, so that a user
 682         # method which matches a synth-method pattern is treated
 683         # properly as a user method.
 684
 685         set synth_match 0
 686         for { set isynth 0 } { $isynth < [llength $list_synth] } { incr isynth } {
 687             set synth         [lindex $list_synth $isynth]
 688             set synth_count   [lindex $synth 0]
 689             set synth_access  [lindex $synth 1]
 690             set synth_re      [lindex $synth 2]
 691
 692             if {[regexp "$synth_re" "$actual_line"]} {
 693
 694                 if {"$access" != "$synth_access"} {
 695                     cp_check_errata "$synth_access" "$access" $in_errata_table
 696                     fail "$in_testname // wrong access specifier for synthetic operator: $access"
 697                     queue delete $line_queue
 698                     return false
 699                 }
 700
 701                 if {$synth_count > 0} {
 702                     cp_check_errata "$actual_line" "$actual_line" $in_errata_table
 703                     fail "$in_testname // duplicate synthetic operator: $actual_line"
 704                 }
 705
 706                 # Update the count in list_synth.
 707
 708                 incr synth_count
 709                 set synth [list $synth_count $synth_access "$synth_re"]
 710                 set list_synth [lreplace $list_synth $isynth $isynth $synth]
 711
 712                 # Match found.
 713
 714                 set synth_match 1
 715                 break
 716             }
 717         }
 718         if {$synth_match} { continue }
 719
 720         # If checking a nested type/recursively and we see a closing curly
 721         # brace, we're done.
 722         if {$recursive_qid != 0 && [string equal $actual_line "\};"]} {
 723             break
 724         }
 725
 726         # Unrecognized line.
 727
 728         if {[llength $list_methods] > 0} {
 729             set method_decl [lindex [lindex $list_methods 0] 1]
 730             cp_check_errata "$method_decl" "$actual_line" $in_errata_table
 731         }
 732
 733         fail "$in_testname // unrecognized line type 2: $actual_line"
 734         queue delete $line_queue
 735         return false
 736     }
 737
 738     # Done with the line queue.
 739     if {$recursive_qid == 0} {
 740         queue delete $line_queue
 741     }
 742
 743     # Check for missing elements.
 744
 745     if {$vbase_match} {
 746         if {[llength $list_vbases] > 0} {
 747             fail "$in_testname // missing virtual base pointers"
 748             return false
 749         }
 750     }
 751
 752     if {[llength $list_fields] > 0} {
 753         fail "$in_testname // missing fields"
 754         return false
 755     }
 756
 757     if {[llength $list_methods] > 0} {
 758         fail "$in_testname // missing methods"
 759         return false
 760     }
 761
 762     if {[llength $list_typedefs] > 0} {
 763         fail "$in_testname // missing typedefs"
 764         return false
 765     }
 766
 767     # Check the tail.
 768
 769     set actual_tail [string trim $actual_tail]
 770     if {"$actual_tail" != "$in_tail"} {
 771         cp_check_errata "$in_tail" "$actual_tail" $in_errata_table
 772         fail "$in_testname // wrong tail: $actual_tail"
 773         return false
 774     }
 775
 776     # It all worked, but don't call `pass' if we've been called
 777     # recursively.
 778
 779     if {$recursive_qid == 0} {
 780         pass "$in_testname"
 781     }
 782
 783     return true
 784 }