Merge from mainline (167278:168000).
[official-gcc/graphite-test-results.git] / gcc / ada / par-ch13.adb
blob9cb40fc2470b853c3b383cec4f2a378b9bdd7785
1 ------------------------------------------------------------------------------
2 -- --
3 -- GNAT COMPILER COMPONENTS --
4 -- --
5 -- P A R . C H 1 3 --
6 -- --
7 -- B o d y --
8 -- --
9 -- Copyright (C) 1992-2010, 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 ------------------------------------------------------------------------------
26 pragma Style_Checks (All_Checks);
27 -- Turn off subprogram body ordering check. Subprograms are in order
28 -- by RM section rather than alphabetical
30 separate (Par)
31 package body Ch13 is
33 -- Local functions, used only in this chapter
35 function P_Component_Clause return Node_Id;
36 function P_Mod_Clause return Node_Id;
38 -----------------------------------
39 -- Aspect_Specifications_Present --
40 -----------------------------------
42 function Aspect_Specifications_Present
43 (Strict : Boolean := Ada_Version < Ada_2012) return Boolean
45 Scan_State : Saved_Scan_State;
46 Result : Boolean;
48 begin
49 Save_Scan_State (Scan_State);
51 -- If we have a semicolon, test for semicolon followed by Aspect
52 -- Specifications, in which case we decide the semicolon is accidental.
54 if Token = Tok_Semicolon then
55 Scan; -- past semicolon
57 -- The recursive test is set Strict, since we already have one
58 -- error (the unexpected semicolon), so we will ignore that semicolon
59 -- only if we absolutely definitely have an aspect specification
60 -- following it.
62 if Aspect_Specifications_Present (Strict => True) then
63 Error_Msg_SP ("|extra "";"" ignored");
64 return True;
66 else
67 Restore_Scan_State (Scan_State);
68 return False;
69 end if;
70 end if;
72 -- Definitely must have WITH to consider aspect specs to be present
74 if Token /= Tok_With then
75 return False;
76 end if;
78 -- Have a WITH, see if it looks like an aspect specification
80 Save_Scan_State (Scan_State);
81 Scan; -- past WITH
83 -- If no identifier, then consider that we definitely do not have an
84 -- aspect specification.
86 if Token /= Tok_Identifier then
87 Result := False;
89 -- This is where we pay attention to the Strict mode. Normally when we
90 -- are in Ada 2012 mode, Strict is False, and we consider that we have
91 -- an aspect specification if the identifier is an aspect name (even if
92 -- not followed by =>) or the identifier is not an aspect name but is
93 -- followed by =>. P_Aspect_Specifications will generate messages if the
94 -- aspect specification is ill-formed.
96 elsif not Strict then
97 if Get_Aspect_Id (Token_Name) /= No_Aspect then
98 Result := True;
99 else
100 Scan; -- past identifier
101 Result := Token = Tok_Arrow;
102 end if;
104 -- If earlier than Ada 2012, check for valid aspect identifier followed
105 -- by an arrow, and consider that this is still an aspect specification
106 -- so we give an appropriate message.
108 else
109 if Get_Aspect_Id (Token_Name) = No_Aspect then
110 Result := False;
112 else
113 Scan; -- past aspect name
115 if Token /= Tok_Arrow then
116 Result := False;
118 else
119 Restore_Scan_State (Scan_State);
120 Error_Msg_SC ("|aspect specification is an Ada 2012 feature");
121 Error_Msg_SC ("\|unit must be compiled with -gnat2012 switch");
122 return True;
123 end if;
124 end if;
125 end if;
127 Restore_Scan_State (Scan_State);
128 return Result;
129 end Aspect_Specifications_Present;
131 --------------------------------------------
132 -- 13.1 Representation Clause (also I.7) --
133 --------------------------------------------
135 -- REPRESENTATION_CLAUSE ::=
136 -- ATTRIBUTE_DEFINITION_CLAUSE
137 -- | ENUMERATION_REPRESENTATION_CLAUSE
138 -- | RECORD_REPRESENTATION_CLAUSE
139 -- | AT_CLAUSE
141 -- ATTRIBUTE_DEFINITION_CLAUSE ::=
142 -- for LOCAL_NAME'ATTRIBUTE_DESIGNATOR use EXPRESSION;
143 -- | for LOCAL_NAME'ATTRIBUTE_DESIGNATOR use NAME;
145 -- Note: in Ada 83, the expression must be a simple expression
147 -- AT_CLAUSE ::= for DIRECT_NAME use at EXPRESSION;
149 -- Note: in Ada 83, the expression must be a simple expression
151 -- ENUMERATION_REPRESENTATION_CLAUSE ::=
152 -- for first_subtype_LOCAL_NAME use ENUMERATION_AGGREGATE;
154 -- ENUMERATION_AGGREGATE ::= ARRAY_AGGREGATE
156 -- RECORD_REPRESENTATION_CLAUSE ::=
157 -- for first_subtype_LOCAL_NAME use
158 -- record [MOD_CLAUSE]
159 -- {COMPONENT_CLAUSE}
160 -- end record;
162 -- Note: for now we allow only a direct name as the local name in the
163 -- above constructs. This probably needs changing later on ???
165 -- The caller has checked that the initial token is FOR
167 -- Error recovery: cannot raise Error_Resync, if an error occurs,
168 -- the scan is repositioned past the next semicolon.
170 function P_Representation_Clause return Node_Id is
171 For_Loc : Source_Ptr;
172 Name_Node : Node_Id;
173 Prefix_Node : Node_Id;
174 Attr_Name : Name_Id;
175 Identifier_Node : Node_Id;
176 Rep_Clause_Node : Node_Id;
177 Expr_Node : Node_Id;
178 Record_Items : List_Id;
180 begin
181 For_Loc := Token_Ptr;
182 Scan; -- past FOR
184 -- Note that the name in a representation clause is always a simple
185 -- name, even in the attribute case, see AI-300 which made this so!
187 Identifier_Node := P_Identifier (C_Use);
189 -- Check case of qualified name to give good error message
191 if Token = Tok_Dot then
192 Error_Msg_SC
193 ("representation clause requires simple name!");
195 loop
196 exit when Token /= Tok_Dot;
197 Scan; -- past dot
198 Discard_Junk_Node (P_Identifier);
199 end loop;
200 end if;
202 -- Attribute Definition Clause
204 if Token = Tok_Apostrophe then
206 -- Allow local names of the form a'b'.... This enables
207 -- us to parse class-wide streams attributes correctly.
209 Name_Node := Identifier_Node;
210 while Token = Tok_Apostrophe loop
212 Scan; -- past apostrophe
214 Identifier_Node := Token_Node;
215 Attr_Name := No_Name;
217 if Token = Tok_Identifier then
218 Attr_Name := Token_Name;
220 if not Is_Attribute_Name (Attr_Name) then
221 Signal_Bad_Attribute;
222 end if;
224 if Style_Check then
225 Style.Check_Attribute_Name (False);
226 end if;
228 -- Here for case of attribute designator is not an identifier
230 else
231 if Token = Tok_Delta then
232 Attr_Name := Name_Delta;
234 elsif Token = Tok_Digits then
235 Attr_Name := Name_Digits;
237 elsif Token = Tok_Access then
238 Attr_Name := Name_Access;
240 else
241 Error_Msg_AP ("attribute designator expected");
242 raise Error_Resync;
243 end if;
245 if Style_Check then
246 Style.Check_Attribute_Name (True);
247 end if;
248 end if;
250 -- We come here with an OK attribute scanned, and the
251 -- corresponding Attribute identifier node stored in Ident_Node.
253 Prefix_Node := Name_Node;
254 Name_Node := New_Node (N_Attribute_Reference, Prev_Token_Ptr);
255 Set_Prefix (Name_Node, Prefix_Node);
256 Set_Attribute_Name (Name_Node, Attr_Name);
257 Scan;
258 end loop;
260 Rep_Clause_Node := New_Node (N_Attribute_Definition_Clause, For_Loc);
261 Set_Name (Rep_Clause_Node, Prefix_Node);
262 Set_Chars (Rep_Clause_Node, Attr_Name);
263 T_Use;
265 Expr_Node := P_Expression_No_Right_Paren;
266 Check_Simple_Expression_In_Ada_83 (Expr_Node);
267 Set_Expression (Rep_Clause_Node, Expr_Node);
269 else
270 TF_Use;
271 Rep_Clause_Node := Empty;
273 -- AT follows USE (At Clause)
275 if Token = Tok_At then
276 Scan; -- past AT
277 Rep_Clause_Node := New_Node (N_At_Clause, For_Loc);
278 Set_Identifier (Rep_Clause_Node, Identifier_Node);
279 Expr_Node := P_Expression_No_Right_Paren;
280 Check_Simple_Expression_In_Ada_83 (Expr_Node);
281 Set_Expression (Rep_Clause_Node, Expr_Node);
283 -- RECORD follows USE (Record Representation Clause)
285 elsif Token = Tok_Record then
286 Record_Items := P_Pragmas_Opt;
287 Rep_Clause_Node :=
288 New_Node (N_Record_Representation_Clause, For_Loc);
289 Set_Identifier (Rep_Clause_Node, Identifier_Node);
291 Push_Scope_Stack;
292 Scope.Table (Scope.Last).Etyp := E_Record;
293 Scope.Table (Scope.Last).Ecol := Start_Column;
294 Scope.Table (Scope.Last).Sloc := Token_Ptr;
295 Scan; -- past RECORD
296 Record_Items := P_Pragmas_Opt;
298 -- Possible Mod Clause
300 if Token = Tok_At then
301 Set_Mod_Clause (Rep_Clause_Node, P_Mod_Clause);
302 Set_Pragmas_Before (Mod_Clause (Rep_Clause_Node), Record_Items);
303 Record_Items := P_Pragmas_Opt;
304 end if;
306 if No (Record_Items) then
307 Record_Items := New_List;
308 end if;
310 Set_Component_Clauses (Rep_Clause_Node, Record_Items);
312 -- Loop through component clauses
314 loop
315 if Token not in Token_Class_Name then
316 exit when Check_End;
317 end if;
319 Append (P_Component_Clause, Record_Items);
320 P_Pragmas_Opt (Record_Items);
321 end loop;
323 -- Left paren follows USE (Enumeration Representation Clause)
325 elsif Token = Tok_Left_Paren then
326 Rep_Clause_Node :=
327 New_Node (N_Enumeration_Representation_Clause, For_Loc);
328 Set_Identifier (Rep_Clause_Node, Identifier_Node);
329 Set_Array_Aggregate (Rep_Clause_Node, P_Aggregate);
331 -- Some other token follows FOR (invalid representation clause)
333 else
334 Error_Msg_SC ("invalid representation clause");
335 raise Error_Resync;
336 end if;
337 end if;
339 TF_Semicolon;
340 return Rep_Clause_Node;
342 exception
343 when Error_Resync =>
344 Resync_Past_Semicolon;
345 return Error;
347 end P_Representation_Clause;
349 ----------------------
350 -- 13.1 Local Name --
351 ----------------------
353 -- Local name is always parsed by its parent. In the case of its use in
354 -- pragmas, the check for a local name is handled in Par.Prag and allows
355 -- all the possible forms of local name. For the uses in chapter 13, we
356 -- currently only allow a direct name, but this should probably change???
358 ---------------------------
359 -- 13.1 At Clause (I.7) --
360 ---------------------------
362 -- Parsed by P_Representation_Clause (13.1)
364 ---------------------------------------
365 -- 13.3 Attribute Definition Clause --
366 ---------------------------------------
368 -- Parsed by P_Representation_Clause (13.1)
370 ------------------------------
371 -- 13.1 Aspect Specifation --
372 ------------------------------
374 -- ASPECT_SPECIFICATION ::=
375 -- with ASPECT_MARK [=> ASPECT_DEFINITION] {.
376 -- ASPECT_MARK [=> ASPECT_DEFINITION] }
378 -- ASPECT_MARK ::= aspect_IDENTIFIER['Class]
380 -- ASPECT_DEFINITION ::= NAME | EXPRESSION
382 -- Error recovery: cannot raise Error_Resync
384 procedure P_Aspect_Specifications (Decl : Node_Id) is
385 Aspects : List_Id;
386 Aspect : Node_Id;
387 A_Id : Aspect_Id;
388 OK : Boolean;
389 Ptr : Source_Ptr;
391 begin
392 -- Check if aspect specification present
394 if not Aspect_Specifications_Present then
395 TF_Semicolon;
396 return;
397 end if;
399 -- Aspect Specification is present
401 Ptr := Token_Ptr;
402 Scan; -- past WITH
404 -- Here we have an aspect specification to scan, note that we don;t
405 -- set the flag till later, because it may turn out that we have no
406 -- valid aspects in the list.
408 Aspects := Empty_List;
409 loop
410 OK := True;
412 if Token /= Tok_Identifier then
413 Error_Msg_SC ("aspect identifier expected");
414 Resync_Past_Semicolon;
415 return;
416 end if;
418 -- We have an identifier (which should be an aspect identifier)
420 A_Id := Get_Aspect_Id (Token_Name);
421 Aspect :=
422 Make_Aspect_Specification (Token_Ptr,
423 Identifier => Token_Node);
425 -- No valid aspect identifier present
427 if A_Id = No_Aspect then
428 Error_Msg_SC ("aspect identifier expected");
430 if Token = Tok_Apostrophe then
431 Scan; -- past '
432 Scan; -- past presumably CLASS
433 end if;
435 if Token = Tok_Arrow then
436 Scan; -- Past arrow
437 Set_Expression (Aspect, P_Expression);
438 OK := False;
440 elsif Token = Tok_Comma then
441 OK := False;
443 else
444 Resync_Past_Semicolon;
445 return;
446 end if;
448 -- OK aspect scanned
450 else
451 Scan; -- past identifier
453 -- Check for 'Class present
455 if Token = Tok_Apostrophe then
456 if not Class_Aspect_OK (A_Id) then
457 Error_Msg_Node_1 := Identifier (Aspect);
458 Error_Msg_SC ("aspect& does not permit attribute here");
459 Scan; -- past apostophe
460 Scan; -- past presumed CLASS
461 OK := False;
463 else
464 Scan; -- past apostrophe
466 if Token /= Tok_Identifier
467 or else Token_Name /= Name_Class
468 then
469 Error_Msg_SC ("Class attribute expected here");
470 OK := False;
472 if Token = Tok_Identifier then
473 Scan; -- past identifier not CLASS
474 end if;
476 else
477 Scan; -- past CLASS
478 Set_Class_Present (Aspect);
479 end if;
480 end if;
481 end if;
483 -- Test case of missing aspect definition
485 if Token = Tok_Comma or else Token = Tok_Semicolon then
486 if Aspect_Argument (A_Id) /= Optional then
487 Error_Msg_Node_1 := Aspect;
488 Error_Msg_AP ("aspect& requires an aspect definition");
489 OK := False;
490 end if;
492 -- Here we have an aspect definition
494 else
495 if Token = Tok_Arrow then
496 Scan; -- past arrow
497 else
498 T_Arrow;
499 OK := False;
500 end if;
502 if Aspect_Argument (A_Id) = Name then
503 Set_Expression (Aspect, P_Name);
504 else
505 Set_Expression (Aspect, P_Expression);
506 end if;
507 end if;
509 -- If OK clause scanned, add it to the list
511 if OK then
512 Append (Aspect, Aspects);
513 end if;
515 if Token = Tok_Comma then
516 Scan; -- past comma
517 else
518 T_Semicolon;
519 exit;
520 end if;
521 end if;
522 end loop;
524 -- If aspects scanned, store them
526 if Is_Non_Empty_List (Aspects) then
527 if Decl = Error then
528 Error_Msg ("aspect specifications not allowed here", Ptr);
529 else
530 Set_Parent (Aspects, Decl);
531 Set_Aspect_Specifications (Decl, Aspects);
532 end if;
533 end if;
534 end P_Aspect_Specifications;
536 ---------------------------------------------
537 -- 13.4 Enumeration Representation Clause --
538 ---------------------------------------------
540 -- Parsed by P_Representation_Clause (13.1)
542 ---------------------------------
543 -- 13.4 Enumeration Aggregate --
544 ---------------------------------
546 -- Parsed by P_Representation_Clause (13.1)
548 ------------------------------------------
549 -- 13.5.1 Record Representation Clause --
550 ------------------------------------------
552 -- Parsed by P_Representation_Clause (13.1)
554 ------------------------------
555 -- 13.5.1 Mod Clause (I.8) --
556 ------------------------------
558 -- MOD_CLAUSE ::= at mod static_EXPRESSION;
560 -- Note: in Ada 83, the expression must be a simple expression
562 -- The caller has checked that the initial Token is AT
564 -- Error recovery: cannot raise Error_Resync
566 -- Note: the caller is responsible for setting the Pragmas_Before field
568 function P_Mod_Clause return Node_Id is
569 Mod_Node : Node_Id;
570 Expr_Node : Node_Id;
572 begin
573 Mod_Node := New_Node (N_Mod_Clause, Token_Ptr);
574 Scan; -- past AT
575 T_Mod;
576 Expr_Node := P_Expression_No_Right_Paren;
577 Check_Simple_Expression_In_Ada_83 (Expr_Node);
578 Set_Expression (Mod_Node, Expr_Node);
579 TF_Semicolon;
580 return Mod_Node;
581 end P_Mod_Clause;
583 ------------------------------
584 -- 13.5.1 Component Clause --
585 ------------------------------
587 -- COMPONENT_CLAUSE ::=
588 -- COMPONENT_CLAUSE_COMPONENT_NAME at POSITION
589 -- range FIRST_BIT .. LAST_BIT;
591 -- COMPONENT_CLAUSE_COMPONENT_NAME ::=
592 -- component_DIRECT_NAME
593 -- | component_DIRECT_NAME'ATTRIBUTE_DESIGNATOR
594 -- | FIRST_SUBTYPE_DIRECT_NAME'ATTRIBUTE_DESIGNATOR
596 -- POSITION ::= static_EXPRESSION
598 -- Note: in Ada 83, the expression must be a simple expression
600 -- FIRST_BIT ::= static_SIMPLE_EXPRESSION
601 -- LAST_BIT ::= static_SIMPLE_EXPRESSION
603 -- Note: the AARM V2.0 grammar has an error at this point, it uses
604 -- EXPRESSION instead of SIMPLE_EXPRESSION for FIRST_BIT and LAST_BIT
606 -- Error recovery: cannot raise Error_Resync
608 function P_Component_Clause return Node_Id is
609 Component_Node : Node_Id;
610 Comp_Name : Node_Id;
611 Expr_Node : Node_Id;
613 begin
614 Component_Node := New_Node (N_Component_Clause, Token_Ptr);
615 Comp_Name := P_Name;
617 if Nkind (Comp_Name) = N_Identifier
618 or else Nkind (Comp_Name) = N_Attribute_Reference
619 then
620 Set_Component_Name (Component_Node, Comp_Name);
621 else
622 Error_Msg_N
623 ("component name must be direct name or attribute", Comp_Name);
624 Set_Component_Name (Component_Node, Error);
625 end if;
627 Set_Sloc (Component_Node, Token_Ptr);
628 T_At;
629 Expr_Node := P_Expression_No_Right_Paren;
630 Check_Simple_Expression_In_Ada_83 (Expr_Node);
631 Set_Position (Component_Node, Expr_Node);
632 T_Range;
633 Expr_Node := P_Expression_No_Right_Paren;
634 Check_Simple_Expression_In_Ada_83 (Expr_Node);
635 Set_First_Bit (Component_Node, Expr_Node);
636 T_Dot_Dot;
637 Expr_Node := P_Expression_No_Right_Paren;
638 Check_Simple_Expression_In_Ada_83 (Expr_Node);
639 Set_Last_Bit (Component_Node, Expr_Node);
640 TF_Semicolon;
641 return Component_Node;
642 end P_Component_Clause;
644 ----------------------
645 -- 13.5.1 Position --
646 ----------------------
648 -- Parsed by P_Component_Clause (13.5.1)
650 -----------------------
651 -- 13.5.1 First Bit --
652 -----------------------
654 -- Parsed by P_Component_Clause (13.5.1)
656 ----------------------
657 -- 13.5.1 Last Bit --
658 ----------------------
660 -- Parsed by P_Component_Clause (13.5.1)
662 --------------------------
663 -- 13.8 Code Statement --
664 --------------------------
666 -- CODE_STATEMENT ::= QUALIFIED_EXPRESSION
668 -- On entry the caller has scanned the SUBTYPE_MARK (passed in as the
669 -- single argument, and the scan points to the apostrophe.
671 -- Error recovery: can raise Error_Resync
673 function P_Code_Statement (Subtype_Mark : Node_Id) return Node_Id is
674 Node1 : Node_Id;
676 begin
677 Scan; -- past apostrophe
679 -- If left paren, then we have a possible code statement
681 if Token = Tok_Left_Paren then
682 Node1 := New_Node (N_Code_Statement, Sloc (Subtype_Mark));
683 Set_Expression (Node1, P_Qualified_Expression (Subtype_Mark));
684 TF_Semicolon;
685 return Node1;
687 -- Otherwise we have an illegal range attribute. Note that P_Name
688 -- ensures that Token = Tok_Range is the only possibility left here.
690 else -- Token = Tok_Range
691 Error_Msg_SC ("RANGE attribute illegal here!");
692 raise Error_Resync;
693 end if;
695 end P_Code_Statement;
697 end Ch13;