diff options
Diffstat (limited to 'gcc/ada/par-ch4.adb')
| -rw-r--r-- | gcc/ada/par-ch4.adb | 195 |
1 files changed, 58 insertions, 137 deletions
diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb index ca02f1b..ebdc587 100644 --- a/gcc/ada/par-ch4.adb +++ b/gcc/ada/par-ch4.adb @@ -592,6 +592,20 @@ package body Ch4 is Explicit_Actual_Parameter => Rnam)); exit; + -- 'Make is a special attribute that takes a variable + -- amount of parameters. + + elsif All_Extensions_Allowed + and then Attr_Name = Name_Make + then + Scan; + Rnam := P_Expression; + Append_To (Expressions (Name_Node), + Make_Parameter_Association (Sloc (Rnam), + Selector_Name => Expr, + Explicit_Actual_Parameter => Rnam)); + exit; + -- For all other cases named notation is illegal else @@ -654,13 +668,13 @@ package body Ch4 is -- (discrete_range) - -- This is a slice. This case is handled in LP_State_Init + -- This is a slice -- (expression, expression, ..) -- This is interpreted as an indexed component, i.e. as a -- case of a name which can be extended in the normal manner. - -- This case is handled by LP_State_Name or LP_State_Expr. + -- This case is handled by LP_State_Expr. -- Note: if and case expressions (without an extra level of -- parentheses) are permitted in this context). @@ -921,129 +935,9 @@ package body Ch4 is -- Error recovery: cannot raise Error_Resync - function P_Function_Name return Node_Id is - Designator_Node : Node_Id; - Prefix_Node : Node_Id; - Selector_Node : Node_Id; - Dot_Sloc : Source_Ptr := No_Location; - - begin - -- Prefix_Node is set to the gathered prefix so far, Empty means that - -- no prefix has been scanned. This allows us to build up the result - -- in the required right recursive manner. - - Prefix_Node := Empty; - - -- Loop through prefixes - - loop - Designator_Node := Token_Node; - - if Token not in Token_Class_Desig then - return P_Identifier; -- let P_Identifier issue the error message - - else -- Token in Token_Class_Desig - Scan; -- past designator - exit when Token /= Tok_Dot; - end if; - - -- Here at a dot, with token just before it in Designator_Node - - if No (Prefix_Node) then - Prefix_Node := Designator_Node; - else - Selector_Node := New_Node (N_Selected_Component, Dot_Sloc); - Set_Prefix (Selector_Node, Prefix_Node); - Set_Selector_Name (Selector_Node, Designator_Node); - Prefix_Node := Selector_Node; - end if; - - Dot_Sloc := Token_Ptr; - Scan; -- past dot - end loop; - - -- Fall out of the loop having just scanned a designator - - if No (Prefix_Node) then - return Designator_Node; - else - Selector_Node := New_Node (N_Selected_Component, Dot_Sloc); - Set_Prefix (Selector_Node, Prefix_Node); - Set_Selector_Name (Selector_Node, Designator_Node); - return Selector_Node; - end if; - - exception - when Error_Resync => - return Error; - end P_Function_Name; - - -- This function parses a restricted form of Names which are either - -- identifiers, or identifiers preceded by a sequence of prefixes - -- that are direct names. - - -- Error recovery: cannot raise Error_Resync - function P_Qualified_Simple_Name return Node_Id is - Designator_Node : Node_Id; - Prefix_Node : Node_Id; - Selector_Node : Node_Id; - Dot_Sloc : Source_Ptr := No_Location; - begin - -- Prefix node is set to the gathered prefix so far, Empty means that - -- no prefix has been scanned. This allows us to build up the result - -- in the required right recursive manner. - - Prefix_Node := Empty; - - -- Loop through prefixes - - loop - Designator_Node := Token_Node; - - if Token = Tok_Identifier then - Scan; -- past identifier - exit when Token /= Tok_Dot; - - elsif Token not in Token_Class_Desig then - return P_Identifier; -- let P_Identifier issue the error message - - else - Scan; -- past designator - - if Token /= Tok_Dot then - Error_Msg_SP ("identifier expected"); - return Error; - end if; - end if; - - -- Here at a dot, with token just before it in Designator_Node - - if No (Prefix_Node) then - Prefix_Node := Designator_Node; - else - Selector_Node := New_Node (N_Selected_Component, Dot_Sloc); - Set_Prefix (Selector_Node, Prefix_Node); - Set_Selector_Name (Selector_Node, Designator_Node); - Prefix_Node := Selector_Node; - end if; - - Dot_Sloc := Token_Ptr; - Scan; -- past dot - end loop; - - -- Fall out of the loop having just scanned an identifier - - if No (Prefix_Node) then - return Designator_Node; - else - Selector_Node := New_Node (N_Selected_Component, Dot_Sloc); - Set_Prefix (Selector_Node, Prefix_Node); - Set_Selector_Name (Selector_Node, Designator_Node); - return Selector_Node; - end if; - + return P_Qualified_Simple_Name_Resync; exception when Error_Resync => return Error; @@ -1062,6 +956,10 @@ package body Ch4 is Dot_Sloc : Source_Ptr := No_Location; begin + -- Prefix_Node is set to the gathered prefix so far, Empty means that + -- no prefix has been scanned. This allows us to build up the result + -- in the required right recursive manner. + Prefix_Node := Empty; -- Loop through prefixes @@ -1069,21 +967,13 @@ package body Ch4 is loop Designator_Node := Token_Node; - if Token = Tok_Identifier then - Scan; -- past identifier - exit when Token /= Tok_Dot; - - elsif Token not in Token_Class_Desig then + if Token not in Token_Class_Desig then Discard_Junk_Node (P_Identifier); -- to issue the error message raise Error_Resync; else Scan; -- past designator - - if Token /= Tok_Dot then - Error_Msg_SP ("identifier expected"); - raise Error_Resync; - end if; + exit when Token /= Tok_Dot; end if; -- Here at a dot, with token just before it in Designator_Node @@ -1098,7 +988,7 @@ package body Ch4 is end if; Dot_Sloc := Token_Ptr; - Scan; -- past period + Scan; -- past dot end loop; -- Fall out of the loop having just scanned an identifier @@ -1593,8 +1483,13 @@ package body Ch4 is -- Improper use of WITH elsif Token = Tok_With then - Error_Msg_SC ("WITH must be preceded by single expression in " & - "extension aggregate"); + if Inside_Abstract_State then + Error_Msg_SC ("state name with options must be enclosed in " & + "parentheses"); + else + Error_Msg_SC ("WITH must be preceded by single expression in " & + "extension aggregate"); + end if; raise Error_Resync; -- Range attribute can only appear as part of a discrete choice list @@ -3473,8 +3368,9 @@ package body Ch4 is function P_Allocator return Node_Id is Alloc_Node : Node_Id; - Type_Node : Node_Id; Null_Exclusion_Present : Boolean; + Scan_State : Saved_Scan_State; + Type_Node : Node_Id; begin Alloc_Node := New_Node (N_Allocator, Token_Ptr); @@ -3496,6 +3392,31 @@ package body Ch4 is Null_Exclusion_Present := P_Null_Exclusion; Set_Null_Exclusion_Present (Alloc_Node, Null_Exclusion_Present); + + -- Check for 'Make + + if All_Extensions_Allowed + and then Token = Tok_Identifier + then + Save_Scan_State (Scan_State); + Type_Node := P_Qualified_Simple_Name_Resync; + if Token = Tok_Apostrophe then + Scan; + if Token_Name = Name_Make then + Restore_Scan_State (Scan_State); + Set_Expression + (Alloc_Node, + Make_Qualified_Expression (Token_Ptr, + Subtype_Mark => Check_Subtype_Mark (Type_Node), + Expression => P_Expression_Or_Range_Attribute)); + return Alloc_Node; + end if; + end if; + Restore_Scan_State (Scan_State); + end if; + + -- Otherwise continue parsing the subtype + Type_Node := P_Subtype_Mark_Resync; if Token = Tok_Apostrophe then |