]>
Commit | Line | Data |
---|---|---|
19235870 RK |
1 | ------------------------------------------------------------------------------ |
2 | -- -- | |
3 | -- GNAT COMPILER COMPONENTS -- | |
4 | -- -- | |
5 | -- P A R . C H 2 -- | |
6 | -- -- | |
7 | -- B o d y -- | |
8 | -- -- | |
1d005acc | 9 | -- Copyright (C) 1992-2019, 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 Ch2 is | |
32 | ||
33 | -- Local functions, used only in this chapter | |
34 | ||
f073e741 | 35 | procedure Scan_Pragma_Argument_Association |
58ba2415 HK |
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 | |
f073e741 | 42 | -- rule that no associations without identifiers can follow an association |
58ba2415 HK |
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. | |
aab45d22 AC |
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. | |
19235870 RK |
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 | ||
bde58e32 | 65 | function P_Identifier (C : Id_Check := None) return Node_Id is |
19235870 RK |
66 | Ident_Node : Node_Id; |
67 | ||
68 | begin | |
69 | -- All set if we do indeed have an identifier | |
70 | ||
885c4871 AC |
71 | -- Code duplication, see Par_Ch3.P_Defining_Identifier??? |
72 | ||
19235870 | 73 | if Token = Tok_Identifier then |
e192a2cd | 74 | Check_Future_Keyword; |
19235870 RK |
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 | ||
bde58e32 | 82 | elsif Is_Reserved_Identifier (C) then |
19235870 RK |
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 | ||
dec55d76 | 117 | -- Handled by scanner as part of numeric literal handing (see 2.4) |
19235870 RK |
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 | ||
b11e8d6f | 175 | -- Handled by the scanner and returned as Tok_Char_Literal |
19235870 RK |
176 | |
177 | ------------------------- | |
178 | -- 2.6 String Literal -- | |
179 | ------------------------- | |
180 | ||
181 | -- STRING LITERAL ::= "{STRING_ELEMENT}" | |
182 | ||
b11e8d6f | 183 | -- Handled by the scanner and returned as Tok_String_Literal |
19235870 RK |
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 | ||
470cd9e9 | 226 | function P_Pragma (Skipping : Boolean := False) return Node_Id is |
07fc65c4 GB |
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 | |
ff7a7e12 | 236 | -- If skipping the pragma, ignore a missing semicolon |
470cd9e9 | 237 | |
ff7a7e12 RD |
238 | if Token /= Tok_Semicolon and then Skipping then |
239 | null; | |
470cd9e9 | 240 | |
ff7a7e12 | 241 | -- Otherwise demand a semicolon |
470cd9e9 | 242 | |
07fc65c4 | 243 | else |
ff7a7e12 | 244 | T_Semicolon; |
07fc65c4 GB |
245 | end if; |
246 | end Skip_Pragma_Semicolon; | |
247 | ||
94d3a18d AC |
248 | -- Local variables |
249 | ||
94d3a18d | 250 | Import_Check_Required : Boolean := False; |
0bba838d | 251 | -- Set True if check of pragma IMPORT or INTERFACE is required |
94d3a18d AC |
252 | |
253 | Arg_Count : Nat := 0; | |
254 | -- Number of argument associations processed | |
255 | ||
256 | Identifier_Seen : Boolean := False; | |
257 | -- Set True if an identifier is encountered for a pragma argument. Used | |
258 | -- to check that there are no more arguments without identifiers. | |
259 | ||
260 | Assoc_Node : Node_Id; | |
261 | Ident_Node : Node_Id; | |
262 | Prag_Name : Name_Id; | |
263 | Prag_Node : Node_Id; | |
264 | Result : Node_Id; | |
265 | Semicolon_Loc : Source_Ptr; | |
266 | ||
07fc65c4 | 267 | -- Start of processing for P_Pragma |
19235870 RK |
268 | |
269 | begin | |
b6e6a4e3 | 270 | Inside_Pragma := True; |
7e5e5cc7 | 271 | Prag_Node := New_Node (N_Pragma, Token_Ptr); |
19235870 | 272 | Scan; -- past PRAGMA |
7e5e5cc7 | 273 | Prag_Name := Token_Name; |
19235870 RK |
274 | |
275 | if Style_Check then | |
276 | Style.Check_Pragma_Name; | |
277 | end if; | |
278 | ||
82c80734 RD |
279 | -- Ada 2005 (AI-284): INTERFACE is a new reserved word but it is |
280 | -- allowed as a pragma name. | |
281 | ||
533e3abc BD |
282 | if Is_Reserved_Keyword (Token) then |
283 | Prag_Name := Keyword_Name (Token); | |
284 | Ident_Node := Make_Identifier (Token_Ptr, Prag_Name); | |
285 | Scan; -- past the keyword | |
82c80734 RD |
286 | else |
287 | Ident_Node := P_Identifier; | |
82c80734 RD |
288 | end if; |
289 | ||
7e5e5cc7 | 290 | Set_Pragma_Identifier (Prag_Node, Ident_Node); |
19235870 RK |
291 | |
292 | -- See if special INTERFACE/IMPORT check is required | |
293 | ||
294 | if SIS_Entry_Active then | |
0bba838d BD |
295 | Import_Check_Required := |
296 | (Prag_Name = Name_Import) or else (Prag_Name = Name_Interface); | |
19235870 | 297 | else |
0bba838d | 298 | Import_Check_Required := False; |
19235870 RK |
299 | end if; |
300 | ||
aa3efecd AC |
301 | -- Set global to indicate if we are within a Depends pragma |
302 | ||
ed323421 AC |
303 | if Chars (Ident_Node) = Name_Depends |
304 | or else Chars (Ident_Node) = Name_Refined_Depends | |
305 | then | |
aa3efecd AC |
306 | Inside_Depends := True; |
307 | end if; | |
308 | ||
19235870 RK |
309 | -- Scan arguments. We assume that arguments are present if there is |
310 | -- a left paren, or if a semicolon is missing and there is another | |
311 | -- token on the same line as the pragma name. | |
312 | ||
313 | if Token = Tok_Left_Paren | |
314 | or else (Token /= Tok_Semicolon | |
aa3efecd | 315 | and then not Token_Is_At_Start_Of_Line) |
19235870 | 316 | then |
7e5e5cc7 | 317 | Set_Pragma_Argument_Associations (Prag_Node, New_List); |
19235870 RK |
318 | T_Left_Paren; |
319 | ||
320 | loop | |
321 | Arg_Count := Arg_Count + 1; | |
58ba2415 HK |
322 | |
323 | Scan_Pragma_Argument_Association | |
324 | (Identifier_Seen => Identifier_Seen, | |
325 | Association => Assoc_Node, | |
326 | Reserved_Words_OK => | |
327 | Nam_In (Prag_Name, Name_Restriction_Warnings, | |
328 | Name_Restrictions)); | |
19235870 | 329 | |
0bba838d | 330 | if Arg_Count = 2 and then Import_Check_Required then |
19235870 RK |
331 | -- Here is where we cancel the SIS active status if this pragma |
332 | -- supplies a body for the currently active subprogram spec. | |
333 | ||
334 | if Nkind (Expression (Assoc_Node)) in N_Direct_Name | |
335 | and then Chars (Expression (Assoc_Node)) = Chars (SIS_Labl) | |
336 | then | |
337 | SIS_Entry_Active := False; | |
338 | end if; | |
339 | end if; | |
340 | ||
7e5e5cc7 | 341 | Append (Assoc_Node, Pragma_Argument_Associations (Prag_Node)); |
19235870 RK |
342 | exit when Token /= Tok_Comma; |
343 | Scan; -- past comma | |
344 | end loop; | |
345 | ||
470cd9e9 RD |
346 | -- If we have := for pragma Debug, it is worth special casing the |
347 | -- error message (it is easy to think of pragma Debug as taking a | |
348 | -- statement, and an assignment statement is the most likely | |
349 | -- candidate for this error) | |
fbf5a39b | 350 | |
7e5e5cc7 | 351 | if Token = Tok_Colon_Equal and then Prag_Name = Name_Debug then |
fbf5a39b AC |
352 | Error_Msg_SC ("argument for pragma Debug must be procedure call"); |
353 | Resync_To_Semicolon; | |
354 | ||
355 | -- Normal case, we expect a right paren here | |
356 | ||
357 | else | |
358 | T_Right_Paren; | |
359 | end if; | |
19235870 RK |
360 | end if; |
361 | ||
362 | Semicolon_Loc := Token_Ptr; | |
363 | ||
b6e6a4e3 AC |
364 | -- Cancel indication of being within a pragma or in particular a Depends |
365 | -- pragma. | |
aa3efecd AC |
366 | |
367 | Inside_Depends := False; | |
94d3a18d | 368 | Inside_Pragma := False; |
aa3efecd | 369 | |
07fc65c4 GB |
370 | -- Now we have two tasks left, we need to scan out the semicolon |
371 | -- following the pragma, and we have to call Par.Prag to process | |
372 | -- the pragma. Normally we do them in this order, however, there | |
373 | -- is one exception namely pragma Style_Checks where we like to | |
374 | -- skip the semicolon after processing the pragma, since that way | |
375 | -- the style checks for the scanning of the semicolon follow the | |
376 | -- settings of the pragma. | |
377 | ||
378 | -- You might think we could just unconditionally do things in | |
379 | -- the opposite order, but there are other pragmas, notably the | |
380 | -- case of pragma Source_File_Name, which assume the semicolon | |
381 | -- is already scanned out. | |
382 | ||
7e5e5cc7 RD |
383 | if Prag_Name = Name_Style_Checks then |
384 | Result := Par.Prag (Prag_Node, Semicolon_Loc); | |
07fc65c4 GB |
385 | Skip_Pragma_Semicolon; |
386 | return Result; | |
19235870 | 387 | else |
07fc65c4 | 388 | Skip_Pragma_Semicolon; |
7e5e5cc7 | 389 | return Par.Prag (Prag_Node, Semicolon_Loc); |
19235870 | 390 | end if; |
94d3a18d | 391 | |
19235870 RK |
392 | exception |
393 | when Error_Resync => | |
394 | Resync_Past_Semicolon; | |
94d3a18d AC |
395 | Inside_Depends := False; |
396 | Inside_Pragma := False; | |
19235870 | 397 | return Error; |
19235870 RK |
398 | end P_Pragma; |
399 | ||
400 | -- This routine is called if a pragma is encountered in an inappropriate | |
401 | -- position, the pragma is scanned out and control returns to continue. | |
402 | ||
403 | -- The caller has checked that the initial token is pragma | |
404 | ||
405 | -- Error recovery: cannot raise Error_Resync | |
406 | ||
407 | procedure P_Pragmas_Misplaced is | |
408 | begin | |
409 | while Token = Tok_Pragma loop | |
410 | Error_Msg_SC ("pragma not allowed here"); | |
470cd9e9 | 411 | Discard_Junk_Node (P_Pragma (Skipping => True)); |
19235870 RK |
412 | end loop; |
413 | end P_Pragmas_Misplaced; | |
414 | ||
415 | -- This function is called to scan out an optional sequence of pragmas. | |
416 | -- If no pragmas are found, then No_List is returned. | |
417 | ||
418 | -- Error recovery: Cannot raise Error_Resync | |
419 | ||
420 | function P_Pragmas_Opt return List_Id is | |
421 | L : List_Id; | |
422 | ||
423 | begin | |
424 | if Token = Tok_Pragma then | |
425 | L := New_List; | |
426 | P_Pragmas_Opt (L); | |
427 | return L; | |
428 | ||
429 | else | |
430 | return No_List; | |
431 | end if; | |
432 | end P_Pragmas_Opt; | |
433 | ||
434 | -- This procedure is called to scan out an optional sequence of pragmas. | |
435 | -- Any pragmas found are appended to the list provided as an argument. | |
436 | ||
437 | -- Error recovery: Cannot raise Error_Resync | |
438 | ||
439 | procedure P_Pragmas_Opt (List : List_Id) is | |
a77152ca | 440 | P : Node_Id; |
19235870 RK |
441 | |
442 | begin | |
443 | while Token = Tok_Pragma loop | |
444 | P := P_Pragma; | |
445 | ||
7e5e5cc7 | 446 | if Nkind (P) /= N_Error |
6e759c2a | 447 | and then Nam_In (Pragma_Name_Unmapped (P), Name_Assert, Name_Debug) |
7e5e5cc7 | 448 | then |
6e759c2a | 449 | Error_Msg_Name_1 := Pragma_Name_Unmapped (P); |
19235870 RK |
450 | Error_Msg_N |
451 | ("pragma% must be in declaration/statement context", P); | |
452 | else | |
453 | Append (P, List); | |
454 | end if; | |
455 | end loop; | |
456 | end P_Pragmas_Opt; | |
457 | ||
458 | -------------------------------------- | |
459 | -- 2.8 Pragma_Argument Association -- | |
460 | -------------------------------------- | |
461 | ||
462 | -- PRAGMA_ARGUMENT_ASSOCIATION ::= | |
463 | -- [pragma_argument_IDENTIFIER =>] NAME | |
464 | -- | [pragma_argument_IDENTIFIER =>] EXPRESSION | |
465 | ||
aab45d22 AC |
466 | -- In Ada 2012, there are two more possibilities: |
467 | ||
468 | -- PRAGMA_ARGUMENT_ASSOCIATION ::= | |
469 | -- [pragma_argument_ASPECT_MARK =>] NAME | |
470 | -- | [pragma_argument_ASPECT_MARK =>] EXPRESSION | |
471 | ||
472 | -- where the interesting allowed cases (which do not fit the syntax of the | |
16d3a853 | 473 | -- first alternative above) are |
aab45d22 AC |
474 | |
475 | -- ASPECT_MARK ::= | |
476 | -- Pre'Class | Post'Class | Invariant'Class | Type_Invariant'Class | |
477 | ||
478 | -- We allow this special usage in all Ada modes, but it would be a pain to | |
479 | -- allow these aspects to pervade the pragma syntax, and the representation | |
480 | -- of pragma nodes internally. So what we do is to replace these | |
481 | -- ASPECT_MARK forms with identifiers whose name is one of the special | |
482 | -- internal names _Pre, _Post, _Invariant, or _Type_Invariant. | |
483 | ||
19235870 RK |
484 | -- Error recovery: cannot raise Error_Resync |
485 | ||
f073e741 | 486 | procedure Scan_Pragma_Argument_Association |
58ba2415 HK |
487 | (Identifier_Seen : in out Boolean; |
488 | Association : out Node_Id; | |
489 | Reserved_Words_OK : Boolean := False) | |
f073e741 | 490 | is |
58ba2415 | 491 | function P_Expression_Or_Reserved_Word return Node_Id; |
533e3abc BD |
492 | -- Parse an expression or, if the token is one of the following reserved |
493 | -- words, construct an identifier with proper Chars field. | |
58ba2415 HK |
494 | -- Access |
495 | -- Delta | |
496 | -- Digits | |
497 | -- Mod | |
498 | -- Range | |
499 | ||
500 | ----------------------------------- | |
501 | -- P_Expression_Or_Reserved_Word -- | |
502 | ----------------------------------- | |
503 | ||
504 | function P_Expression_Or_Reserved_Word return Node_Id is | |
505 | Word : Node_Id; | |
506 | Word_Id : Name_Id; | |
507 | ||
508 | begin | |
509 | Word_Id := No_Name; | |
510 | ||
511 | if Token = Tok_Access then | |
512 | Word_Id := Name_Access; | |
513 | Scan; -- past ACCESS | |
514 | ||
515 | elsif Token = Tok_Delta then | |
516 | Word_Id := Name_Delta; | |
517 | Scan; -- past DELTA | |
518 | ||
519 | elsif Token = Tok_Digits then | |
520 | Word_Id := Name_Digits; | |
521 | Scan; -- past DIGITS | |
522 | ||
523 | elsif Token = Tok_Mod then | |
524 | Word_Id := Name_Mod; | |
525 | Scan; -- past MOD | |
526 | ||
527 | elsif Token = Tok_Range then | |
528 | Word_Id := Name_Range; | |
529 | Scan; -- post RANGE | |
530 | end if; | |
531 | ||
532 | if Word_Id = No_Name then | |
533 | return P_Expression; | |
534 | else | |
535 | Word := New_Node (N_Identifier, Token_Ptr); | |
536 | Set_Chars (Word, Word_Id); | |
537 | return Word; | |
538 | end if; | |
539 | end P_Expression_Or_Reserved_Word; | |
540 | ||
541 | -- Local variables | |
542 | ||
543 | Expression_Node : Node_Id; | |
19235870 | 544 | Identifier_Node : Node_Id; |
58ba2415 HK |
545 | Identifier_OK : Boolean; |
546 | Scan_State : Saved_Scan_State; | |
547 | ||
548 | -- Start of processing for Scan_Pragma_Argument_Association | |
19235870 RK |
549 | |
550 | begin | |
f073e741 RD |
551 | Association := New_Node (N_Pragma_Argument_Association, Token_Ptr); |
552 | Set_Chars (Association, No_Name); | |
58ba2415 | 553 | Identifier_OK := False; |
19235870 | 554 | |
ef7c5692 AC |
555 | -- Argument starts with identifier |
556 | ||
19235870 RK |
557 | if Token = Tok_Identifier then |
558 | Identifier_Node := Token_Node; | |
559 | Save_Scan_State (Scan_State); -- at Identifier | |
560 | Scan; -- past Identifier | |
561 | ||
562 | if Token = Tok_Arrow then | |
563 | Scan; -- past arrow | |
58ba2415 | 564 | Identifier_OK := True; |
f073e741 | 565 | |
aab45d22 | 566 | -- Case of one of the special aspect forms |
f073e741 | 567 | |
aab45d22 AC |
568 | elsif Token = Tok_Apostrophe then |
569 | Scan; -- past apostrophe | |
570 | ||
571 | -- We have apostrophe, so check for identifier'Class | |
572 | ||
573 | if Token /= Tok_Identifier or else Token_Name /= Name_Class then | |
574 | null; | |
575 | ||
576 | -- We have identifier'Class, check for arrow | |
577 | ||
578 | else | |
579 | Scan; -- Past Class | |
580 | ||
581 | if Token /= Tok_Arrow then | |
582 | null; | |
583 | ||
584 | -- Here we have scanned identifier'Class => | |
585 | ||
586 | else | |
58ba2415 | 587 | Identifier_OK := True; |
aab45d22 AC |
588 | Scan; -- past arrow |
589 | ||
590 | case Chars (Identifier_Node) is | |
591 | when Name_Pre => | |
592 | Set_Chars (Identifier_Node, Name_uPre); | |
593 | ||
594 | when Name_Post => | |
595 | Set_Chars (Identifier_Node, Name_uPost); | |
596 | ||
597 | when Name_Type_Invariant => | |
598 | Set_Chars (Identifier_Node, Name_uType_Invariant); | |
599 | ||
600 | when Name_Invariant => | |
601 | Set_Chars (Identifier_Node, Name_uInvariant); | |
602 | ||
603 | -- If it is X'Class => for some invalid X, we will give | |
604 | -- an error, and forget that 'Class was present, which | |
605 | -- will give better error recovery. We could do a spell | |
606 | -- check here, but it seems too much work. | |
607 | ||
608 | when others => | |
609 | Error_Msg_SC ("invalid aspect id for pragma"); | |
610 | end case; | |
611 | end if; | |
612 | end if; | |
19235870 | 613 | end if; |
ef7c5692 | 614 | |
aab45d22 | 615 | -- Identifier was present |
ef7c5692 | 616 | |
58ba2415 | 617 | if Identifier_OK then |
aab45d22 AC |
618 | Set_Chars (Association, Chars (Identifier_Node)); |
619 | Identifier_Seen := True; | |
620 | ||
621 | -- Identifier not present after all | |
622 | ||
623 | else | |
624 | Restore_Scan_State (Scan_State); -- to Identifier | |
625 | end if; | |
ef7c5692 AC |
626 | end if; |
627 | ||
e6a96e55 AC |
628 | -- Diagnose error of "positional" argument for pragma appearing after |
629 | -- a "named" argument (quotes here are because that's not quite accurate | |
630 | -- Ada RM terminology). | |
631 | ||
632 | -- Since older GNAT versions did not generate this error, disable this | |
303fbb20 AC |
633 | -- message in Relaxed_RM_Semantics mode to help legacy code using e.g. |
634 | -- codepeer. | |
913eb73e | 635 | |
58ba2415 HK |
636 | if Identifier_Seen |
637 | and not Identifier_OK | |
638 | and not Relaxed_RM_Semantics | |
639 | then | |
913eb73e AC |
640 | Error_Msg_SC ("|pragma argument identifier required here"); |
641 | Error_Msg_SC ("\since previous argument had identifier (RM 2.8(4))"); | |
19235870 RK |
642 | end if; |
643 | ||
58ba2415 HK |
644 | if Identifier_OK then |
645 | ||
4afcf3a5 | 646 | -- Certain pragmas such as Restriction_Warnings and Restrictions |
58ba2415 HK |
647 | -- allow reserved words to appear as expressions when checking for |
648 | -- prohibited uses of attributes. | |
649 | ||
650 | if Reserved_Words_OK | |
651 | and then Chars (Identifier_Node) = Name_No_Use_Of_Attribute | |
652 | then | |
653 | Expression_Node := P_Expression_Or_Reserved_Word; | |
654 | else | |
655 | Expression_Node := P_Expression; | |
656 | end if; | |
b46be8a2 | 657 | else |
58ba2415 | 658 | Expression_Node := P_Expression_If_OK; |
b46be8a2 | 659 | end if; |
58ba2415 HK |
660 | |
661 | Set_Expression (Association, Expression_Node); | |
f073e741 | 662 | end Scan_Pragma_Argument_Association; |
19235870 RK |
663 | |
664 | end Ch2; |