gdb/testsuite/lib/cp-support.exp

   1 # This test code is part of GDB, the GNU debugger.
   2
   3 # Copyright 2003-2020 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
 249     if {$recursive_qid == 0} {
 250         # The test name defaults to the command, but without the
 251         # arguments, for historical reasons.
 252
 253         if { "$in_testname" == "" } then { set in_testname "ptype $in_exp" }
 254
 255         set in_command "ptype${in_ptype_arg} $in_exp"
 256     }
 257
 258     # Save class tables in a history array for reuse.
 259
 260     global cp_class_table_history
 261     if { $in_class_table == "ibid" } then {
 262         if { ! [info exists cp_class_table_history("$in_key,$in_tag") ] } then {
 263             fail "$in_testname // bad ibid"
 264             return false
 265         }
 266         set in_class_table $cp_class_table_history("$in_key,$in_tag")
 267     } else {
 268         set cp_class_table_history("$in_key,$in_tag") $in_class_table
 269     }
 270
 271     # Split the class table into separate tables.
 272
 273     set list_bases   { }
 274     set list_vbases  { }
 275     set list_fields  { }
 276     set list_methods { }
 277     set list_typedefs { }
 278     set list_types    { }
 279     set list_enums    { }
 280     set list_unions   { }
 281
 282     foreach class_line $in_class_table {
 283         switch [lindex $class_line 0] {
 284             "base"   { lappend list_bases   [lindex $class_line 1] }
 285             "vbase"  { lappend list_vbases  [lindex $class_line 1] }
 286             "field"  { lappend list_fields  [lrange $class_line 1 2] }
 287             "method" { lappend list_methods [lrange $class_line 1 2] }
 288             "typedef" { lappend list_typedefs [lrange $class_line 1 2] }
 289             "type"    { lappend list_types [lrange $class_line 1 4] }
 290             default  {
 291                 fail "$in_testname // bad line in class table: $class_line"
 292                 return false
 293             }
 294         }
 295     }
 296
 297     # Construct a list of synthetic operators.
 298     # These are: { count ccess-type regular-expression }.
 299
 300     set list_synth { }
 301     lappend list_synth [list 0 "public" \
 302                             "$in_tag & operator=\\($in_tag const ?&\\);"]
 303     lappend list_synth [list 0 "public" \
 304                             "$in_tag\\((int,|) ?$in_tag const ?&\\);"]
 305     lappend list_synth [list 0 "public" \
 306                             "$in_tag\\((int|void|)\\);"]
 307
 308     # Partial regexp for parsing the struct/class header.
 309     set regexp_header "(struct|class)${wsopt}(\[^ \t\]*)${wsopt}"
 310     append regexp_header "(\\\[with .*\\\]${wsopt})?((:\[^\{\]*)?)${wsopt}\{"
 311     if {$recursive_qid == 0} {
 312         # Actually do the ptype.
 313
 314         # For processing the output of ptype, we must get to the prompt.
 315         set the_regexp "type = ${regexp_header}"
 316         append the_regexp "(.*)\}${wsopt}(\[^\r\n\]*)\[\r\n\]+$gdb_prompt $"
 317         set parse_okay 0
 318         gdb_test_multiple "$in_command" "$in_testname // parse failed" {
 319             -re $the_regexp {
 320                 set parse_okay          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                 set actual_body         $expect_out(6,string)
 325                 set actual_tail         $expect_out(7,string)
 326             }
 327         }
 328     } else {
 329         # The struct/class header by the first element in the line queue.
 330         # "Parse" that instead of the output of ptype.
 331         set header [cp_support_internal::next_line $recursive_qid]
 332         set parse_okay [regexp $regexp_header $header dummy actual_key \
 333                             actual_tag dummy actual_base_string]
 334
 335         if {$parse_okay} {
 336             cp_ptype_class_verbose \
 337                 "Parsing nested type definition (parse_okay=$parse_okay):"
 338             cp_ptype_class_verbose \
 339                 "\tactual_key=$actual_key, actual_tag=$actual_tag"
 340             cp_ptype_class_verbose "\tactual_base_string=$actual_base_string"
 341         }
 342
 343         # Cannot have a tail with a nested type definition.
 344         set actual_tail ""
 345     }
 346
 347     if { ! $parse_okay } {
 348         cp_ptype_class_verbose "*** parse failed ***"
 349         return false
 350     }
 351
 352     # Check the actual key.  It would be nice to require that it match
 353     # the input key, but gdb does not support that.  For now, accept any
 354     # $actual_key as long as the access property of each field/method
 355     # matches.
 356
 357     switch "$actual_key" {
 358         "class"  { set access "private" }
 359         "struct" { set access "public"  }
 360         default  {
 361             cp_check_errata "class"  "$actual_key" $in_errata_table
 362             cp_check_errata "struct" "$actual_key" $in_errata_table
 363             fail "$in_testname // wrong key: $actual_key"
 364             return false
 365         }
 366     }
 367
 368     # Check the actual tag.
 369
 370     if { "$actual_tag" != "$in_tag" } then {
 371         cp_check_errata "$in_tag" "$actual_tag" $in_errata_table
 372         fail "$in_testname // wrong tag: $actual_tag"
 373         return false
 374     }
 375
 376     # Check the actual bases.
 377     # First parse them into a list.
 378
 379     set list_actual_bases { }
 380     if { "$actual_base_string" != "" } then {
 381         regsub "^:${wsopt}" $actual_base_string "" actual_base_string
 382         set list_actual_bases [split $actual_base_string ","]
 383     }
 384
 385     # Check the base count.
 386
 387     if { [llength $list_actual_bases] < [llength $list_bases] } then {
 388         fail "$in_testname // too few bases"
 389         return false
 390     }
 391     if { [llength $list_actual_bases] > [llength $list_bases] } then {
 392         fail "$in_testname // too many bases"
 393         return false
 394     }
 395
 396     # Check each base.
 397
 398     foreach actual_base $list_actual_bases {
 399         set actual_base [string trim $actual_base]
 400         set base [lindex $list_bases 0]
 401         if { "$actual_base" != "$base" } then {
 402             cp_check_errata "$base" "$actual_base" $in_errata_table
 403             fail "$in_testname // wrong base: $actual_base"
 404             return false
 405         }
 406         set list_bases [lreplace $list_bases 0 0]
 407     }
 408
 409     # Parse each line in the body.
 410
 411     set last_was_access 0
 412     set vbase_match 0
 413
 414     if {$recursive_qid == 0} {
 415         # Use a queue to hold the lines that will be checked.
 416         # This will allow processing below to remove lines from the input
 417         # more easily.
 418         set line_queue [::Queue::new]
 419         foreach l [split $actual_body "\r\n"] {
 420             set l [string trim $l]
 421             if {$l != ""} {
 422                 queue push $line_queue $l
 423             }
 424         }
 425     } else {
 426         set line_queue $recursive_qid
 427     }
 428
 429     while {![queue empty $line_queue]} {
 430
 431         # Get the next line.
 432
 433         set actual_line [cp_support_internal::next_line $line_queue]
 434         if { "$actual_line" == "" } then { continue }
 435
 436         # Access specifiers.
 437
 438         if { [regexp "^(public|protected|private)${wsopt}:\$" "$actual_line" s0 s1] } then {
 439             set access "$s1"
 440             if { $last_was_access } then {
 441                 fail "$in_testname // redundant access specifier"
 442                 queue delete $line_queue
 443                 return false
 444             }
 445             set last_was_access 1
 446             continue
 447         } else {
 448             set last_was_access 0
 449         }
 450
 451         # Optional virtual base pointer.
 452
 453         if { [ llength $list_vbases ] > 0 } then {
 454             set vbase [lindex $list_vbases 0]
 455             if { [ regexp "$vbase \\*(_vb.|_vb\\\$|__vb_)\[0-9\]*$vbase;" $actual_line ] } then {
 456                 if { "$access" != "private" } then {
 457                     cp_check_errata "private" "$access" $in_errata_table
 458                     fail "$in_testname // wrong access specifier for virtual base: $access"
 459                     queue delete $line_queue
 460                     return false
 461                 }
 462                 set list_vbases [lreplace $list_vbases 0 0]
 463                 set vbase_match 1
 464                 continue
 465             }
 466         }
 467
 468         # Data field.
 469
 470         if { [llength $list_fields] > 0 } then {
 471             set field_access [lindex [lindex $list_fields 0] 0]
 472             set field_decl   [lindex [lindex $list_fields 0] 1]
 473             if {$recursive_qid > 0} {
 474                 cp_ptype_class_verbose "\tactual_line=$actual_line"
 475                 cp_ptype_class_verbose "\tfield_access=$field_access"
 476                 cp_ptype_class_verbose "\tfield_decl=$field_decl"
 477                 cp_ptype_class_verbose "\taccess=$access"
 478             }
 479             if { "$actual_line" == "$field_decl" } then {
 480                 if { "$access" != "$field_access" } then {
 481                     cp_check_errata "$field_access" "$access" $in_errata_table
 482                     fail "$in_testname // wrong access specifier for field: $access"
 483                     queue delete $line_queue
 484                     return false
 485                 }
 486                 set list_fields [lreplace $list_fields 0 0]
 487                 continue
 488             }
 489
 490             # Data fields must appear before synths and methods.
 491             cp_check_errata "$field_decl" "$actual_line" $in_errata_table
 492             fail "$in_testname // unrecognized line type 1: $actual_line"
 493             queue delete $line_queue
 494             return false
 495         }
 496
 497         # Method function.
 498
 499         if { [llength $list_methods] > 0 } then {
 500             set method_access [lindex [lindex $list_methods 0] 0]
 501             set method_decl   [lindex [lindex $list_methods 0] 1]
 502             if { "$actual_line" == "$method_decl" } then {
 503                 if { "$access" != "$method_access" } then {
 504                     cp_check_errata "$method_access" "$access" $in_errata_table
 505                     fail "$in_testname // wrong access specifier for method: $access"
 506                     queue delete $line_queue
 507                     return false
 508                 }
 509                 set list_methods [lreplace $list_methods 0 0]
 510                 continue
 511             }
 512
 513             # gcc 2.95.3 shows "foo()" as "foo(void)".
 514             regsub -all "\\(\\)" $method_decl "(void)" method_decl
 515             if { "$actual_line" == "$method_decl" } then {
 516                 if { "$access" != "$method_access" } then {
 517                     cp_check_errata "$method_access" "$access" $in_errata_table
 518                     fail "$in_testname // wrong access specifier for method: $access"
 519                     queue delete $line_queue
 520                     return false
 521                 }
 522                 set list_methods [lreplace $list_methods 0 0]
 523                 continue
 524             }
 525         }
 526
 527         # Typedef
 528
 529         if {[llength $list_typedefs] > 0} {
 530             set typedef_access [lindex [lindex $list_typedefs 0] 0]
 531             set typedef_decl [lindex [lindex $list_typedefs 0] 1]
 532             if {[string equal $actual_line $typedef_decl]} {
 533                 if {![string equal $access $typedef_access]} {
 534                     cp_check_errata $typedef_access $access $in_errata_table
 535                     fail "$in_testname // wrong access specifier for typedef: $access"
 536                     queue delete $line_queue
 537                     return false
 538                 }
 539                 set list_typedefs [lreplace $list_typedefs 0 0]
 540                 continue
 541             }
 542         }
 543
 544         # Nested type definitions
 545
 546         if {[llength $list_types] > 0} {
 547             cp_ptype_class_verbose "Nested type definition: "
 548             lassign [lindex $list_types 0] nested_access nested_key \
 549                 nested_name nested_children
 550             set msg "nested_access=$nested_access, nested_key=$nested_key, "
 551             append msg "nested_name=$nested_name, "
 552             append msg "[llength $nested_children] children"
 553             cp_ptype_class_verbose $msg
 554
 555             if {![string equal $access $nested_access]} {
 556                 cp_check_errata $nested_access $access $in_errata_table
 557                 set txt "$in_testname // wrong access specifier for "
 558                 append txt "nested type: $access"
 559                 fail $txt
 560                 queue delete $line_queue
 561                 return false
 562             }
 563
 564             switch $nested_key {
 565                 enum {
 566                     set expected_result \
 567                         "enum $nested_name (: (unsigned )?int )?\{"
 568                     foreach c $nested_children {
 569                         append expected_result "$c, "
 570                     }
 571                     set expected_result \
 572                         [string trimright $expected_result { ,}]
 573                     append expected_result "\};"
 574                     cp_ptype_class_verbose \
 575                         "Expecting enum result: $expected_result"
 576                     if {![regexp -- $expected_result $actual_line]} {
 577                         set txt "$in_testname // wrong nested type enum"
 578                         append txt " definition: $actual_line"
 579                         fail $txt
 580                         queue delete $line_queue
 581                         return false
 582                     }
 583                     cp_ptype_class_verbose "passed enum $nested_name"
 584                 }
 585
 586                 union {
 587                     set expected_result "union $nested_name \{"
 588                     cp_ptype_class_verbose \
 589                         "Expecting union result: $expected_result"
 590                     if {![string equal $expected_result $actual_line]} {
 591                         set txt "$in_testname // wrong nested type union"
 592                         append txt " definition: $actual_line"
 593                         fail $txt
 594                         queue delete $line_queue
 595                         return false
 596                     }
 597
 598                     # This will be followed by lines for each member of the
 599                     # union.
 600                     cp_ptype_class_verbose "matched union name"
 601                     foreach m $nested_children {
 602                         set actual_line \
 603                             [cp_support_internal::next_line $line_queue]
 604                         cp_ptype_class_verbose "Expecting union member: $m"
 605                         if {![string equal $m $actual_line]} {
 606                             set txt "$in_testname // unexpected union member: "
 607                             append txt $m
 608                             fail $txt
 609                             queue delete $line_queue
 610                             return false
 611                         }
 612                         cp_ptype_class_verbose "matched union child \"$m\""
 613                     }
 614
 615                     # Nested union types always end with a trailing curly brace.
 616                     set actual_line [cp_support_internal::next_line $line_queue]
 617                     if {![string equal $actual_line "\};"]} {
 618                         fail "$in_testname // missing closing curly brace"
 619                         queue delete $line_queue
 620                         return false
 621                     }
 622                     cp_ptype_class_verbose "passed union $nested_name"
 623                 }
 624
 625                 struct -
 626                 class {
 627                     cp_ptype_class_verbose \
 628                         "Expecting [llength $nested_children] children"
 629                     foreach c $nested_children {
 630                         cp_ptype_class_verbose "\t$c"
 631                     }
 632                     # Start by pushing the current line back into the queue
 633                     # so that the recursive call can parse the class/struct
 634                     # header.
 635                     queue unpush $line_queue $actual_line
 636                     cp_ptype_class_verbose \
 637                         "Recursing for type $nested_key $nested_name"
 638                     if {![cp_test_ptype_class $in_exp $in_testname $nested_key \
 639                               $nested_name $nested_children $in_tail \
 640                               $in_errata_table $in_ptype_arg $line_queue]} {
 641                         # The recursive call has already called `fail' and
 642                         # released the line queue.
 643                         return false
 644                     }
 645                     cp_ptype_class_verbose \
 646                         "passed nested type $nested_key $nested_name"
 647                 }
 648
 649                 default {
 650                     fail "$in_testname // invalid nested type key: $nested_key"
 651                     queue delete $line_queue
 652                     return false
 653                 }
 654             }
 655
 656             set list_types [lreplace $list_types 0 0]
 657             continue
 658         }
 659
 660         # Synthetic operators.  These are optional and can be mixed in
 661         # with the methods in any order, but duplicates are wrong.
 662         #
 663         # This test must come after the user methods, so that a user
 664         # method which matches a synth-method pattern is treated
 665         # properly as a user method.
 666
 667         set synth_match 0
 668         for { set isynth 0 } { $isynth < [llength $list_synth] } { incr isynth } {
 669             set synth         [lindex $list_synth $isynth]
 670             set synth_count   [lindex $synth 0]
 671             set synth_access  [lindex $synth 1]
 672             set synth_re      [lindex $synth 2]
 673
 674             if { [ regexp "$synth_re" "$actual_line" ] } then {
 675
 676                 if { "$access" != "$synth_access" } then {
 677                     cp_check_errata "$synth_access" "$access" $in_errata_table
 678                     fail "$in_testname // wrong access specifier for synthetic operator: $access"
 679                     queue delete $line_queue
 680                     return false
 681                 }
 682
 683                 if { $synth_count > 0 } then {
 684                     cp_check_errata "$actual_line" "$actual_line" $in_errata_table
 685                     fail "$in_testname // duplicate synthetic operator: $actual_line"
 686                 }
 687
 688                 # Update the count in list_synth.
 689
 690                 incr synth_count
 691                 set synth [list $synth_count $synth_access "$synth_re"]
 692                 set list_synth [lreplace $list_synth $isynth $isynth $synth]
 693
 694                 # Match found.
 695
 696                 set synth_match 1
 697                 break
 698             }
 699         }
 700         if { $synth_match } then { continue }
 701
 702         # If checking a nested type/recursively and we see a closing curly
 703         # brace, we're done.
 704         if {$recursive_qid != 0 && [string equal $actual_line "\};"]} {
 705             break
 706         }
 707
 708         # Unrecognized line.
 709
 710         if { [llength $list_methods] > 0 } then {
 711             set method_decl [lindex [lindex $list_methods 0] 1]
 712             cp_check_errata "$method_decl" "$actual_line" $in_errata_table
 713         }
 714
 715         fail "$in_testname // unrecognized line type 2: $actual_line"
 716         queue delete $line_queue
 717         return false
 718     }
 719
 720     # Done with the line queue.
 721     if {$recursive_qid == 0} {
 722         queue delete $line_queue
 723     }
 724
 725     # Check for missing elements.
 726
 727     if { $vbase_match } then {
 728         if { [llength $list_vbases] > 0 } then {
 729             fail "$in_testname // missing virtual base pointers"
 730             return false
 731         }
 732     }
 733
 734     if { [llength $list_fields] > 0 } then {
 735         fail "$in_testname // missing fields"
 736         return false
 737     }
 738
 739     if { [llength $list_methods] > 0 } then {
 740         fail "$in_testname // missing methods"
 741         return false
 742     }
 743
 744     if {[llength $list_typedefs] > 0} {
 745         fail "$in_testname // missing typedefs"
 746         return false
 747     }
 748
 749     # Check the tail.
 750
 751     set actual_tail [string trim $actual_tail]
 752     if { "$actual_tail" != "$in_tail" } then {
 753         cp_check_errata "$in_tail" "$actual_tail" $in_errata_table
 754         fail "$in_testname // wrong tail: $actual_tail"
 755         return false
 756     }
 757
 758     # It all worked, but don't call `pass' if we've been called
 759     # recursively.
 760
 761     if {$recursive_qid == 0} {
 762         pass "$in_testname"
 763     }
 764
 765     return true
 766 }