Mercurial > hg > CbC > CbC_gcc
comparison gcc/ada/par-ch2.adb @ 111:04ced10e8804
gcc 7
author | kono |
---|---|
date | Fri, 27 Oct 2017 22:46:09 +0900 |
parents | |
children | 84e7813d76e9 |
comparison
equal
deleted
inserted
replaced
68:561a7518be6b | 111:04ced10e8804 |
---|---|
1 ------------------------------------------------------------------------------ | |
2 -- -- | |
3 -- GNAT COMPILER COMPONENTS -- | |
4 -- -- | |
5 -- P A R . C H 2 -- | |
6 -- -- | |
7 -- B o d y -- | |
8 -- -- | |
9 -- Copyright (C) 1992-2017, Free Software Foundation, Inc. -- | |
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- -- | |
13 -- ware Foundation; either version 3, or (at your option) any later ver- -- | |
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 -- | |
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. -- | |
20 -- -- | |
21 -- GNAT was originally developed by the GNAT team at New York University. -- | |
22 -- Extensive contributions were provided by Ada Core Technologies Inc. -- | |
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 Ch2 is | |
32 | |
33 -- Local functions, used only in this chapter | |
34 | |
35 procedure Scan_Pragma_Argument_Association | |
36 (Identifier_Seen : in out Boolean; | |
37 Association : out Node_Id; | |
38 Reserved_Words_OK : Boolean := False); | |
39 -- Scans out a pragma argument association. Identifier_Seen is True on | |
40 -- entry if a previous association had an identifier, and gets set True | |
41 -- if the scanned association has an identifier (this is used to check the | |
42 -- rule that no associations without identifiers can follow an association | |
43 -- which has an identifier). The result is returned in Association. Flag | |
44 -- For_Pragma_Restrictions should be set when arguments are being parsed | |
45 -- for pragma Restrictions. | |
46 -- | |
47 -- Note: We allow attribute forms Pre'Class, Post'Class, Invariant'Class, | |
48 -- Type_Invariant'Class in place of a pragma argument identifier. Rather | |
49 -- than handle this case specially, we replace such references with | |
50 -- one of the special internal identifiers _Pre, _Post, _Invariant, or | |
51 -- _Type_Invariant, and this procedure is where this replacement occurs. | |
52 | |
53 --------------------- | |
54 -- 2.3 Identifier -- | |
55 --------------------- | |
56 | |
57 -- IDENTIFIER ::= LETTER {[UNDERLINE] LETTER_OR_DIGIT} | |
58 | |
59 -- LETTER_OR_DIGIT ::= IDENTIFIER_LETTER | DIGIT | |
60 | |
61 -- An IDENTIFIER shall not be a reserved word | |
62 | |
63 -- Error recovery: can raise Error_Resync (cannot return Error) | |
64 | |
65 function P_Identifier (C : Id_Check := None) return Node_Id is | |
66 Ident_Node : Node_Id; | |
67 | |
68 begin | |
69 -- All set if we do indeed have an identifier | |
70 | |
71 -- Code duplication, see Par_Ch3.P_Defining_Identifier??? | |
72 | |
73 if Token = Tok_Identifier then | |
74 Check_Future_Keyword; | |
75 Ident_Node := Token_Node; | |
76 Scan; -- past Identifier | |
77 return Ident_Node; | |
78 | |
79 -- If we have a reserved identifier, manufacture an identifier with | |
80 -- a corresponding name after posting an appropriate error message | |
81 | |
82 elsif Is_Reserved_Identifier (C) then | |
83 Scan_Reserved_Identifier (Force_Msg => False); | |
84 Ident_Node := Token_Node; | |
85 Scan; -- past the node | |
86 return Ident_Node; | |
87 | |
88 -- Otherwise we have junk that cannot be interpreted as an identifier | |
89 | |
90 else | |
91 T_Identifier; -- to give message | |
92 raise Error_Resync; | |
93 end if; | |
94 end P_Identifier; | |
95 | |
96 -------------------------- | |
97 -- 2.3 Letter Or Digit -- | |
98 -------------------------- | |
99 | |
100 -- Parsed by P_Identifier (2.3) | |
101 | |
102 -------------------------- | |
103 -- 2.4 Numeric Literal -- | |
104 -------------------------- | |
105 | |
106 -- NUMERIC_LITERAL ::= DECIMAL_LITERAL | BASED_LITERAL | |
107 | |
108 -- Numeric literal is returned by the scanner as either | |
109 -- Tok_Integer_Literal or Tok_Real_Literal | |
110 | |
111 ---------------------------- | |
112 -- 2.4.1 Decimal Literal -- | |
113 ---------------------------- | |
114 | |
115 -- DECIMAL_LITERAL ::= NUMERAL [.NUMERAL] [EXPONENT] | |
116 | |
117 -- Handled by scanner as part of numeric literal handing (see 2.4) | |
118 | |
119 -------------------- | |
120 -- 2.4.1 Numeral -- | |
121 -------------------- | |
122 | |
123 -- NUMERAL ::= DIGIT {[UNDERLINE] DIGIT} | |
124 | |
125 -- Handled by scanner as part of numeric literal handling (see 2.4) | |
126 | |
127 --------------------- | |
128 -- 2.4.1 Exponent -- | |
129 --------------------- | |
130 | |
131 -- EXPONENT ::= E [+] NUMERAL | E - NUMERAL | |
132 | |
133 -- Handled by scanner as part of numeric literal handling (see 2.4) | |
134 | |
135 -------------------------- | |
136 -- 2.4.2 Based Literal -- | |
137 -------------------------- | |
138 | |
139 -- BASED_LITERAL ::= | |
140 -- BASE # BASED_NUMERAL [.BASED_NUMERAL] # [EXPONENT] | |
141 | |
142 -- Handled by scanner as part of numeric literal handling (see 2.4) | |
143 | |
144 ----------------- | |
145 -- 2.4.2 Base -- | |
146 ----------------- | |
147 | |
148 -- BASE ::= NUMERAL | |
149 | |
150 -- Handled by scanner as part of numeric literal handling (see 2.4) | |
151 | |
152 -------------------------- | |
153 -- 2.4.2 Based Numeral -- | |
154 -------------------------- | |
155 | |
156 -- BASED_NUMERAL ::= | |
157 -- EXTENDED_DIGIT {[UNDERLINE] EXTENDED_DIGIT} | |
158 | |
159 -- Handled by scanner as part of numeric literal handling (see 2.4) | |
160 | |
161 --------------------------- | |
162 -- 2.4.2 Extended Digit -- | |
163 --------------------------- | |
164 | |
165 -- EXTENDED_DIGIT ::= DIGIT | A | B | C | D | E | F | |
166 | |
167 -- Handled by scanner as part of numeric literal handling (see 2.4) | |
168 | |
169 ---------------------------- | |
170 -- 2.5 Character Literal -- | |
171 ---------------------------- | |
172 | |
173 -- CHARACTER_LITERAL ::= ' GRAPHIC_CHARACTER ' | |
174 | |
175 -- Handled by the scanner and returned as Tok_Char_Literal | |
176 | |
177 ------------------------- | |
178 -- 2.6 String Literal -- | |
179 ------------------------- | |
180 | |
181 -- STRING LITERAL ::= "{STRING_ELEMENT}" | |
182 | |
183 -- Handled by the scanner and returned as Tok_String_Literal | |
184 -- or if the string looks like an operator as Tok_Operator_Symbol. | |
185 | |
186 ------------------------- | |
187 -- 2.6 String Element -- | |
188 ------------------------- | |
189 | |
190 -- STRING_ELEMENT ::= "" | non-quotation_mark_GRAPHIC_CHARACTER | |
191 | |
192 -- A STRING_ELEMENT is either a pair of quotation marks ("), | |
193 -- or a single GRAPHIC_CHARACTER other than a quotation mark. | |
194 | |
195 -- Handled by scanner as part of string literal handling (see 2.4) | |
196 | |
197 ------------------ | |
198 -- 2.7 Comment -- | |
199 ------------------ | |
200 | |
201 -- A COMMENT starts with two adjacent hyphens and extends up to the | |
202 -- end of the line. A COMMENT may appear on any line of a program. | |
203 | |
204 -- Handled by the scanner which simply skips past encountered comments | |
205 | |
206 ----------------- | |
207 -- 2.8 Pragma -- | |
208 ----------------- | |
209 | |
210 -- PRAGMA ::= pragma IDENTIFIER | |
211 -- [(PRAGMA_ARGUMENT_ASSOCIATION {, PRAGMA_ARGUMENT_ASSOCIATION})]; | |
212 | |
213 -- The caller has checked that the initial token is PRAGMA | |
214 | |
215 -- Error recovery: cannot raise Error_Resync | |
216 | |
217 -- One special piece of processing is needed in this routine. As described | |
218 -- in the section on "Handling semicolon used in place of IS" in module | |
219 -- Parse, the parser detects the case of missing subprogram bodies to | |
220 -- allow recovery from this syntactic error. Pragma INTERFACE (and, for | |
221 -- Ada 95, pragma IMPORT) can appear in place of the body. The parser must | |
222 -- recognize the use of these two pragmas in this context, otherwise it | |
223 -- will think there are missing bodies, and try to change ; to IS, when | |
224 -- in fact the bodies ARE present, supplied by these pragmas. | |
225 | |
226 function P_Pragma (Skipping : Boolean := False) return Node_Id is | |
227 procedure Skip_Pragma_Semicolon; | |
228 -- Skip past semicolon at end of pragma | |
229 | |
230 --------------------------- | |
231 -- Skip_Pragma_Semicolon -- | |
232 --------------------------- | |
233 | |
234 procedure Skip_Pragma_Semicolon is | |
235 begin | |
236 -- If skipping the pragma, ignore a missing semicolon | |
237 | |
238 if Token /= Tok_Semicolon and then Skipping then | |
239 null; | |
240 | |
241 -- Otherwise demand a semicolon | |
242 | |
243 else | |
244 T_Semicolon; | |
245 end if; | |
246 end Skip_Pragma_Semicolon; | |
247 | |
248 -- Local variables | |
249 | |
250 Interface_Check_Required : Boolean := False; | |
251 -- Set True if check of pragma INTERFACE is required | |
252 | |
253 Import_Check_Required : Boolean := False; | |
254 -- Set True if check of pragma IMPORT is required | |
255 | |
256 Arg_Count : Nat := 0; | |
257 -- Number of argument associations processed | |
258 | |
259 Identifier_Seen : Boolean := False; | |
260 -- Set True if an identifier is encountered for a pragma argument. Used | |
261 -- to check that there are no more arguments without identifiers. | |
262 | |
263 Assoc_Node : Node_Id; | |
264 Ident_Node : Node_Id; | |
265 Prag_Name : Name_Id; | |
266 Prag_Node : Node_Id; | |
267 Result : Node_Id; | |
268 Semicolon_Loc : Source_Ptr; | |
269 | |
270 -- Start of processing for P_Pragma | |
271 | |
272 begin | |
273 Inside_Pragma := True; | |
274 Prag_Node := New_Node (N_Pragma, Token_Ptr); | |
275 Scan; -- past PRAGMA | |
276 Prag_Name := Token_Name; | |
277 | |
278 if Style_Check then | |
279 Style.Check_Pragma_Name; | |
280 end if; | |
281 | |
282 -- Ada 2005 (AI-284): INTERFACE is a new reserved word but it is | |
283 -- allowed as a pragma name. | |
284 | |
285 if Is_Reserved_Keyword (Token) then | |
286 Prag_Name := Keyword_Name (Token); | |
287 Ident_Node := Make_Identifier (Token_Ptr, Prag_Name); | |
288 Scan; -- past the keyword | |
289 else | |
290 Ident_Node := P_Identifier; | |
291 end if; | |
292 | |
293 Set_Pragma_Identifier (Prag_Node, Ident_Node); | |
294 | |
295 -- See if special INTERFACE/IMPORT check is required | |
296 | |
297 if SIS_Entry_Active then | |
298 Interface_Check_Required := (Prag_Name = Name_Interface); | |
299 Import_Check_Required := (Prag_Name = Name_Import); | |
300 else | |
301 Interface_Check_Required := False; | |
302 Import_Check_Required := False; | |
303 end if; | |
304 | |
305 -- Set global to indicate if we are within a Depends pragma | |
306 | |
307 if Chars (Ident_Node) = Name_Depends | |
308 or else Chars (Ident_Node) = Name_Refined_Depends | |
309 then | |
310 Inside_Depends := True; | |
311 end if; | |
312 | |
313 -- Scan arguments. We assume that arguments are present if there is | |
314 -- a left paren, or if a semicolon is missing and there is another | |
315 -- token on the same line as the pragma name. | |
316 | |
317 if Token = Tok_Left_Paren | |
318 or else (Token /= Tok_Semicolon | |
319 and then not Token_Is_At_Start_Of_Line) | |
320 then | |
321 Set_Pragma_Argument_Associations (Prag_Node, New_List); | |
322 T_Left_Paren; | |
323 | |
324 loop | |
325 Arg_Count := Arg_Count + 1; | |
326 | |
327 Scan_Pragma_Argument_Association | |
328 (Identifier_Seen => Identifier_Seen, | |
329 Association => Assoc_Node, | |
330 Reserved_Words_OK => | |
331 Nam_In (Prag_Name, Name_Restriction_Warnings, | |
332 Name_Restrictions)); | |
333 | |
334 if Arg_Count = 2 | |
335 and then (Interface_Check_Required or else Import_Check_Required) | |
336 then | |
337 -- Here is where we cancel the SIS active status if this pragma | |
338 -- supplies a body for the currently active subprogram spec. | |
339 | |
340 if Nkind (Expression (Assoc_Node)) in N_Direct_Name | |
341 and then Chars (Expression (Assoc_Node)) = Chars (SIS_Labl) | |
342 then | |
343 SIS_Entry_Active := False; | |
344 end if; | |
345 end if; | |
346 | |
347 Append (Assoc_Node, Pragma_Argument_Associations (Prag_Node)); | |
348 exit when Token /= Tok_Comma; | |
349 Scan; -- past comma | |
350 end loop; | |
351 | |
352 -- If we have := for pragma Debug, it is worth special casing the | |
353 -- error message (it is easy to think of pragma Debug as taking a | |
354 -- statement, and an assignment statement is the most likely | |
355 -- candidate for this error) | |
356 | |
357 if Token = Tok_Colon_Equal and then Prag_Name = Name_Debug then | |
358 Error_Msg_SC ("argument for pragma Debug must be procedure call"); | |
359 Resync_To_Semicolon; | |
360 | |
361 -- Normal case, we expect a right paren here | |
362 | |
363 else | |
364 T_Right_Paren; | |
365 end if; | |
366 end if; | |
367 | |
368 Semicolon_Loc := Token_Ptr; | |
369 | |
370 -- Cancel indication of being within a pragma or in particular a Depends | |
371 -- pragma. | |
372 | |
373 Inside_Depends := False; | |
374 Inside_Pragma := False; | |
375 | |
376 -- Now we have two tasks left, we need to scan out the semicolon | |
377 -- following the pragma, and we have to call Par.Prag to process | |
378 -- the pragma. Normally we do them in this order, however, there | |
379 -- is one exception namely pragma Style_Checks where we like to | |
380 -- skip the semicolon after processing the pragma, since that way | |
381 -- the style checks for the scanning of the semicolon follow the | |
382 -- settings of the pragma. | |
383 | |
384 -- You might think we could just unconditionally do things in | |
385 -- the opposite order, but there are other pragmas, notably the | |
386 -- case of pragma Source_File_Name, which assume the semicolon | |
387 -- is already scanned out. | |
388 | |
389 if Prag_Name = Name_Style_Checks then | |
390 Result := Par.Prag (Prag_Node, Semicolon_Loc); | |
391 Skip_Pragma_Semicolon; | |
392 return Result; | |
393 else | |
394 Skip_Pragma_Semicolon; | |
395 return Par.Prag (Prag_Node, Semicolon_Loc); | |
396 end if; | |
397 | |
398 exception | |
399 when Error_Resync => | |
400 Resync_Past_Semicolon; | |
401 Inside_Depends := False; | |
402 Inside_Pragma := False; | |
403 return Error; | |
404 end P_Pragma; | |
405 | |
406 -- This routine is called if a pragma is encountered in an inappropriate | |
407 -- position, the pragma is scanned out and control returns to continue. | |
408 | |
409 -- The caller has checked that the initial token is pragma | |
410 | |
411 -- Error recovery: cannot raise Error_Resync | |
412 | |
413 procedure P_Pragmas_Misplaced is | |
414 begin | |
415 while Token = Tok_Pragma loop | |
416 Error_Msg_SC ("pragma not allowed here"); | |
417 Discard_Junk_Node (P_Pragma (Skipping => True)); | |
418 end loop; | |
419 end P_Pragmas_Misplaced; | |
420 | |
421 -- This function is called to scan out an optional sequence of pragmas. | |
422 -- If no pragmas are found, then No_List is returned. | |
423 | |
424 -- Error recovery: Cannot raise Error_Resync | |
425 | |
426 function P_Pragmas_Opt return List_Id is | |
427 L : List_Id; | |
428 | |
429 begin | |
430 if Token = Tok_Pragma then | |
431 L := New_List; | |
432 P_Pragmas_Opt (L); | |
433 return L; | |
434 | |
435 else | |
436 return No_List; | |
437 end if; | |
438 end P_Pragmas_Opt; | |
439 | |
440 -- This procedure is called to scan out an optional sequence of pragmas. | |
441 -- Any pragmas found are appended to the list provided as an argument. | |
442 | |
443 -- Error recovery: Cannot raise Error_Resync | |
444 | |
445 procedure P_Pragmas_Opt (List : List_Id) is | |
446 P : Node_Id; | |
447 | |
448 begin | |
449 while Token = Tok_Pragma loop | |
450 P := P_Pragma; | |
451 | |
452 if Nkind (P) /= N_Error | |
453 and then Nam_In (Pragma_Name_Unmapped (P), Name_Assert, Name_Debug) | |
454 then | |
455 Error_Msg_Name_1 := Pragma_Name_Unmapped (P); | |
456 Error_Msg_N | |
457 ("pragma% must be in declaration/statement context", P); | |
458 else | |
459 Append (P, List); | |
460 end if; | |
461 end loop; | |
462 end P_Pragmas_Opt; | |
463 | |
464 -------------------------------------- | |
465 -- 2.8 Pragma_Argument Association -- | |
466 -------------------------------------- | |
467 | |
468 -- PRAGMA_ARGUMENT_ASSOCIATION ::= | |
469 -- [pragma_argument_IDENTIFIER =>] NAME | |
470 -- | [pragma_argument_IDENTIFIER =>] EXPRESSION | |
471 | |
472 -- In Ada 2012, there are two more possibilities: | |
473 | |
474 -- PRAGMA_ARGUMENT_ASSOCIATION ::= | |
475 -- [pragma_argument_ASPECT_MARK =>] NAME | |
476 -- | [pragma_argument_ASPECT_MARK =>] EXPRESSION | |
477 | |
478 -- where the interesting allowed cases (which do not fit the syntax of the | |
479 -- first alternative above) are | |
480 | |
481 -- ASPECT_MARK ::= | |
482 -- Pre'Class | Post'Class | Invariant'Class | Type_Invariant'Class | |
483 | |
484 -- We allow this special usage in all Ada modes, but it would be a pain to | |
485 -- allow these aspects to pervade the pragma syntax, and the representation | |
486 -- of pragma nodes internally. So what we do is to replace these | |
487 -- ASPECT_MARK forms with identifiers whose name is one of the special | |
488 -- internal names _Pre, _Post, _Invariant, or _Type_Invariant. | |
489 | |
490 -- Error recovery: cannot raise Error_Resync | |
491 | |
492 procedure Scan_Pragma_Argument_Association | |
493 (Identifier_Seen : in out Boolean; | |
494 Association : out Node_Id; | |
495 Reserved_Words_OK : Boolean := False) | |
496 is | |
497 function P_Expression_Or_Reserved_Word return Node_Id; | |
498 -- Parse an expression or, if the token is one of the following reserved | |
499 -- words, construct an identifier with proper Chars field. | |
500 -- Access | |
501 -- Delta | |
502 -- Digits | |
503 -- Mod | |
504 -- Range | |
505 | |
506 ----------------------------------- | |
507 -- P_Expression_Or_Reserved_Word -- | |
508 ----------------------------------- | |
509 | |
510 function P_Expression_Or_Reserved_Word return Node_Id is | |
511 Word : Node_Id; | |
512 Word_Id : Name_Id; | |
513 | |
514 begin | |
515 Word_Id := No_Name; | |
516 | |
517 if Token = Tok_Access then | |
518 Word_Id := Name_Access; | |
519 Scan; -- past ACCESS | |
520 | |
521 elsif Token = Tok_Delta then | |
522 Word_Id := Name_Delta; | |
523 Scan; -- past DELTA | |
524 | |
525 elsif Token = Tok_Digits then | |
526 Word_Id := Name_Digits; | |
527 Scan; -- past DIGITS | |
528 | |
529 elsif Token = Tok_Mod then | |
530 Word_Id := Name_Mod; | |
531 Scan; -- past MOD | |
532 | |
533 elsif Token = Tok_Range then | |
534 Word_Id := Name_Range; | |
535 Scan; -- post RANGE | |
536 end if; | |
537 | |
538 if Word_Id = No_Name then | |
539 return P_Expression; | |
540 else | |
541 Word := New_Node (N_Identifier, Token_Ptr); | |
542 Set_Chars (Word, Word_Id); | |
543 return Word; | |
544 end if; | |
545 end P_Expression_Or_Reserved_Word; | |
546 | |
547 -- Local variables | |
548 | |
549 Expression_Node : Node_Id; | |
550 Identifier_Node : Node_Id; | |
551 Identifier_OK : Boolean; | |
552 Scan_State : Saved_Scan_State; | |
553 | |
554 -- Start of processing for Scan_Pragma_Argument_Association | |
555 | |
556 begin | |
557 Association := New_Node (N_Pragma_Argument_Association, Token_Ptr); | |
558 Set_Chars (Association, No_Name); | |
559 Identifier_OK := False; | |
560 | |
561 -- Argument starts with identifier | |
562 | |
563 if Token = Tok_Identifier then | |
564 Identifier_Node := Token_Node; | |
565 Save_Scan_State (Scan_State); -- at Identifier | |
566 Scan; -- past Identifier | |
567 | |
568 if Token = Tok_Arrow then | |
569 Scan; -- past arrow | |
570 Identifier_OK := True; | |
571 | |
572 -- Case of one of the special aspect forms | |
573 | |
574 elsif Token = Tok_Apostrophe then | |
575 Scan; -- past apostrophe | |
576 | |
577 -- We have apostrophe, so check for identifier'Class | |
578 | |
579 if Token /= Tok_Identifier or else Token_Name /= Name_Class then | |
580 null; | |
581 | |
582 -- We have identifier'Class, check for arrow | |
583 | |
584 else | |
585 Scan; -- Past Class | |
586 | |
587 if Token /= Tok_Arrow then | |
588 null; | |
589 | |
590 -- Here we have scanned identifier'Class => | |
591 | |
592 else | |
593 Identifier_OK := True; | |
594 Scan; -- past arrow | |
595 | |
596 case Chars (Identifier_Node) is | |
597 when Name_Pre => | |
598 Set_Chars (Identifier_Node, Name_uPre); | |
599 | |
600 when Name_Post => | |
601 Set_Chars (Identifier_Node, Name_uPost); | |
602 | |
603 when Name_Type_Invariant => | |
604 Set_Chars (Identifier_Node, Name_uType_Invariant); | |
605 | |
606 when Name_Invariant => | |
607 Set_Chars (Identifier_Node, Name_uInvariant); | |
608 | |
609 -- If it is X'Class => for some invalid X, we will give | |
610 -- an error, and forget that 'Class was present, which | |
611 -- will give better error recovery. We could do a spell | |
612 -- check here, but it seems too much work. | |
613 | |
614 when others => | |
615 Error_Msg_SC ("invalid aspect id for pragma"); | |
616 end case; | |
617 end if; | |
618 end if; | |
619 end if; | |
620 | |
621 -- Identifier was present | |
622 | |
623 if Identifier_OK then | |
624 Set_Chars (Association, Chars (Identifier_Node)); | |
625 Identifier_Seen := True; | |
626 | |
627 -- Identifier not present after all | |
628 | |
629 else | |
630 Restore_Scan_State (Scan_State); -- to Identifier | |
631 end if; | |
632 end if; | |
633 | |
634 -- Diagnose error of "positional" argument for pragma appearing after | |
635 -- a "named" argument (quotes here are because that's not quite accurate | |
636 -- Ada RM terminology). | |
637 | |
638 -- Since older GNAT versions did not generate this error, disable this | |
639 -- message in Relaxed_RM_Semantics mode to help legacy code using e.g. | |
640 -- codepeer. | |
641 | |
642 if Identifier_Seen | |
643 and not Identifier_OK | |
644 and not Relaxed_RM_Semantics | |
645 then | |
646 Error_Msg_SC ("|pragma argument identifier required here"); | |
647 Error_Msg_SC ("\since previous argument had identifier (RM 2.8(4))"); | |
648 end if; | |
649 | |
650 if Identifier_OK then | |
651 | |
652 -- Certain pragmas such as Restriction_Warnings and Restrictions | |
653 -- allow reserved words to appear as expressions when checking for | |
654 -- prohibited uses of attributes. | |
655 | |
656 if Reserved_Words_OK | |
657 and then Chars (Identifier_Node) = Name_No_Use_Of_Attribute | |
658 then | |
659 Expression_Node := P_Expression_Or_Reserved_Word; | |
660 else | |
661 Expression_Node := P_Expression; | |
662 end if; | |
663 else | |
664 Expression_Node := P_Expression_If_OK; | |
665 end if; | |
666 | |
667 Set_Expression (Association, Expression_Node); | |
668 end Scan_Pragma_Argument_Association; | |
669 | |
670 end Ch2; |