]>
Commit | Line | Data |
---|---|---|
78c90502 MC |
1 | # This test code is part of GDB, the GNU debugger. |
2 | ||
213516ef | 3 | # Copyright 2003-2023 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 \]*" | |
36695cf8 | 248 | set hwsopt "\[\t \]*" |
78c90502 | 249 | |
883fd55a KS |
250 | if {$recursive_qid == 0} { |
251 | # The test name defaults to the command, but without the | |
252 | # arguments, for historical reasons. | |
78c90502 | 253 | |
d4c45423 | 254 | if {"$in_testname" == ""} { set in_testname "ptype $in_exp" } |
b3720c3a | 255 | |
883fd55a KS |
256 | set in_command "ptype${in_ptype_arg} $in_exp" |
257 | } | |
78c90502 MC |
258 | |
259 | # Save class tables in a history array for reuse. | |
260 | ||
261 | global cp_class_table_history | |
d4c45423 AB |
262 | if {$in_class_table == "ibid"} { |
263 | if {![info exists cp_class_table_history("$in_key,$in_tag")]} { | |
78c90502 | 264 | fail "$in_testname // bad ibid" |
883fd55a | 265 | return false |
78c90502 MC |
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 { } | |
345f514a | 278 | set list_typedefs { } |
883fd55a KS |
279 | set list_types { } |
280 | set list_enums { } | |
281 | set list_unions { } | |
78c90502 MC |
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] } | |
345f514a | 289 | "typedef" { lappend list_typedefs [lrange $class_line 1 2] } |
883fd55a KS |
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 | } | |
78c90502 MC |
295 | } |
296 | } | |
297 | ||
298 | # Construct a list of synthetic operators. | |
299 | # These are: { count ccess-type regular-expression }. | |
300 | ||
301 | set list_synth { } | |
883fd55a KS |
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. | |
36695cf8 TV |
310 | set regexp_header "(struct|class)${hwsopt}(\[^ \t\]*)${hwsopt}" |
311 | append regexp_header "(\\\[with .*\\\]${hwsopt})?((:\[^\{\]*)?)${hwsopt}\{" | |
883fd55a KS |
312 | if {$recursive_qid == 0} { |
313 | # Actually do the ptype. | |
883fd55a | 314 | # For processing the output of ptype, we must get to the prompt. |
883fd55a | 315 | set parse_okay 0 |
36695cf8 TV |
316 | set state 0 |
317 | set actual_body "" | |
883fd55a | 318 | gdb_test_multiple "$in_command" "$in_testname // parse failed" { |
36695cf8 TV |
319 | -re "type = ${regexp_header}" { |
320 | if { $state == 0 } { set state 1 } else { set state -1 } | |
883fd55a KS |
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) | |
36695cf8 TV |
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 | } | |
883fd55a | 344 | } |
78c90502 | 345 | } |
883fd55a KS |
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 | |
78c90502 | 368 | } |
78c90502 MC |
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" | |
883fd55a | 382 | return false |
78c90502 MC |
383 | } |
384 | } | |
385 | ||
386 | # Check the actual tag. | |
387 | ||
d4c45423 | 388 | if {"$actual_tag" != "$in_tag"} { |
78c90502 MC |
389 | cp_check_errata "$in_tag" "$actual_tag" $in_errata_table |
390 | fail "$in_testname // wrong tag: $actual_tag" | |
883fd55a | 391 | return false |
78c90502 MC |
392 | } |
393 | ||
394 | # Check the actual bases. | |
395 | # First parse them into a list. | |
396 | ||
397 | set list_actual_bases { } | |
d4c45423 | 398 | if {"$actual_base_string" != ""} { |
78c90502 MC |
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 | ||
d4c45423 | 405 | if {[llength $list_actual_bases] < [llength $list_bases]} { |
78c90502 | 406 | fail "$in_testname // too few bases" |
883fd55a | 407 | return false |
78c90502 | 408 | } |
d4c45423 | 409 | if {[llength $list_actual_bases] > [llength $list_bases]} { |
78c90502 | 410 | fail "$in_testname // too many bases" |
883fd55a | 411 | return false |
78c90502 MC |
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] | |
d4c45423 | 419 | if {"$actual_base" != "$base"} { |
78c90502 MC |
420 | cp_check_errata "$base" "$actual_base" $in_errata_table |
421 | fail "$in_testname // wrong base: $actual_base" | |
883fd55a | 422 | return false |
78c90502 MC |
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 | ||
883fd55a KS |
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]} { | |
78c90502 | 448 | |
883fd55a | 449 | # Get the next line. |
78c90502 | 450 | |
883fd55a | 451 | set actual_line [cp_support_internal::next_line $line_queue] |
d4c45423 | 452 | if {"$actual_line" == ""} { continue } |
78c90502 MC |
453 | |
454 | # Access specifiers. | |
455 | ||
d4c45423 | 456 | if {[regexp "^(public|protected|private)${wsopt}:\$" "$actual_line" s0 s1]} { |
78c90502 | 457 | set access "$s1" |
d4c45423 | 458 | if {$last_was_access} { |
78c90502 | 459 | fail "$in_testname // redundant access specifier" |
883fd55a KS |
460 | queue delete $line_queue |
461 | return false | |
78c90502 MC |
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 | ||
d4c45423 | 471 | if {[llength $list_vbases] > 0} { |
78c90502 | 472 | set vbase [lindex $list_vbases 0] |
d4c45423 AB |
473 | if {[regexp "$vbase \\*(_vb.|_vb\\\$|__vb_)\[0-9\]*$vbase;" $actual_line]} { |
474 | if {"$access" != "private"} { | |
78c90502 MC |
475 | cp_check_errata "private" "$access" $in_errata_table |
476 | fail "$in_testname // wrong access specifier for virtual base: $access" | |
883fd55a KS |
477 | queue delete $line_queue |
478 | return false | |
78c90502 MC |
479 | } |
480 | set list_vbases [lreplace $list_vbases 0 0] | |
481 | set vbase_match 1 | |
482 | continue | |
483 | } | |
484 | } | |
485 | ||
486 | # Data field. | |
487 | ||
d4c45423 | 488 | if {[llength $list_fields] > 0} { |
78c90502 MC |
489 | set field_access [lindex [lindex $list_fields 0] 0] |
490 | set field_decl [lindex [lindex $list_fields 0] 1] | |
883fd55a KS |
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 | } | |
d4c45423 AB |
497 | if {"$actual_line" == "$field_decl"} { |
498 | if {"$access" != "$field_access"} { | |
78c90502 MC |
499 | cp_check_errata "$field_access" "$access" $in_errata_table |
500 | fail "$in_testname // wrong access specifier for field: $access" | |
883fd55a KS |
501 | queue delete $line_queue |
502 | return false | |
78c90502 MC |
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" | |
883fd55a KS |
511 | queue delete $line_queue |
512 | return false | |
78c90502 MC |
513 | } |
514 | ||
515 | # Method function. | |
516 | ||
d4c45423 | 517 | if {[llength $list_methods] > 0} { |
78c90502 MC |
518 | set method_access [lindex [lindex $list_methods 0] 0] |
519 | set method_decl [lindex [lindex $list_methods 0] 1] | |
d4c45423 AB |
520 | if {"$actual_line" == "$method_decl"} { |
521 | if {"$access" != "$method_access"} { | |
78c90502 MC |
522 | cp_check_errata "$method_access" "$access" $in_errata_table |
523 | fail "$in_testname // wrong access specifier for method: $access" | |
883fd55a KS |
524 | queue delete $line_queue |
525 | return false | |
78c90502 MC |
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 | |
d4c45423 AB |
533 | if {"$actual_line" == "$method_decl"} { |
534 | if {"$access" != "$method_access"} { | |
78c90502 MC |
535 | cp_check_errata "$method_access" "$access" $in_errata_table |
536 | fail "$in_testname // wrong access specifier for method: $access" | |
883fd55a KS |
537 | queue delete $line_queue |
538 | return false | |
78c90502 MC |
539 | } |
540 | set list_methods [lreplace $list_methods 0 0] | |
541 | continue | |
542 | } | |
543 | } | |
544 | ||
345f514a KS |
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" | |
883fd55a KS |
554 | queue delete $line_queue |
555 | return false | |
345f514a KS |
556 | } |
557 | set list_typedefs [lreplace $list_typedefs 0 0] | |
558 | continue | |
559 | } | |
560 | } | |
561 | ||
883fd55a KS |
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 \ | |
6f6d0c26 | 585 | "enum $nested_name (: (unsigned )?int )?\{" |
883fd55a KS |
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" | |
11b03145 | 596 | append txt " definition: $actual_line" |
883fd55a KS |
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 | ||
78c90502 MC |
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 | ||
d4c45423 | 692 | if {[regexp "$synth_re" "$actual_line"]} { |
78c90502 | 693 | |
d4c45423 | 694 | if {"$access" != "$synth_access"} { |
78c90502 MC |
695 | cp_check_errata "$synth_access" "$access" $in_errata_table |
696 | fail "$in_testname // wrong access specifier for synthetic operator: $access" | |
883fd55a KS |
697 | queue delete $line_queue |
698 | return false | |
78c90502 MC |
699 | } |
700 | ||
d4c45423 | 701 | if {$synth_count > 0} { |
78c90502 MC |
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 | } | |
d4c45423 | 718 | if {$synth_match} { continue } |
78c90502 | 719 | |
883fd55a KS |
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 | ||
78c90502 MC |
726 | # Unrecognized line. |
727 | ||
d4c45423 | 728 | if {[llength $list_methods] > 0} { |
78c90502 MC |
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" | |
883fd55a KS |
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 | |
78c90502 MC |
741 | } |
742 | ||
743 | # Check for missing elements. | |
744 | ||
d4c45423 AB |
745 | if {$vbase_match} { |
746 | if {[llength $list_vbases] > 0} { | |
78c90502 | 747 | fail "$in_testname // missing virtual base pointers" |
883fd55a | 748 | return false |
78c90502 MC |
749 | } |
750 | } | |
751 | ||
d4c45423 | 752 | if {[llength $list_fields] > 0} { |
78c90502 | 753 | fail "$in_testname // missing fields" |
883fd55a | 754 | return false |
78c90502 MC |
755 | } |
756 | ||
d4c45423 | 757 | if {[llength $list_methods] > 0} { |
78c90502 | 758 | fail "$in_testname // missing methods" |
883fd55a | 759 | return false |
78c90502 MC |
760 | } |
761 | ||
345f514a KS |
762 | if {[llength $list_typedefs] > 0} { |
763 | fail "$in_testname // missing typedefs" | |
883fd55a | 764 | return false |
345f514a KS |
765 | } |
766 | ||
78c90502 MC |
767 | # Check the tail. |
768 | ||
769 | set actual_tail [string trim $actual_tail] | |
d4c45423 | 770 | if {"$actual_tail" != "$in_tail"} { |
78c90502 MC |
771 | cp_check_errata "$in_tail" "$actual_tail" $in_errata_table |
772 | fail "$in_testname // wrong tail: $actual_tail" | |
883fd55a | 773 | return false |
78c90502 MC |
774 | } |
775 | ||
883fd55a KS |
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 | } | |
78c90502 | 782 | |
883fd55a | 783 | return true |
78c90502 | 784 | } |