Commit | Line | Data |
---|---|---|
78c90502 MC |
1 | # This test code is part of GDB, the GNU debugger. |
2 | ||
11bc5fe4 | 3 | # Copyright 2003-2020 Free Software Foundation, Inc. |
78c90502 MC |
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 | |
e22f8b7c | 7 | # the Free Software Foundation; either version 3 of the License, or |
78c90502 | 8 | # (at your option) any later version. |
e22f8b7c | 9 | # |
78c90502 MC |
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. | |
e22f8b7c | 14 | # |
78c90502 | 15 | # You should have received a copy of the GNU General Public License |
e22f8b7c | 16 | # along with this program. If not, see <http://www.gnu.org/licenses/>. |
78c90502 | 17 | |
883fd55a KS |
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 | ||
78c90502 MC |
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 | ||
883fd55a KS |
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. | |
78c90502 MC |
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 | # | |
b3720c3a TT |
91 | # IN_EXP is the expression to use; the appropriate "ptype" invocation |
92 | # is prepended to it. IN_TESTNAME is the testname for | |
78c90502 | 93 | # gdb_test_multiple. If IN_TESTNAME is the empty string, then it |
b3720c3a | 94 | # defaults to "ptype IN_EXP". |
78c90502 MC |
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 | # | |
345f514a KS |
128 | # { typedef "access" "declaration" } |
129 | # | |
130 | # the class has a typedef with the given access type and the | |
131 | # given declaration. | |
132 | # | |
883fd55a KS |
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 | # | |
78c90502 MC |
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 | # | |
bd69fc68 TT |
160 | # IN_PTYPE_ARG are arguments to pass to ptype. The default is "/r". |
161 | # | |
883fd55a KS |
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 | # | |
78c90502 MC |
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 | # | |
78c90502 MC |
241 | # -- chastain 2004-08-07 |
242 | ||
883fd55a KS |
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 } } { | |
78c90502 MC |
246 | global gdb_prompt |
247 | set wsopt "\[\r\n\t \]*" | |
248 | ||
883fd55a KS |
249 | if {$recursive_qid == 0} { |
250 | # The test name defaults to the command, but without the | |
251 | # arguments, for historical reasons. | |
78c90502 | 252 | |
883fd55a | 253 | if { "$in_testname" == "" } then { set in_testname "ptype $in_exp" } |
b3720c3a | 254 | |
883fd55a KS |
255 | set in_command "ptype${in_ptype_arg} $in_exp" |
256 | } | |
78c90502 MC |
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" | |
883fd55a | 264 | return false |
78c90502 MC |
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 { } | |
345f514a | 277 | set list_typedefs { } |
883fd55a KS |
278 | set list_types { } |
279 | set list_enums { } | |
280 | set list_unions { } | |
78c90502 MC |
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] } | |
345f514a | 288 | "typedef" { lappend list_typedefs [lrange $class_line 1 2] } |
883fd55a KS |
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 | } | |
78c90502 MC |
294 | } |
295 | } | |
296 | ||
297 | # Construct a list of synthetic operators. | |
298 | # These are: { count ccess-type regular-expression }. | |
299 | ||
300 | set list_synth { } | |
883fd55a KS |
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 | } | |
78c90502 | 327 | } |
883fd55a KS |
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 | |
78c90502 | 350 | } |
78c90502 MC |
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" | |
883fd55a | 364 | return false |
78c90502 MC |
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" | |
883fd55a | 373 | return false |
78c90502 MC |
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" | |
883fd55a | 389 | return false |
78c90502 MC |
390 | } |
391 | if { [llength $list_actual_bases] > [llength $list_bases] } then { | |
392 | fail "$in_testname // too many bases" | |
883fd55a | 393 | return false |
78c90502 MC |
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" | |
883fd55a | 404 | return false |
78c90502 MC |
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 | ||
883fd55a KS |
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]} { | |
78c90502 | 430 | |
883fd55a | 431 | # Get the next line. |
78c90502 | 432 | |
883fd55a | 433 | set actual_line [cp_support_internal::next_line $line_queue] |
78c90502 MC |
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" | |
883fd55a KS |
442 | queue delete $line_queue |
443 | return false | |
78c90502 MC |
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" | |
883fd55a KS |
459 | queue delete $line_queue |
460 | return false | |
78c90502 MC |
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] | |
883fd55a KS |
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 | } | |
78c90502 MC |
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" | |
883fd55a KS |
483 | queue delete $line_queue |
484 | return false | |
78c90502 MC |
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" | |
883fd55a KS |
493 | queue delete $line_queue |
494 | return false | |
78c90502 MC |
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" | |
883fd55a KS |
506 | queue delete $line_queue |
507 | return false | |
78c90502 MC |
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" | |
883fd55a KS |
519 | queue delete $line_queue |
520 | return false | |
78c90502 MC |
521 | } |
522 | set list_methods [lreplace $list_methods 0 0] | |
523 | continue | |
524 | } | |
525 | } | |
526 | ||
345f514a KS |
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" | |
883fd55a KS |
536 | queue delete $line_queue |
537 | return false | |
345f514a KS |
538 | } |
539 | set list_typedefs [lreplace $list_typedefs 0 0] | |
540 | continue | |
541 | } | |
542 | } | |
543 | ||
883fd55a KS |
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 \ | |
6f6d0c26 | 567 | "enum $nested_name (: (unsigned )?int )?\{" |
883fd55a KS |
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" | |
11b03145 | 578 | append txt " definition: $actual_line" |
883fd55a KS |
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 | ||
78c90502 MC |
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" | |
883fd55a KS |
679 | queue delete $line_queue |
680 | return false | |
78c90502 MC |
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 | ||
883fd55a KS |
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 | ||
78c90502 MC |
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" | |
883fd55a KS |
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 | |
78c90502 MC |
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" | |
883fd55a | 730 | return false |
78c90502 MC |
731 | } |
732 | } | |
733 | ||
734 | if { [llength $list_fields] > 0 } then { | |
735 | fail "$in_testname // missing fields" | |
883fd55a | 736 | return false |
78c90502 MC |
737 | } |
738 | ||
739 | if { [llength $list_methods] > 0 } then { | |
740 | fail "$in_testname // missing methods" | |
883fd55a | 741 | return false |
78c90502 MC |
742 | } |
743 | ||
345f514a KS |
744 | if {[llength $list_typedefs] > 0} { |
745 | fail "$in_testname // missing typedefs" | |
883fd55a | 746 | return false |
345f514a KS |
747 | } |
748 | ||
78c90502 MC |
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" | |
883fd55a | 755 | return false |
78c90502 MC |
756 | } |
757 | ||
883fd55a KS |
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 | } | |
78c90502 | 764 | |
883fd55a | 765 | return true |
78c90502 | 766 | } |