]>
Commit | Line | Data |
---|---|---|
19235870 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- P A R . C H 1 3 -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
4b490c1e | 9 | -- Copyright (C) 1992-2020, Free Software Foundation, Inc. -- |
19235870 RK |
10 | -- -- |
11 | -- GNAT is free software; you can redistribute it and/or modify it under -- | |
12 | -- terms of the GNU General Public License as published by the Free Soft- -- | |
b5c84c3c | 13 | -- ware Foundation; either version 3, or (at your option) any later ver- -- |
19235870 RK |
14 | -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- |
15 | -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- | |
16 | -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -- | |
17 | -- for more details. You should have received a copy of the GNU General -- | |
b5c84c3c RD |
18 | -- Public License distributed with GNAT; see file COPYING3. If not, go to -- |
19 | -- http://www.gnu.org/licenses for a complete copy of the license. -- | |
19235870 RK |
20 | -- -- |
21 | -- GNAT was originally developed by the GNAT team at New York University. -- | |
71ff80dc | 22 | -- Extensive contributions were provided by Ada Core Technologies Inc. -- |
19235870 RK |
23 | -- -- |
24 | ------------------------------------------------------------------------------ | |
25 | ||
26 | pragma Style_Checks (All_Checks); | |
27 | -- Turn off subprogram body ordering check. Subprograms are in order | |
28 | -- by RM section rather than alphabetical | |
29 | ||
30 | separate (Par) | |
31 | package body Ch13 is | |
32 | ||
33 | -- Local functions, used only in this chapter | |
34 | ||
35 | function P_Component_Clause return Node_Id; | |
36 | function P_Mod_Clause return Node_Id; | |
37 | ||
0f1a6a0b AC |
38 | ----------------------------------- |
39 | -- Aspect_Specifications_Present -- | |
40 | ----------------------------------- | |
41 | ||
39231404 AC |
42 | function Aspect_Specifications_Present |
43 | (Strict : Boolean := Ada_Version < Ada_2012) return Boolean | |
44 | is | |
0f1a6a0b AC |
45 | Scan_State : Saved_Scan_State; |
46 | Result : Boolean; | |
47 | ||
a905304c AC |
48 | function Possible_Misspelled_Aspect return Boolean; |
49 | -- Returns True, if Token_Name is a misspelling of some aspect name | |
50 | ||
ef2c20e7 AC |
51 | function With_Present return Boolean; |
52 | -- Returns True if WITH is present, indicating presence of aspect | |
53 | -- specifications. Also allows incorrect use of WHEN in place of WITH. | |
54 | ||
a905304c AC |
55 | -------------------------------- |
56 | -- Possible_Misspelled_Aspect -- | |
57 | -------------------------------- | |
58 | ||
59 | function Possible_Misspelled_Aspect return Boolean is | |
60 | begin | |
61 | for J in Aspect_Id_Exclude_No_Aspect loop | |
62 | if Is_Bad_Spelling_Of (Token_Name, Aspect_Names (J)) then | |
63 | return True; | |
64 | end if; | |
65 | end loop; | |
66 | ||
67 | return False; | |
68 | end Possible_Misspelled_Aspect; | |
69 | ||
ef2c20e7 AC |
70 | ------------------ |
71 | -- With_Present -- | |
72 | ------------------ | |
73 | ||
74 | function With_Present return Boolean is | |
75 | begin | |
76 | if Token = Tok_With then | |
77 | return True; | |
78 | ||
79 | -- Check for WHEN used in place of WITH | |
80 | ||
81 | elsif Token = Tok_When then | |
82 | declare | |
83 | Scan_State : Saved_Scan_State; | |
84 | ||
85 | begin | |
86 | Save_Scan_State (Scan_State); | |
87 | Scan; -- past WHEN | |
88 | ||
89 | if Token = Tok_Identifier | |
90 | and then Get_Aspect_Id (Token_Name) /= No_Aspect | |
91 | then | |
92 | Error_Msg_SC ("WHEN should be WITH"); | |
93 | Restore_Scan_State (Scan_State); | |
94 | return True; | |
95 | ||
96 | else | |
97 | Restore_Scan_State (Scan_State); | |
98 | return False; | |
99 | end if; | |
100 | end; | |
101 | ||
102 | else | |
103 | return False; | |
104 | end if; | |
105 | end With_Present; | |
106 | ||
a905304c AC |
107 | -- Start of processing for Aspect_Specifications_Present |
108 | ||
0f1a6a0b | 109 | begin |
eaba57fb | 110 | -- Definitely must have WITH to consider aspect specs to be present |
39231404 | 111 | |
eaba57fb RD |
112 | -- Note that this means that if we have a semicolon, we immediately |
113 | -- return False. There is a case in which this is not optimal, namely | |
114 | -- something like | |
0f1a6a0b | 115 | |
eaba57fb RD |
116 | -- type R is new Integer; |
117 | -- with bla bla; | |
0f1a6a0b | 118 | |
eaba57fb RD |
119 | -- where the semicolon is redundant, but scanning forward for it would |
120 | -- be too expensive. Instead we pick up the aspect specifications later | |
121 | -- as a bogus declaration, and diagnose the semicolon at that point. | |
0f1a6a0b | 122 | |
ef2c20e7 | 123 | if not With_Present then |
0f1a6a0b AC |
124 | return False; |
125 | end if; | |
126 | ||
ef2c20e7 AC |
127 | -- Have a WITH or some token that we accept as a legitimate bad attempt |
128 | -- at writing WITH. See if it looks like an aspect specification | |
0f1a6a0b AC |
129 | |
130 | Save_Scan_State (Scan_State); | |
ef2c20e7 | 131 | Scan; -- past WITH (or WHEN or other bad keyword) |
0f1a6a0b AC |
132 | |
133 | -- If no identifier, then consider that we definitely do not have an | |
134 | -- aspect specification. | |
135 | ||
136 | if Token /= Tok_Identifier then | |
137 | Result := False; | |
138 | ||
a905304c AC |
139 | -- This is where we pay attention to the Strict mode. Normally when |
140 | -- we are in Ada 2012 mode, Strict is False, and we consider that we | |
141 | -- have an aspect specification if the identifier is an aspect name | |
142 | -- or a likely misspelling of one (even if not followed by =>) or | |
143 | -- the identifier is not an aspect name but is followed by =>, by | |
144 | -- a comma, or by a semicolon. The last two cases correspond to | |
145 | -- (misspelled) Boolean aspects with a defaulted value of True. | |
146 | -- P_Aspect_Specifications will generate messages if the aspect | |
9e92ad49 | 147 | -- specification is ill-formed. |
0f1a6a0b | 148 | |
39231404 | 149 | elsif not Strict then |
a905304c AC |
150 | if Get_Aspect_Id (Token_Name) /= No_Aspect |
151 | or else Possible_Misspelled_Aspect | |
152 | then | |
0f1a6a0b AC |
153 | Result := True; |
154 | else | |
155 | Scan; -- past identifier | |
15918371 AC |
156 | Result := Token = Tok_Arrow or else |
157 | Token = Tok_Comma or else | |
158 | Token = Tok_Semicolon; | |
0f1a6a0b AC |
159 | end if; |
160 | ||
78efd712 AC |
161 | -- If earlier than Ada 2012, check for valid aspect identifier (possibly |
162 | -- completed with 'CLASS) followed by an arrow, and consider that this | |
163 | -- is still an aspect specification so we give an appropriate message. | |
0f1a6a0b AC |
164 | |
165 | else | |
166 | if Get_Aspect_Id (Token_Name) = No_Aspect then | |
167 | Result := False; | |
168 | ||
169 | else | |
170 | Scan; -- past aspect name | |
171 | ||
78efd712 AC |
172 | Result := False; |
173 | ||
174 | if Token = Tok_Arrow then | |
175 | Result := True; | |
176 | ||
7a1f1775 AC |
177 | -- The identifier may be the name of a boolean aspect with a |
178 | -- defaulted True value. Further checks when analyzing aspect | |
e28072cd | 179 | -- specification, which may include further aspects. |
7a1f1775 | 180 | |
15918371 | 181 | elsif Token = Tok_Comma or else Token = Tok_Semicolon then |
7a1f1775 AC |
182 | Result := True; |
183 | ||
78efd712 AC |
184 | elsif Token = Tok_Apostrophe then |
185 | Scan; -- past apostrophe | |
186 | ||
187 | if Token = Tok_Identifier | |
188 | and then Token_Name = Name_Class | |
189 | then | |
190 | Scan; -- past CLASS | |
191 | ||
192 | if Token = Tok_Arrow then | |
193 | Result := True; | |
194 | end if; | |
195 | end if; | |
196 | end if; | |
0f1a6a0b | 197 | |
78efd712 | 198 | if Result then |
0f1a6a0b | 199 | Restore_Scan_State (Scan_State); |
fb620b37 | 200 | Error_Msg_Ada_2012_Feature ("|aspect specification", Token_Ptr); |
0f1a6a0b AC |
201 | return True; |
202 | end if; | |
203 | end if; | |
204 | end if; | |
205 | ||
206 | Restore_Scan_State (Scan_State); | |
207 | return Result; | |
208 | end Aspect_Specifications_Present; | |
209 | ||
473e20df AC |
210 | ------------------------------- |
211 | -- Get_Aspect_Specifications -- | |
212 | ------------------------------- | |
213 | ||
214 | function Get_Aspect_Specifications | |
215 | (Semicolon : Boolean := True) return List_Id | |
216 | is | |
473e20df | 217 | A_Id : Aspect_Id; |
adb252d8 AC |
218 | Aspect : Node_Id; |
219 | Aspects : List_Id; | |
473e20df AC |
220 | OK : Boolean; |
221 | ||
bc3c2eca AC |
222 | Opt : Boolean; |
223 | -- True if current aspect takes an optional argument | |
224 | ||
473e20df AC |
225 | begin |
226 | Aspects := Empty_List; | |
227 | ||
228 | -- Check if aspect specification present | |
229 | ||
230 | if not Aspect_Specifications_Present then | |
231 | if Semicolon then | |
232 | TF_Semicolon; | |
233 | end if; | |
234 | ||
235 | return Aspects; | |
236 | end if; | |
237 | ||
ef2c20e7 | 238 | Scan; -- past WITH (or possible WHEN after error) |
473e20df AC |
239 | Aspects := Empty_List; |
240 | ||
aa3efecd AC |
241 | -- Loop to scan aspects |
242 | ||
473e20df AC |
243 | loop |
244 | OK := True; | |
245 | ||
adb252d8 AC |
246 | -- The aspect mark is not an identifier |
247 | ||
473e20df AC |
248 | if Token /= Tok_Identifier then |
249 | Error_Msg_SC ("aspect identifier expected"); | |
250 | ||
adb252d8 AC |
251 | -- Skip the whole aspect specification list |
252 | ||
473e20df AC |
253 | if Semicolon then |
254 | Resync_Past_Semicolon; | |
255 | end if; | |
256 | ||
257 | return Aspects; | |
258 | end if; | |
259 | ||
473e20df AC |
260 | A_Id := Get_Aspect_Id (Token_Name); |
261 | Aspect := | |
262 | Make_Aspect_Specification (Token_Ptr, | |
263 | Identifier => Token_Node); | |
264 | ||
adb252d8 | 265 | -- The aspect mark is not recognized |
473e20df AC |
266 | |
267 | if A_Id = No_Aspect then | |
9d2a2071 | 268 | Error_Msg_N ("& is not a valid aspect identifier", Token_Node); |
adb252d8 | 269 | OK := False; |
473e20df AC |
270 | |
271 | -- Check bad spelling | |
272 | ||
f2c992d9 AC |
273 | for J in Aspect_Id_Exclude_No_Aspect loop |
274 | if Is_Bad_Spelling_Of (Token_Name, Aspect_Names (J)) then | |
473e20df | 275 | Error_Msg_Name_1 := Aspect_Names (J); |
9d2a2071 AC |
276 | Error_Msg_N -- CODEFIX |
277 | ("\possible misspelling of%", Token_Node); | |
473e20df AC |
278 | exit; |
279 | end if; | |
280 | end loop; | |
281 | ||
282 | Scan; -- past incorrect identifier | |
283 | ||
284 | if Token = Tok_Apostrophe then | |
adb252d8 | 285 | Scan; -- past apostrophe |
473e20df AC |
286 | Scan; -- past presumably CLASS |
287 | end if; | |
288 | ||
adb252d8 AC |
289 | -- Attempt to parse the aspect definition by assuming it is an |
290 | -- expression. | |
291 | ||
473e20df | 292 | if Token = Tok_Arrow then |
adb252d8 | 293 | Scan; -- past arrow |
473e20df | 294 | Set_Expression (Aspect, P_Expression); |
adb252d8 | 295 | |
9d2a2071 AC |
296 | -- If we have a correct terminator (comma or semicolon, or a |
297 | -- reasonable likely missing comma), then just proceed. | |
473e20df | 298 | |
9d2a2071 AC |
299 | elsif Token = Tok_Comma or else |
300 | Token = Tok_Semicolon or else | |
301 | Token = Tok_Identifier | |
302 | then | |
adb252d8 AC |
303 | null; |
304 | ||
305 | -- Otherwise the aspect contains a junk definition | |
473e20df AC |
306 | |
307 | else | |
308 | if Semicolon then | |
309 | Resync_Past_Semicolon; | |
310 | end if; | |
311 | ||
312 | return Aspects; | |
313 | end if; | |
314 | ||
adb252d8 | 315 | -- Aspect mark is OK |
473e20df AC |
316 | |
317 | else | |
318 | Scan; -- past identifier | |
bc3c2eca AC |
319 | Opt := Aspect_Argument (A_Id) = Optional_Expression |
320 | or else | |
321 | Aspect_Argument (A_Id) = Optional_Name; | |
473e20df AC |
322 | |
323 | -- Check for 'Class present | |
324 | ||
325 | if Token = Tok_Apostrophe then | |
adb252d8 | 326 | if Class_Aspect_OK (A_Id) then |
473e20df AC |
327 | Scan; -- past apostrophe |
328 | ||
adb252d8 AC |
329 | if Token = Tok_Identifier |
330 | and then Token_Name = Name_Class | |
473e20df | 331 | then |
adb252d8 AC |
332 | Scan; -- past CLASS |
333 | Set_Class_Present (Aspect); | |
334 | else | |
473e20df AC |
335 | Error_Msg_SC ("Class attribute expected here"); |
336 | OK := False; | |
337 | ||
338 | if Token = Tok_Identifier then | |
339 | Scan; -- past identifier not CLASS | |
340 | end if; | |
473e20df | 341 | end if; |
adb252d8 AC |
342 | |
343 | -- The aspect does not allow 'Class | |
344 | ||
345 | else | |
346 | Error_Msg_Node_1 := Identifier (Aspect); | |
347 | Error_Msg_SC ("aspect& does not permit attribute here"); | |
348 | OK := False; | |
349 | ||
350 | Scan; -- past apostrophe | |
351 | Scan; -- past presumably CLASS | |
473e20df AC |
352 | end if; |
353 | end if; | |
354 | ||
adb252d8 AC |
355 | -- Check for a missing aspect definition. Aspects with optional |
356 | -- definitions are not considered. | |
473e20df | 357 | |
adb252d8 | 358 | if Token = Tok_Comma or else Token = Tok_Semicolon then |
bc3c2eca | 359 | if not Opt then |
473e20df AC |
360 | Error_Msg_Node_1 := Identifier (Aspect); |
361 | Error_Msg_AP ("aspect& requires an aspect definition"); | |
362 | OK := False; | |
363 | end if; | |
364 | ||
bc3c2eca AC |
365 | -- Here we do not have a comma or a semicolon, we are done if we |
366 | -- do not have an arrow and the aspect does not need an argument | |
adb252d8 | 367 | |
bc3c2eca AC |
368 | elsif Opt and then Token /= Tok_Arrow then |
369 | null; | |
370 | ||
371 | -- Here we have either an arrow, or an aspect that definitely | |
372 | -- needs an aspect definition, and we will look for one even if | |
373 | -- no arrow is preseant. | |
473e20df | 374 | |
adb252d8 | 375 | -- Otherwise we have an aspect definition |
473e20df AC |
376 | |
377 | else | |
378 | if Token = Tok_Arrow then | |
379 | Scan; -- past arrow | |
380 | else | |
381 | T_Arrow; | |
382 | OK := False; | |
383 | end if; | |
384 | ||
adb252d8 | 385 | -- Detect a common error where the non-null definition of |
bf561f2b AC |
386 | -- aspect Depends, Global, Refined_Depends, Refined_Global |
387 | -- or Refined_State lacks enclosing parentheses. | |
adb252d8 AC |
388 | |
389 | if Token /= Tok_Left_Paren and then Token /= Tok_Null then | |
390 | ||
391 | -- [Refined_]Depends | |
392 | ||
393 | if A_Id = Aspect_Depends | |
394 | or else | |
395 | A_Id = Aspect_Refined_Depends | |
396 | then | |
397 | Error_Msg_SC -- CODEFIX | |
398 | ("missing ""("""); | |
399 | Resync_Past_Malformed_Aspect; | |
400 | ||
401 | -- Return when the current aspect is the last in the list | |
402 | -- of specifications and the list applies to a body. | |
403 | ||
404 | if Token = Tok_Is then | |
405 | return Aspects; | |
406 | end if; | |
407 | ||
408 | -- [Refined_]Global | |
409 | ||
410 | elsif A_Id = Aspect_Global | |
411 | or else | |
412 | A_Id = Aspect_Refined_Global | |
413 | then | |
414 | declare | |
415 | Scan_State : Saved_Scan_State; | |
416 | ||
417 | begin | |
418 | Save_Scan_State (Scan_State); | |
419 | Scan; -- past item or mode_selector | |
420 | ||
421 | -- Emit an error when the aspect has a mode_selector | |
422 | -- as the moded_global_list must be parenthesized: | |
423 | -- with Global => Output => Item | |
424 | ||
425 | if Token = Tok_Arrow then | |
426 | Restore_Scan_State (Scan_State); | |
427 | Error_Msg_SC -- CODEFIX | |
428 | ("missing ""("""); | |
429 | Resync_Past_Malformed_Aspect; | |
430 | ||
431 | -- Return when the current aspect is the last in | |
432 | -- the list of specifications and the list applies | |
433 | -- to a body. | |
434 | ||
435 | if Token = Tok_Is then | |
436 | return Aspects; | |
437 | end if; | |
438 | ||
439 | elsif Token = Tok_Comma then | |
440 | Scan; -- past comma | |
441 | ||
442 | -- An item followed by a comma does not need to | |
443 | -- be parenthesized if the next token is a valid | |
444 | -- aspect name: | |
445 | -- with Global => Item, | |
446 | -- Aspect => ... | |
447 | ||
448 | if Token = Tok_Identifier | |
449 | and then Get_Aspect_Id (Token_Name) /= No_Aspect | |
450 | then | |
451 | Restore_Scan_State (Scan_State); | |
452 | ||
453 | -- Otherwise this is a list of items in which case | |
454 | -- the list must be parenthesized. | |
455 | ||
456 | else | |
457 | Restore_Scan_State (Scan_State); | |
458 | Error_Msg_SC -- CODEFIX | |
459 | ("missing ""("""); | |
460 | Resync_Past_Malformed_Aspect; | |
461 | ||
462 | -- Return when the current aspect is the last | |
463 | -- in the list of specifications and the list | |
464 | -- applies to a body. | |
465 | ||
466 | if Token = Tok_Is then | |
467 | return Aspects; | |
468 | end if; | |
469 | end if; | |
470 | ||
471 | -- The definition of [Refined_]Global does not need to | |
472 | -- be parenthesized. | |
473 | ||
474 | else | |
475 | Restore_Scan_State (Scan_State); | |
476 | end if; | |
477 | end; | |
bf561f2b AC |
478 | |
479 | -- Refined_State | |
480 | ||
481 | elsif A_Id = Aspect_Refined_State then | |
482 | if Token = Tok_Identifier then | |
483 | declare | |
484 | Scan_State : Saved_Scan_State; | |
485 | ||
486 | begin | |
487 | Save_Scan_State (Scan_State); | |
488 | Scan; -- past state | |
489 | ||
490 | -- The refinement contains a constituent, the whole | |
491 | -- argument of Refined_State must be parenthesized. | |
492 | ||
493 | -- with Refined_State => State => Constit | |
494 | ||
495 | if Token = Tok_Arrow then | |
496 | Restore_Scan_State (Scan_State); | |
497 | Error_Msg_SC -- CODEFIX | |
498 | ("missing ""("""); | |
499 | Resync_Past_Malformed_Aspect; | |
500 | ||
501 | -- Return when the current aspect is the last | |
502 | -- in the list of specifications and the list | |
503 | -- applies to a body. | |
504 | ||
505 | if Token = Tok_Is then | |
506 | return Aspects; | |
507 | end if; | |
508 | ||
509 | -- The refinement lacks constituents. Do not flag | |
510 | -- this case as the error would be misleading. The | |
511 | -- diagnostic is left to the analysis. | |
512 | ||
513 | -- with Refined_State => State | |
514 | ||
515 | else | |
516 | Restore_Scan_State (Scan_State); | |
517 | end if; | |
518 | end; | |
519 | end if; | |
adb252d8 AC |
520 | end if; |
521 | end if; | |
522 | ||
ed323421 | 523 | -- Note if inside Depends or Refined_Depends aspect |
aa3efecd | 524 | |
ed323421 AC |
525 | if A_Id = Aspect_Depends |
526 | or else A_Id = Aspect_Refined_Depends | |
527 | then | |
aa3efecd AC |
528 | Inside_Depends := True; |
529 | end if; | |
530 | ||
0bba838d BD |
531 | -- Note that we have seen an Import aspect specification. |
532 | -- This matters only while parsing a subprogram. | |
533 | ||
534 | if A_Id = Aspect_Import then | |
535 | SIS_Aspect_Import_Seen := True; | |
536 | -- Should do it only for subprograms | |
537 | end if; | |
538 | ||
539 | -- Parse the aspect definition depending on the expected | |
adb252d8 AC |
540 | -- argument kind. |
541 | ||
80e59506 | 542 | if Aspect_Argument (A_Id) = Name |
adb252d8 | 543 | or else Aspect_Argument (A_Id) = Optional_Name |
80e59506 | 544 | then |
473e20df | 545 | Set_Expression (Aspect, P_Name); |
80e59506 | 546 | |
473e20df | 547 | else |
80e59506 AC |
548 | pragma Assert |
549 | (Aspect_Argument (A_Id) = Expression | |
550 | or else | |
551 | Aspect_Argument (A_Id) = Optional_Expression); | |
473e20df AC |
552 | Set_Expression (Aspect, P_Expression); |
553 | end if; | |
aa3efecd AC |
554 | |
555 | -- Unconditionally reset flag for Inside_Depends | |
556 | ||
557 | Inside_Depends := False; | |
473e20df AC |
558 | end if; |
559 | ||
adb252d8 AC |
560 | -- Add the aspect to the resulting list only when it was properly |
561 | -- parsed. | |
473e20df AC |
562 | |
563 | if OK then | |
564 | Append (Aspect, Aspects); | |
565 | end if; | |
9d2a2071 | 566 | end if; |
473e20df | 567 | |
9d2a2071 AC |
568 | -- Merge here after good or bad aspect (we should be at a comma |
569 | -- or a semicolon, but there might be other possible errors). | |
adb252d8 | 570 | |
9d2a2071 | 571 | -- The aspect specification list contains more than one aspect |
473e20df | 572 | |
9d2a2071 AC |
573 | if Token = Tok_Comma then |
574 | Scan; -- past comma | |
575 | goto Continue; | |
473e20df | 576 | |
9d2a2071 AC |
577 | -- Check for a missing comma between two aspects. Emit an error |
578 | -- and proceed to the next aspect. | |
473e20df | 579 | |
9d2a2071 AC |
580 | elsif Token = Tok_Identifier |
581 | and then Get_Aspect_Id (Token_Name) /= No_Aspect | |
582 | then | |
583 | declare | |
584 | Scan_State : Saved_Scan_State; | |
473e20df | 585 | |
9d2a2071 AC |
586 | begin |
587 | Save_Scan_State (Scan_State); | |
588 | Scan; -- past identifier | |
adb252d8 | 589 | |
9d2a2071 AC |
590 | -- Attempt to detect ' or => following a potential aspect |
591 | -- mark. | |
473e20df | 592 | |
9d2a2071 AC |
593 | if Token = Tok_Apostrophe or else Token = Tok_Arrow then |
594 | Restore_Scan_State (Scan_State); | |
595 | Error_Msg_AP -- CODEFIX | |
596 | ("|missing "","""); | |
597 | goto Continue; | |
adb252d8 | 598 | |
9d2a2071 AC |
599 | -- The construct following the current aspect is not an |
600 | -- aspect. | |
601 | ||
602 | else | |
603 | Restore_Scan_State (Scan_State); | |
604 | end if; | |
605 | end; | |
473e20df | 606 | |
9d2a2071 AC |
607 | -- Check for a mistyped semicolon in place of a comma between two |
608 | -- aspects. Emit an error and proceed to the next aspect. | |
473e20df | 609 | |
9d2a2071 AC |
610 | elsif Token = Tok_Semicolon then |
611 | declare | |
612 | Scan_State : Saved_Scan_State; | |
473e20df | 613 | |
9d2a2071 AC |
614 | begin |
615 | Save_Scan_State (Scan_State); | |
616 | Scan; -- past semicolon | |
473e20df | 617 | |
9d2a2071 AC |
618 | if Token = Tok_Identifier |
619 | and then Get_Aspect_Id (Token_Name) /= No_Aspect | |
620 | then | |
621 | Scan; -- past identifier | |
473e20df | 622 | |
596f7139 | 623 | -- Attempt to detect ' or => following potential aspect mark |
adb252d8 | 624 | |
9d2a2071 AC |
625 | if Token = Tok_Apostrophe or else Token = Tok_Arrow then |
626 | Restore_Scan_State (Scan_State); | |
627 | Error_Msg_SC -- CODEFIX | |
628 | ("|"";"" should be "","""); | |
629 | Scan; -- past semicolon | |
630 | goto Continue; | |
473e20df | 631 | end if; |
9d2a2071 | 632 | end if; |
adb252d8 | 633 | |
596f7139 | 634 | -- Construct following the current aspect is not an aspect |
adb252d8 | 635 | |
9d2a2071 AC |
636 | Restore_Scan_State (Scan_State); |
637 | end; | |
638 | end if; | |
473e20df | 639 | |
596f7139 | 640 | -- Require semicolon if caller expects to scan this out |
473e20df | 641 | |
9d2a2071 AC |
642 | if Semicolon then |
643 | T_Semicolon; | |
644 | end if; | |
473e20df | 645 | |
9d2a2071 | 646 | exit; |
473e20df | 647 | |
9d2a2071 AC |
648 | <<Continue>> |
649 | null; | |
473e20df AC |
650 | end loop; |
651 | ||
652 | return Aspects; | |
473e20df AC |
653 | end Get_Aspect_Specifications; |
654 | ||
19235870 RK |
655 | -------------------------------------------- |
656 | -- 13.1 Representation Clause (also I.7) -- | |
657 | -------------------------------------------- | |
658 | ||
659 | -- REPRESENTATION_CLAUSE ::= | |
660 | -- ATTRIBUTE_DEFINITION_CLAUSE | |
661 | -- | ENUMERATION_REPRESENTATION_CLAUSE | |
662 | -- | RECORD_REPRESENTATION_CLAUSE | |
663 | -- | AT_CLAUSE | |
664 | ||
665 | -- ATTRIBUTE_DEFINITION_CLAUSE ::= | |
666 | -- for LOCAL_NAME'ATTRIBUTE_DESIGNATOR use EXPRESSION; | |
667 | -- | for LOCAL_NAME'ATTRIBUTE_DESIGNATOR use NAME; | |
668 | ||
669 | -- Note: in Ada 83, the expression must be a simple expression | |
670 | ||
671 | -- AT_CLAUSE ::= for DIRECT_NAME use at EXPRESSION; | |
672 | ||
673 | -- Note: in Ada 83, the expression must be a simple expression | |
674 | ||
675 | -- ENUMERATION_REPRESENTATION_CLAUSE ::= | |
676 | -- for first_subtype_LOCAL_NAME use ENUMERATION_AGGREGATE; | |
677 | ||
678 | -- ENUMERATION_AGGREGATE ::= ARRAY_AGGREGATE | |
679 | ||
680 | -- RECORD_REPRESENTATION_CLAUSE ::= | |
681 | -- for first_subtype_LOCAL_NAME use | |
682 | -- record [MOD_CLAUSE] | |
683 | -- {COMPONENT_CLAUSE} | |
684 | -- end record; | |
685 | ||
686 | -- Note: for now we allow only a direct name as the local name in the | |
687 | -- above constructs. This probably needs changing later on ??? | |
688 | ||
689 | -- The caller has checked that the initial token is FOR | |
690 | ||
691 | -- Error recovery: cannot raise Error_Resync, if an error occurs, | |
692 | -- the scan is repositioned past the next semicolon. | |
693 | ||
694 | function P_Representation_Clause return Node_Id is | |
695 | For_Loc : Source_Ptr; | |
696 | Name_Node : Node_Id; | |
697 | Prefix_Node : Node_Id; | |
698 | Attr_Name : Name_Id; | |
699 | Identifier_Node : Node_Id; | |
700 | Rep_Clause_Node : Node_Id; | |
701 | Expr_Node : Node_Id; | |
702 | Record_Items : List_Id; | |
703 | ||
704 | begin | |
705 | For_Loc := Token_Ptr; | |
706 | Scan; -- past FOR | |
707 | ||
708 | -- Note that the name in a representation clause is always a simple | |
a90bd866 | 709 | -- name, even in the attribute case, see AI-300 which made this so. |
19235870 | 710 | |
bde58e32 | 711 | Identifier_Node := P_Identifier (C_Use); |
19235870 RK |
712 | |
713 | -- Check case of qualified name to give good error message | |
714 | ||
715 | if Token = Tok_Dot then | |
716 | Error_Msg_SC | |
717 | ("representation clause requires simple name!"); | |
718 | ||
719 | loop | |
720 | exit when Token /= Tok_Dot; | |
721 | Scan; -- past dot | |
722 | Discard_Junk_Node (P_Identifier); | |
723 | end loop; | |
724 | end if; | |
725 | ||
726 | -- Attribute Definition Clause | |
727 | ||
728 | if Token = Tok_Apostrophe then | |
729 | ||
730 | -- Allow local names of the form a'b'.... This enables | |
731 | -- us to parse class-wide streams attributes correctly. | |
732 | ||
733 | Name_Node := Identifier_Node; | |
734 | while Token = Tok_Apostrophe loop | |
735 | ||
736 | Scan; -- past apostrophe | |
737 | ||
738 | Identifier_Node := Token_Node; | |
739 | Attr_Name := No_Name; | |
740 | ||
741 | if Token = Tok_Identifier then | |
742 | Attr_Name := Token_Name; | |
743 | ||
d48f3dca | 744 | -- Note that the parser must complain in case of an internal |
cc6c4d62 | 745 | -- attribute name that comes from source since internal names |
d48f3dca AC |
746 | -- are meant to be used only by the compiler. |
747 | ||
748 | if not Is_Attribute_Name (Attr_Name) | |
c1107fa3 AC |
749 | and then (not Is_Internal_Attribute_Name (Attr_Name) |
750 | or else Comes_From_Source (Token_Node)) | |
d48f3dca | 751 | then |
19235870 RK |
752 | Signal_Bad_Attribute; |
753 | end if; | |
754 | ||
755 | if Style_Check then | |
756 | Style.Check_Attribute_Name (False); | |
757 | end if; | |
758 | ||
759 | -- Here for case of attribute designator is not an identifier | |
760 | ||
761 | else | |
762 | if Token = Tok_Delta then | |
763 | Attr_Name := Name_Delta; | |
764 | ||
765 | elsif Token = Tok_Digits then | |
766 | Attr_Name := Name_Digits; | |
767 | ||
768 | elsif Token = Tok_Access then | |
769 | Attr_Name := Name_Access; | |
770 | ||
771 | else | |
772 | Error_Msg_AP ("attribute designator expected"); | |
773 | raise Error_Resync; | |
774 | end if; | |
775 | ||
776 | if Style_Check then | |
777 | Style.Check_Attribute_Name (True); | |
778 | end if; | |
779 | end if; | |
780 | ||
572f38e4 AC |
781 | -- Here we have an OK attribute scanned, and the corresponding |
782 | -- Attribute identifier node is stored in Ident_Node. | |
19235870 RK |
783 | |
784 | Prefix_Node := Name_Node; | |
785 | Name_Node := New_Node (N_Attribute_Reference, Prev_Token_Ptr); | |
786 | Set_Prefix (Name_Node, Prefix_Node); | |
787 | Set_Attribute_Name (Name_Node, Attr_Name); | |
788 | Scan; | |
572f38e4 AC |
789 | |
790 | -- Check for Address clause which needs to be marked for use in | |
791 | -- optimizing performance of Exp_Util.Following_Address_Clause. | |
792 | ||
793 | if Attr_Name = Name_Address | |
794 | and then Nkind (Prefix_Node) = N_Identifier | |
795 | then | |
a921e83c | 796 | Set_Name_Table_Boolean1 (Chars (Prefix_Node), True); |
572f38e4 | 797 | end if; |
19235870 RK |
798 | end loop; |
799 | ||
800 | Rep_Clause_Node := New_Node (N_Attribute_Definition_Clause, For_Loc); | |
801 | Set_Name (Rep_Clause_Node, Prefix_Node); | |
802 | Set_Chars (Rep_Clause_Node, Attr_Name); | |
803 | T_Use; | |
804 | ||
805 | Expr_Node := P_Expression_No_Right_Paren; | |
806 | Check_Simple_Expression_In_Ada_83 (Expr_Node); | |
807 | Set_Expression (Rep_Clause_Node, Expr_Node); | |
808 | ||
809 | else | |
810 | TF_Use; | |
811 | Rep_Clause_Node := Empty; | |
812 | ||
813 | -- AT follows USE (At Clause) | |
814 | ||
815 | if Token = Tok_At then | |
816 | Scan; -- past AT | |
817 | Rep_Clause_Node := New_Node (N_At_Clause, For_Loc); | |
818 | Set_Identifier (Rep_Clause_Node, Identifier_Node); | |
819 | Expr_Node := P_Expression_No_Right_Paren; | |
820 | Check_Simple_Expression_In_Ada_83 (Expr_Node); | |
821 | Set_Expression (Rep_Clause_Node, Expr_Node); | |
822 | ||
572f38e4 AC |
823 | -- Mark occurrence of address clause (used to optimize performance |
824 | -- of Exp_Util.Following_Address_Clause). | |
825 | ||
a921e83c | 826 | Set_Name_Table_Boolean1 (Chars (Identifier_Node), True); |
572f38e4 | 827 | |
19235870 RK |
828 | -- RECORD follows USE (Record Representation Clause) |
829 | ||
830 | elsif Token = Tok_Record then | |
831 | Record_Items := P_Pragmas_Opt; | |
832 | Rep_Clause_Node := | |
833 | New_Node (N_Record_Representation_Clause, For_Loc); | |
834 | Set_Identifier (Rep_Clause_Node, Identifier_Node); | |
835 | ||
836 | Push_Scope_Stack; | |
0bba838d BD |
837 | Scopes (Scope.Last).Etyp := E_Record; |
838 | Scopes (Scope.Last).Ecol := Start_Column; | |
839 | Scopes (Scope.Last).Sloc := Token_Ptr; | |
19235870 RK |
840 | Scan; -- past RECORD |
841 | Record_Items := P_Pragmas_Opt; | |
842 | ||
843 | -- Possible Mod Clause | |
844 | ||
845 | if Token = Tok_At then | |
846 | Set_Mod_Clause (Rep_Clause_Node, P_Mod_Clause); | |
847 | Set_Pragmas_Before (Mod_Clause (Rep_Clause_Node), Record_Items); | |
848 | Record_Items := P_Pragmas_Opt; | |
849 | end if; | |
850 | ||
851 | if No (Record_Items) then | |
852 | Record_Items := New_List; | |
853 | end if; | |
854 | ||
855 | Set_Component_Clauses (Rep_Clause_Node, Record_Items); | |
856 | ||
857 | -- Loop through component clauses | |
858 | ||
859 | loop | |
860 | if Token not in Token_Class_Name then | |
861 | exit when Check_End; | |
862 | end if; | |
863 | ||
864 | Append (P_Component_Clause, Record_Items); | |
865 | P_Pragmas_Opt (Record_Items); | |
866 | end loop; | |
867 | ||
868 | -- Left paren follows USE (Enumeration Representation Clause) | |
869 | ||
870 | elsif Token = Tok_Left_Paren then | |
871 | Rep_Clause_Node := | |
872 | New_Node (N_Enumeration_Representation_Clause, For_Loc); | |
873 | Set_Identifier (Rep_Clause_Node, Identifier_Node); | |
874 | Set_Array_Aggregate (Rep_Clause_Node, P_Aggregate); | |
875 | ||
876 | -- Some other token follows FOR (invalid representation clause) | |
877 | ||
878 | else | |
879 | Error_Msg_SC ("invalid representation clause"); | |
880 | raise Error_Resync; | |
881 | end if; | |
882 | end if; | |
883 | ||
884 | TF_Semicolon; | |
885 | return Rep_Clause_Node; | |
886 | ||
887 | exception | |
888 | when Error_Resync => | |
889 | Resync_Past_Semicolon; | |
890 | return Error; | |
891 | ||
892 | end P_Representation_Clause; | |
893 | ||
894 | ---------------------- | |
895 | -- 13.1 Local Name -- | |
896 | ---------------------- | |
897 | ||
898 | -- Local name is always parsed by its parent. In the case of its use in | |
899 | -- pragmas, the check for a local name is handled in Par.Prag and allows | |
900 | -- all the possible forms of local name. For the uses in chapter 13, we | |
901 | -- currently only allow a direct name, but this should probably change??? | |
902 | ||
903 | --------------------------- | |
904 | -- 13.1 At Clause (I.7) -- | |
905 | --------------------------- | |
906 | ||
907 | -- Parsed by P_Representation_Clause (13.1) | |
908 | ||
909 | --------------------------------------- | |
910 | -- 13.3 Attribute Definition Clause -- | |
911 | --------------------------------------- | |
912 | ||
913 | -- Parsed by P_Representation_Clause (13.1) | |
914 | ||
308e6f3a RW |
915 | -------------------------------- |
916 | -- 13.1 Aspect Specification -- | |
917 | -------------------------------- | |
0f1a6a0b AC |
918 | |
919 | -- ASPECT_SPECIFICATION ::= | |
1c163178 | 920 | -- with ASPECT_MARK [=> ASPECT_DEFINITION] {, |
0f1a6a0b AC |
921 | -- ASPECT_MARK [=> ASPECT_DEFINITION] } |
922 | ||
923 | -- ASPECT_MARK ::= aspect_IDENTIFIER['Class] | |
924 | ||
925 | -- ASPECT_DEFINITION ::= NAME | EXPRESSION | |
926 | ||
927 | -- Error recovery: cannot raise Error_Resync | |
928 | ||
1c54829e AC |
929 | procedure P_Aspect_Specifications |
930 | (Decl : Node_Id; | |
931 | Semicolon : Boolean := True) | |
932 | is | |
0f1a6a0b | 933 | Aspects : List_Id; |
718deaf1 | 934 | Ptr : Source_Ptr; |
0f1a6a0b AC |
935 | |
936 | begin | |
0f1a6a0b AC |
937 | -- Aspect Specification is present |
938 | ||
718deaf1 | 939 | Ptr := Token_Ptr; |
0f1a6a0b | 940 | |
1c163178 | 941 | -- Here we have an aspect specification to scan, note that we don't |
0f1a6a0b AC |
942 | -- set the flag till later, because it may turn out that we have no |
943 | -- valid aspects in the list. | |
944 | ||
473e20df | 945 | Aspects := Get_Aspect_Specifications (Semicolon); |
0f1a6a0b | 946 | |
9f90d123 | 947 | -- Here if aspects present |
0f1a6a0b AC |
948 | |
949 | if Is_Non_Empty_List (Aspects) then | |
9f90d123 AC |
950 | |
951 | -- If Decl is Empty, we just ignore the aspects (the caller in this | |
952 | -- case has always issued an appropriate error message). | |
953 | ||
954 | if Decl = Empty then | |
955 | null; | |
956 | ||
957 | -- If Decl is Error, we ignore the aspects, and issue a message | |
958 | ||
fa1072e7 GL |
959 | elsif Decl = Error |
960 | or else not Permits_Aspect_Specifications (Decl) | |
961 | then | |
718deaf1 | 962 | Error_Msg ("aspect specifications not allowed here", Ptr); |
9f90d123 AC |
963 | |
964 | -- Here aspects are allowed, and we store them | |
965 | ||
718deaf1 AC |
966 | else |
967 | Set_Parent (Aspects, Decl); | |
968 | Set_Aspect_Specifications (Decl, Aspects); | |
969 | end if; | |
0f1a6a0b AC |
970 | end if; |
971 | end P_Aspect_Specifications; | |
972 | ||
19235870 RK |
973 | --------------------------------------------- |
974 | -- 13.4 Enumeration Representation Clause -- | |
975 | --------------------------------------------- | |
976 | ||
977 | -- Parsed by P_Representation_Clause (13.1) | |
978 | ||
979 | --------------------------------- | |
980 | -- 13.4 Enumeration Aggregate -- | |
981 | --------------------------------- | |
982 | ||
983 | -- Parsed by P_Representation_Clause (13.1) | |
984 | ||
985 | ------------------------------------------ | |
986 | -- 13.5.1 Record Representation Clause -- | |
987 | ------------------------------------------ | |
988 | ||
989 | -- Parsed by P_Representation_Clause (13.1) | |
990 | ||
991 | ------------------------------ | |
992 | -- 13.5.1 Mod Clause (I.8) -- | |
993 | ------------------------------ | |
994 | ||
995 | -- MOD_CLAUSE ::= at mod static_EXPRESSION; | |
996 | ||
997 | -- Note: in Ada 83, the expression must be a simple expression | |
998 | ||
999 | -- The caller has checked that the initial Token is AT | |
1000 | ||
1001 | -- Error recovery: cannot raise Error_Resync | |
1002 | ||
1003 | -- Note: the caller is responsible for setting the Pragmas_Before field | |
1004 | ||
1005 | function P_Mod_Clause return Node_Id is | |
1006 | Mod_Node : Node_Id; | |
1007 | Expr_Node : Node_Id; | |
1008 | ||
1009 | begin | |
1010 | Mod_Node := New_Node (N_Mod_Clause, Token_Ptr); | |
1011 | Scan; -- past AT | |
1012 | T_Mod; | |
1013 | Expr_Node := P_Expression_No_Right_Paren; | |
1014 | Check_Simple_Expression_In_Ada_83 (Expr_Node); | |
1015 | Set_Expression (Mod_Node, Expr_Node); | |
1016 | TF_Semicolon; | |
1017 | return Mod_Node; | |
1018 | end P_Mod_Clause; | |
1019 | ||
1020 | ------------------------------ | |
1021 | -- 13.5.1 Component Clause -- | |
1022 | ------------------------------ | |
1023 | ||
1024 | -- COMPONENT_CLAUSE ::= | |
1025 | -- COMPONENT_CLAUSE_COMPONENT_NAME at POSITION | |
1026 | -- range FIRST_BIT .. LAST_BIT; | |
1027 | ||
1028 | -- COMPONENT_CLAUSE_COMPONENT_NAME ::= | |
1029 | -- component_DIRECT_NAME | |
1030 | -- | component_DIRECT_NAME'ATTRIBUTE_DESIGNATOR | |
1031 | -- | FIRST_SUBTYPE_DIRECT_NAME'ATTRIBUTE_DESIGNATOR | |
1032 | ||
1033 | -- POSITION ::= static_EXPRESSION | |
1034 | ||
1035 | -- Note: in Ada 83, the expression must be a simple expression | |
1036 | ||
1037 | -- FIRST_BIT ::= static_SIMPLE_EXPRESSION | |
1038 | -- LAST_BIT ::= static_SIMPLE_EXPRESSION | |
1039 | ||
1040 | -- Note: the AARM V2.0 grammar has an error at this point, it uses | |
1041 | -- EXPRESSION instead of SIMPLE_EXPRESSION for FIRST_BIT and LAST_BIT | |
1042 | ||
1043 | -- Error recovery: cannot raise Error_Resync | |
1044 | ||
1045 | function P_Component_Clause return Node_Id is | |
1046 | Component_Node : Node_Id; | |
1047 | Comp_Name : Node_Id; | |
1048 | Expr_Node : Node_Id; | |
1049 | ||
1050 | begin | |
1051 | Component_Node := New_Node (N_Component_Clause, Token_Ptr); | |
1052 | Comp_Name := P_Name; | |
1053 | ||
1054 | if Nkind (Comp_Name) = N_Identifier | |
1055 | or else Nkind (Comp_Name) = N_Attribute_Reference | |
1056 | then | |
1057 | Set_Component_Name (Component_Node, Comp_Name); | |
1058 | else | |
1059 | Error_Msg_N | |
1060 | ("component name must be direct name or attribute", Comp_Name); | |
1061 | Set_Component_Name (Component_Node, Error); | |
1062 | end if; | |
1063 | ||
1064 | Set_Sloc (Component_Node, Token_Ptr); | |
1065 | T_At; | |
1066 | Expr_Node := P_Expression_No_Right_Paren; | |
1067 | Check_Simple_Expression_In_Ada_83 (Expr_Node); | |
1068 | Set_Position (Component_Node, Expr_Node); | |
1069 | T_Range; | |
1070 | Expr_Node := P_Expression_No_Right_Paren; | |
1071 | Check_Simple_Expression_In_Ada_83 (Expr_Node); | |
1072 | Set_First_Bit (Component_Node, Expr_Node); | |
1073 | T_Dot_Dot; | |
1074 | Expr_Node := P_Expression_No_Right_Paren; | |
1075 | Check_Simple_Expression_In_Ada_83 (Expr_Node); | |
1076 | Set_Last_Bit (Component_Node, Expr_Node); | |
1077 | TF_Semicolon; | |
1078 | return Component_Node; | |
1079 | end P_Component_Clause; | |
1080 | ||
1081 | ---------------------- | |
1082 | -- 13.5.1 Position -- | |
1083 | ---------------------- | |
1084 | ||
1085 | -- Parsed by P_Component_Clause (13.5.1) | |
1086 | ||
1087 | ----------------------- | |
1088 | -- 13.5.1 First Bit -- | |
1089 | ----------------------- | |
1090 | ||
1091 | -- Parsed by P_Component_Clause (13.5.1) | |
1092 | ||
1093 | ---------------------- | |
1094 | -- 13.5.1 Last Bit -- | |
1095 | ---------------------- | |
1096 | ||
1097 | -- Parsed by P_Component_Clause (13.5.1) | |
1098 | ||
1099 | -------------------------- | |
1100 | -- 13.8 Code Statement -- | |
1101 | -------------------------- | |
1102 | ||
1103 | -- CODE_STATEMENT ::= QUALIFIED_EXPRESSION | |
1104 | ||
1105 | -- On entry the caller has scanned the SUBTYPE_MARK (passed in as the | |
1106 | -- single argument, and the scan points to the apostrophe. | |
1107 | ||
1108 | -- Error recovery: can raise Error_Resync | |
1109 | ||
1110 | function P_Code_Statement (Subtype_Mark : Node_Id) return Node_Id is | |
1111 | Node1 : Node_Id; | |
1112 | ||
1113 | begin | |
1114 | Scan; -- past apostrophe | |
1115 | ||
1116 | -- If left paren, then we have a possible code statement | |
1117 | ||
1118 | if Token = Tok_Left_Paren then | |
1119 | Node1 := New_Node (N_Code_Statement, Sloc (Subtype_Mark)); | |
1120 | Set_Expression (Node1, P_Qualified_Expression (Subtype_Mark)); | |
1121 | TF_Semicolon; | |
1122 | return Node1; | |
1123 | ||
1124 | -- Otherwise we have an illegal range attribute. Note that P_Name | |
1125 | -- ensures that Token = Tok_Range is the only possibility left here. | |
1126 | ||
29ba9f52 | 1127 | else |
19235870 RK |
1128 | Error_Msg_SC ("RANGE attribute illegal here!"); |
1129 | raise Error_Resync; | |
1130 | end if; | |
19235870 RK |
1131 | end P_Code_Statement; |
1132 | ||
1133 | end Ch13; |