diff options
Diffstat (limited to 'gcc/ada/par-ch4.adb')
| -rw-r--r-- | gcc/ada/par-ch4.adb | 53 |
1 files changed, 52 insertions, 1 deletions
diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb index 62c4e108c21..838738c9bd9 100644 --- a/gcc/ada/par-ch4.adb +++ b/gcc/ada/par-ch4.adb @@ -28,6 +28,8 @@ pragma Style_Checks (All_Checks); -- Turn off subprogram body ordering check. Subprograms are in order -- by RM section rather than alphabetical +with Hostparm; use Hostparm; + separate (Par) package body Ch4 is @@ -1116,6 +1118,7 @@ package body Ch4 is -- POSITIONAL_ARRAY_AGGREGATE ::= -- (EXPRESSION, EXPRESSION {, EXPRESSION}) -- | (EXPRESSION {, EXPRESSION}, others => EXPRESSION) + -- | (EXPRESSION {, EXPRESSION}, others => <>) -- NAMED_ARRAY_AGGREGATE ::= -- (ARRAY_COMPONENT_ASSOCIATION {, ARRAY_COMPONENT_ASSOCIATION}) @@ -1124,6 +1127,9 @@ package body Ch4 is -- Error recovery: can raise Error_Resync + -- Note: POSITIONAL_ARRAY_AGGREGATE rule has been extended to give support + -- to Ada0Y limited aggregates (AI-287) + function P_Aggregate_Or_Paren_Expr return Node_Id is Aggregate_Node : Node_Id; Expr_List : List_Id; @@ -1161,6 +1167,20 @@ package body Ch4 is end if; end if; + -- Ada0Y (AI-287): The box notation is allowed only with named + -- notation because positional notation might be error prone. For + -- example, in "(X, <>, Y, <>)", there is no type associated with + -- the boxes, so you might not be leaving out the components you + -- thought you were leaving out. + + if Extensions_Allowed and then Token = Tok_Box then + Error_Msg_SC ("(Ada 0Y) box notation only allowed with " + & "named notation"); + Scan; -- past BOX + Aggregate_Node := New_Node (N_Aggregate, Lparen_Sloc); + return Aggregate_Node; + end if; + Expr_Node := P_Expression_Or_Range_Attribute; -- Extension aggregate case @@ -1354,6 +1374,7 @@ package body Ch4 is -- RECORD_COMPONENT_ASSOCIATION ::= -- [COMPONENT_CHOICE_LIST =>] EXPRESSION + -- | COMPONENT_CHOICE_LIST => <> -- COMPONENT_CHOICE_LIST => -- component_SELECTOR_NAME {| component_SELECTOR_NAME} @@ -1361,6 +1382,7 @@ package body Ch4 is -- ARRAY_COMPONENT_ASSOCIATION ::= -- DISCRETE_CHOICE_LIST => EXPRESSION + -- | DISCRETE_CHOICE_LIST => <> -- Note: this routine only handles the named cases, including others. -- Cases where the component choice list is not present have already @@ -1368,6 +1390,10 @@ package body Ch4 is -- Error recovery: can raise Error_Resync + -- Note: RECORD_COMPONENT_ASSOCIATION and ARRAY_COMPONENT_ASSOCIATION + -- rules have been extended to give support to Ada0Y limited + -- aggregates (AI-287) + function P_Record_Or_Array_Component_Association return Node_Id is Assoc_Node : Node_Id; @@ -1376,7 +1402,32 @@ package body Ch4 is Set_Choices (Assoc_Node, P_Discrete_Choice_List); Set_Sloc (Assoc_Node, Token_Ptr); TF_Arrow; - Set_Expression (Assoc_Node, P_Expression); + + if Token = Tok_Box then + + -- Ada0Y (AI-287): The box notation is used to indicate the default + -- initialization of limited aggregate components + + if not Extensions_Allowed then + Error_Msg_SP + ("(Ada 0Y) limited aggregates are an Ada0X extension"); + + if OpenVMS then + Error_Msg_SP + ("\unit must be compiled with " & + "'/'E'X'T'E'N'S'I'O'N'S'_'A'L'L'O'W'E'D qualifier"); + else + Error_Msg_SP + ("\unit must be compiled with -gnatX switch"); + end if; + end if; + + Set_Box_Present (Assoc_Node); + Scan; -- Past box + else + Set_Expression (Assoc_Node, P_Expression); + end if; + return Assoc_Node; end P_Record_Or_Array_Component_Association; |