diff options
Diffstat (limited to 'gcc/ada/par-ch2.adb')
| -rw-r--r-- | gcc/ada/par-ch2.adb | 90 |
1 files changed, 81 insertions, 9 deletions
diff --git a/gcc/ada/par-ch2.adb b/gcc/ada/par-ch2.adb index 62c6735..37fe454 100644 --- a/gcc/ada/par-ch2.adb +++ b/gcc/ada/par-ch2.adb @@ -40,6 +40,12 @@ package body Ch2 is -- the scanned association has an identifier (this is used to check the -- rule that no associations without identifiers can follow an association -- which has an identifier). The result is returned in Association. + -- + -- Note: We allow attribute forms Pre'Class, Post'Class, Invariant'Class, + -- Type_Invariant'Class in place of a pragma argument identifier. Rather + -- than handle this case specially, we replace such references with + -- one of the special internal identifiers _Pre, _Post, _Invariant, or + -- _Type_Invariant, and this procedure is where this replacement occurs. --------------------- -- 2.3 Identifier -- @@ -448,6 +454,24 @@ package body Ch2 is -- [pragma_argument_IDENTIFIER =>] NAME -- | [pragma_argument_IDENTIFIER =>] EXPRESSION + -- In Ada 2012, there are two more possibilities: + + -- PRAGMA_ARGUMENT_ASSOCIATION ::= + -- [pragma_argument_ASPECT_MARK =>] NAME + -- | [pragma_argument_ASPECT_MARK =>] EXPRESSION + + -- where the interesting allowed cases (which do not fit the syntax of the + -- first alternative above are + + -- ASPECT_MARK ::= + -- Pre'Class | Post'Class | Invariant'Class | Type_Invariant'Class + + -- We allow this special usage in all Ada modes, but it would be a pain to + -- allow these aspects to pervade the pragma syntax, and the representation + -- of pragma nodes internally. So what we do is to replace these + -- ASPECT_MARK forms with identifiers whose name is one of the special + -- internal names _Pre, _Post, _Invariant, or _Type_Invariant. + -- Error recovery: cannot raise Error_Resync procedure Scan_Pragma_Argument_Association @@ -461,6 +485,7 @@ package body Ch2 is begin Association := New_Node (N_Pragma_Argument_Association, Token_Ptr); Set_Chars (Association, No_Name); + Id_Present := False; -- Argument starts with identifier @@ -470,22 +495,69 @@ package body Ch2 is Scan; -- past Identifier if Token = Tok_Arrow then - Identifier_Seen := True; Scan; -- past arrow - Set_Chars (Association, Chars (Identifier_Node)); Id_Present := True; - -- Case of argument with no identifier + -- Case of one of the special aspect forms - else - Restore_Scan_State (Scan_State); -- to Identifier - Id_Present := False; + elsif Token = Tok_Apostrophe then + Scan; -- past apostrophe + + -- We have apostrophe, so check for identifier'Class + + if Token /= Tok_Identifier or else Token_Name /= Name_Class then + null; + + -- We have identifier'Class, check for arrow + + else + Scan; -- Past Class + + if Token /= Tok_Arrow then + null; + + -- Here we have scanned identifier'Class => + + else + Id_Present := True; + Scan; -- past arrow + + case Chars (Identifier_Node) is + when Name_Pre => + Set_Chars (Identifier_Node, Name_uPre); + + when Name_Post => + Set_Chars (Identifier_Node, Name_uPost); + + when Name_Type_Invariant => + Set_Chars (Identifier_Node, Name_uType_Invariant); + + when Name_Invariant => + Set_Chars (Identifier_Node, Name_uInvariant); + + -- If it is X'Class => for some invalid X, we will give + -- an error, and forget that 'Class was present, which + -- will give better error recovery. We could do a spell + -- check here, but it seems too much work. + + when others => + Error_Msg_SC ("invalid aspect id for pragma"); + end case; + end if; + end if; end if; - -- Argument does not start with identifier + -- Identifier was present - else - Id_Present := False; + if Id_Present then + Set_Chars (Association, Chars (Identifier_Node)); + Identifier_Seen := True; + + -- Identifier not present after all + + else + Restore_Scan_State (Scan_State); -- to Identifier + end if; end if; -- Diagnose error of "positional" argument for pragma appearing after |