aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada/par-ch4.adb
diff options
context:
space:
mode:
authorBob Duff <duff@adacore.com>2022-08-17 12:50:42 -0400
committerMarc Poulhiès <poulhies@adacore.com>2022-09-12 10:16:49 +0200
commit272ada7499e6ce8e1a8bd3f82c1cc030a51d074e (patch)
tree24451793bc0d5f11414bed202922dc3440a49392 /gcc/ada/par-ch4.adb
parentdad0ebe674d495a7e032a123d2d60c090729ef2c (diff)
downloadgcc-272ada7499e6ce8e1a8bd3f82c1cc030a51d074e.zip
gcc-272ada7499e6ce8e1a8bd3f82c1cc030a51d074e.tar.gz
gcc-272ada7499e6ce8e1a8bd3f82c1cc030a51d074e.tar.bz2
[Ada] Parser and lexer cleanup
This patch makes various minor cleanup changes to the parser. No change in behavior. gcc/ada/ * par-tchk.adb, par-util.adb, prep.adb, prepcomp.adb, scng.adb: Use "in" instead of chains of "=" connected with "or else". Likewise for "not in", "/=", "and then". Misc cleanup. * par-ch10.adb, par-ch12.adb, par-ch13.adb, par-ch4.adb: Likewise. * par-ch8.adb, par-ch9.adb, par-endh.adb, par-sync.adb: Likewise. * par.adb (Pf_Rec): Remove filler, which was added August 25, 1993 to get around a compiler limitation that no longer exists. Minor cleanup. Remove useless qualfications. * par-ch3.adb: Remove redundant return statements. (Component_Scan_Loop): Remove loop name; there are no nested loops, so it's unnecessary and possibly misleading, and it causes too-long lines. * par-ch5.adb: DRY: Remove comments that repeat the comments in par.adb. (P_Sequence_Of_Statements): It is better to initialize things on the declaration. And constants are better than variables. (Test_Statement_Required): Remove unnecessary insertion of a null statement. * par-ch6.adb, par-ch7.adb: DRY: Remove comments that repeat the comments in par.adb.
Diffstat (limited to 'gcc/ada/par-ch4.adb')
-rw-r--r--gcc/ada/par-ch4.adb824
1 files changed, 407 insertions, 417 deletions
diff --git a/gcc/ada/par-ch4.adb b/gcc/ada/par-ch4.adb
index 9a00d7b..0dc6c8a 100644
--- a/gcc/ada/par-ch4.adb
+++ b/gcc/ada/par-ch4.adb
@@ -225,9 +225,7 @@ package body Ch4 is
-- If it looks like start of expression, complain and scan expression
- if Token in Token_Class_Literal
- or else Token = Tok_Left_Paren
- then
+ if Token in Token_Class_Literal | Tok_Left_Paren then
Error_Msg_SC ("name expected");
return P_Expression;
@@ -303,7 +301,7 @@ package body Ch4 is
-- The treatment for the range attribute is similar (we do not
-- consider x'range to be a name in this grammar).
- elsif Token = Tok_Left_Paren or else Token = Tok_Range then
+ elsif Token in Tok_Left_Paren | Tok_Range then
Restore_Scan_State (Scan_State); -- to apostrophe
Expr_Form := EF_Simple_Name;
return Name_Node;
@@ -334,446 +332,449 @@ package body Ch4 is
<<Scan_Name_Extension>>
- -- Character literal used as name cannot be extended. Also this
- -- cannot be a call, since the name for a call must be a designator.
- -- Return in these cases, or if there is no name extension
+ -- Character literal used as name cannot be extended. Also this
+ -- cannot be a call, since the name for a call must be a designator.
+ -- Return in these cases, or if there is no name extension
- if Token not in Token_Class_Namext
- or else Prev_Token = Tok_Char_Literal
- then
- Expr_Form := EF_Name;
- return Name_Node;
- end if;
+ if Token not in Token_Class_Namext
+ or else Prev_Token = Tok_Char_Literal
+ then
+ Expr_Form := EF_Name;
+ return Name_Node;
+ end if;
-- Merge here when we know there is a name extension
<<Scan_Name_Extension_OK>>
- if Token = Tok_Left_Paren then
+ case Token is
+ when Tok_Left_Paren =>
Scan; -- past left paren
goto Scan_Name_Extension_Left_Paren;
- elsif Token = Tok_Apostrophe then
+ when Tok_Apostrophe =>
Save_Scan_State (Scan_State); -- at apostrophe
Scan; -- past apostrophe
goto Scan_Name_Extension_Apostrophe;
- else -- Token = Tok_Dot
+ when Tok_Dot =>
Save_Scan_State (Scan_State); -- at dot
Scan; -- past dot
goto Scan_Name_Extension_Dot;
- end if;
+
+ when others => raise Program_Error;
+ end case;
-- Case of name extended by dot (selection), dot is already skipped
-- and the scan state at the point of the dot is saved in Scan_State.
<<Scan_Name_Extension_Dot>>
- -- Explicit dereference case
+ -- Explicit dereference case
- if Token = Tok_All then
- Prefix_Node := Name_Node;
- Name_Node := New_Node (N_Explicit_Dereference, Token_Ptr);
- Set_Prefix (Name_Node, Prefix_Node);
- Scan; -- past ALL
- goto Scan_Name_Extension;
+ if Token = Tok_All then
+ Prefix_Node := Name_Node;
+ Name_Node := New_Node (N_Explicit_Dereference, Token_Ptr);
+ Set_Prefix (Name_Node, Prefix_Node);
+ Scan; -- past ALL
+ goto Scan_Name_Extension;
-- Selected component case
- elsif Token in Token_Class_Name then
- Prefix_Node := Name_Node;
- Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
- Set_Prefix (Name_Node, Prefix_Node);
- Set_Selector_Name (Name_Node, Token_Node);
- Scan; -- past selector
- goto Scan_Name_Extension;
+ elsif Token in Token_Class_Name then
+ Prefix_Node := Name_Node;
+ Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
+ Set_Prefix (Name_Node, Prefix_Node);
+ Set_Selector_Name (Name_Node, Token_Node);
+ Scan; -- past selector
+ goto Scan_Name_Extension;
-- Reserved identifier as selector
- elsif Is_Reserved_Identifier then
- Scan_Reserved_Identifier (Force_Msg => False);
- Prefix_Node := Name_Node;
- Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
- Set_Prefix (Name_Node, Prefix_Node);
- Set_Selector_Name (Name_Node, Token_Node);
- Scan; -- past identifier used as selector
- goto Scan_Name_Extension;
+ elsif Is_Reserved_Identifier then
+ Scan_Reserved_Identifier (Force_Msg => False);
+ Prefix_Node := Name_Node;
+ Name_Node := New_Node (N_Selected_Component, Prev_Token_Ptr);
+ Set_Prefix (Name_Node, Prefix_Node);
+ Set_Selector_Name (Name_Node, Token_Node);
+ Scan; -- past identifier used as selector
+ goto Scan_Name_Extension;
-- If dot is at end of line and followed by nothing legal,
-- then assume end of name and quit (dot will be taken as
-- an incorrect form of some other punctuation by our caller).
- elsif Token_Is_At_Start_Of_Line then
- Restore_Scan_State (Scan_State);
- return Name_Node;
+ elsif Token_Is_At_Start_Of_Line then
+ Restore_Scan_State (Scan_State);
+ return Name_Node;
-- Here if nothing legal after the dot
- else
- Error_Msg_AP ("selector expected");
- raise Error_Resync;
- end if;
+ else
+ Error_Msg_AP ("selector expected");
+ raise Error_Resync;
+ end if;
-- Here for an apostrophe as name extension. The scan position at the
-- apostrophe has already been saved, and the apostrophe scanned out.
<<Scan_Name_Extension_Apostrophe>>
- Scan_Apostrophe : declare
- function Apostrophe_Should_Be_Semicolon return Boolean;
- -- Checks for case where apostrophe should probably be
- -- a semicolon, and if so, gives appropriate message,
- -- resets the scan pointer to the apostrophe, changes
- -- the current token to Tok_Semicolon, and returns True.
- -- Otherwise returns False.
-
- ------------------------------------
- -- Apostrophe_Should_Be_Semicolon --
- ------------------------------------
-
- function Apostrophe_Should_Be_Semicolon return Boolean is
- begin
- if Token_Is_At_Start_Of_Line then
- Restore_Scan_State (Scan_State); -- to apostrophe
- Error_Msg_SC ("|""''"" should be "";""");
- Token := Tok_Semicolon;
- return True;
- else
- return False;
- end if;
- end Apostrophe_Should_Be_Semicolon;
+ Scan_Apostrophe : declare
+ function Apostrophe_Should_Be_Semicolon return Boolean;
+ -- Checks for case where apostrophe should probably be
+ -- a semicolon, and if so, gives appropriate message,
+ -- resets the scan pointer to the apostrophe, changes
+ -- the current token to Tok_Semicolon, and returns True.
+ -- Otherwise returns False.
- -- Start of processing for Scan_Apostrophe
+ ------------------------------------
+ -- Apostrophe_Should_Be_Semicolon --
+ ------------------------------------
+ function Apostrophe_Should_Be_Semicolon return Boolean is
begin
- -- Check for qualified expression case in Ada 2012 mode
+ if Token_Is_At_Start_Of_Line then
+ Restore_Scan_State (Scan_State); -- to apostrophe
+ Error_Msg_SC ("|""''"" should be "";""");
+ Token := Tok_Semicolon;
+ return True;
+ else
+ return False;
+ end if;
+ end Apostrophe_Should_Be_Semicolon;
- if Ada_Version >= Ada_2012
- and then Token in Tok_Left_Paren | Tok_Left_Bracket
- then
- Name_Node := P_Qualified_Expression (Name_Node);
- goto Scan_Name_Extension;
+ -- Start of processing for Scan_Apostrophe
- -- If range attribute after apostrophe, then return with Token
- -- pointing to the apostrophe. Note that in this case the prefix
- -- need not be a simple name (cases like A.all'range). Similarly
- -- if there is a left paren after the apostrophe, then we also
- -- return with Token pointing to the apostrophe (this is the
- -- aggregate case, or some error case).
+ begin
+ -- Check for qualified expression case in Ada 2012 mode
- elsif Token = Tok_Range or else Token = Tok_Left_Paren then
- Restore_Scan_State (Scan_State); -- to apostrophe
- Expr_Form := EF_Name;
- return Name_Node;
+ if Ada_Version >= Ada_2012
+ and then Token in Tok_Left_Paren | Tok_Left_Bracket
+ then
+ Name_Node := P_Qualified_Expression (Name_Node);
+ goto Scan_Name_Extension;
- -- Here for cases where attribute designator is an identifier
+ -- If range attribute after apostrophe, then return with Token
+ -- pointing to the apostrophe. Note that in this case the prefix
+ -- need not be a simple name (cases like A.all'range). Similarly
+ -- if there is a left paren after the apostrophe, then we also
+ -- return with Token pointing to the apostrophe (this is the
+ -- aggregate case, or some error case).
- elsif Token = Tok_Identifier then
- Attr_Name := Token_Name;
+ elsif Token in Tok_Range | Tok_Left_Paren then
+ Restore_Scan_State (Scan_State); -- to apostrophe
+ Expr_Form := EF_Name;
+ return Name_Node;
- if not Is_Attribute_Name (Attr_Name) then
- if Apostrophe_Should_Be_Semicolon then
- Expr_Form := EF_Name;
- return Name_Node;
+ -- Here for cases where attribute designator is an identifier
- -- Here for a bad attribute name
+ elsif Token = Tok_Identifier then
+ Attr_Name := Token_Name;
- else
- Signal_Bad_Attribute;
- Scan; -- past bad identifier
+ if not Is_Attribute_Name (Attr_Name) then
+ if Apostrophe_Should_Be_Semicolon then
+ Expr_Form := EF_Name;
+ return Name_Node;
- if Token = Tok_Left_Paren then
- Scan; -- past left paren
+ -- Here for a bad attribute name
- loop
- Discard_Junk_Node (P_Expression_If_OK);
- exit when not Comma_Present;
- end loop;
+ else
+ Signal_Bad_Attribute;
+ Scan; -- past bad identifier
- T_Right_Paren;
- end if;
+ if Token = Tok_Left_Paren then
+ Scan; -- past left paren
- return Error;
+ loop
+ Discard_Junk_Node (P_Expression_If_OK);
+ exit when not Comma_Present;
+ end loop;
+
+ T_Right_Paren;
end if;
- end if;
- if Style_Check then
- Style.Check_Attribute_Name (False);
+ return Error;
end if;
+ end if;
- -- Here for case of attribute designator is not an identifier
+ if Style_Check then
+ Style.Check_Attribute_Name (False);
+ end if;
- else
- if Token = Tok_Delta then
- Attr_Name := Name_Delta;
+ -- Here for case of attribute designator is not an identifier
- elsif Token = Tok_Digits then
- Attr_Name := Name_Digits;
+ else
+ if Token = Tok_Delta then
+ Attr_Name := Name_Delta;
- elsif Token = Tok_Access then
- Attr_Name := Name_Access;
+ elsif Token = Tok_Digits then
+ Attr_Name := Name_Digits;
- elsif Token = Tok_Mod and then Ada_Version >= Ada_95 then
- Attr_Name := Name_Mod;
+ elsif Token = Tok_Access then
+ Attr_Name := Name_Access;
- elsif Apostrophe_Should_Be_Semicolon then
- Expr_Form := EF_Name;
- return Name_Node;
+ elsif Token = Tok_Mod and then Ada_Version >= Ada_95 then
+ Attr_Name := Name_Mod;
- else
- Error_Msg_AP ("attribute designator expected");
- raise Error_Resync;
- end if;
+ elsif Apostrophe_Should_Be_Semicolon then
+ Expr_Form := EF_Name;
+ return Name_Node;
- if Style_Check then
- Style.Check_Attribute_Name (True);
- end if;
+ else
+ Error_Msg_AP ("attribute designator expected");
+ raise Error_Resync;
end if;
- -- We come here with an OK attribute scanned, and corresponding
- -- Attribute identifier node stored in Ident_Node.
+ if Style_Check then
+ Style.Check_Attribute_Name (True);
+ end if;
+ end if;
- Prefix_Node := Name_Node;
- Name_Node := New_Node (N_Attribute_Reference, Prev_Token_Ptr);
- Scan; -- past attribute designator
- Set_Prefix (Name_Node, Prefix_Node);
- Set_Attribute_Name (Name_Node, Attr_Name);
+ -- We come here with an OK attribute scanned, and corresponding
+ -- Attribute identifier node stored in Ident_Node.
- -- Scan attribute arguments/designator. We skip this if we know
- -- that the attribute cannot have an argument (see documentation
- -- of Is_Parameterless_Attribute for further details).
+ Prefix_Node := Name_Node;
+ Name_Node := New_Node (N_Attribute_Reference, Prev_Token_Ptr);
+ Scan; -- past attribute designator
+ Set_Prefix (Name_Node, Prefix_Node);
+ Set_Attribute_Name (Name_Node, Attr_Name);
- if Token = Tok_Left_Paren
- and then not
- Is_Parameterless_Attribute (Get_Attribute_Id (Attr_Name))
- then
- -- Attribute Update contains an array or record association
- -- list which provides new values for various components or
- -- elements. The list is parsed as an aggregate, and we get
- -- better error handling by knowing that in the parser.
+ -- Scan attribute arguments/designator. We skip this if we know
+ -- that the attribute cannot have an argument (see documentation
+ -- of Is_Parameterless_Attribute for further details).
- if Attr_Name = Name_Update then
- Set_Expressions (Name_Node, New_List);
- Append (P_Aggregate, Expressions (Name_Node));
+ if Token = Tok_Left_Paren
+ and then not
+ Is_Parameterless_Attribute (Get_Attribute_Id (Attr_Name))
+ then
+ -- Attribute Update contains an array or record association
+ -- list which provides new values for various components or
+ -- elements. The list is parsed as an aggregate, and we get
+ -- better error handling by knowing that in the parser.
- -- All other cases of parsing attribute arguments
+ if Attr_Name = Name_Update then
+ Set_Expressions (Name_Node, New_List);
+ Append (P_Aggregate, Expressions (Name_Node));
- else
- Set_Expressions (Name_Node, New_List);
- Scan; -- past left paren
-
- loop
- declare
- Expr : constant Node_Id := P_Expression_If_OK;
- Rnam : Node_Id;
-
- begin
- -- Case of => for named notation
-
- if Token = Tok_Arrow then
-
- -- Named notation allowed only for the special
- -- case of System'Restriction_Set (No_Dependence =>
- -- unit_NAME), in which case construct a parameter
- -- assocation node and append to the arguments.
-
- if Attr_Name = Name_Restriction_Set
- and then Nkind (Expr) = N_Identifier
- and then Chars (Expr) = Name_No_Dependence
- then
- Scan; -- past arrow
- Rnam := P_Name;
- 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
- Error_Msg_SC
- ("named parameters not permitted "
- & "for attributes");
- Scan; -- past junk arrow
- end if;
-
- -- Here for normal case (not => for named parameter)
+ -- All other cases of parsing attribute arguments
+
+ else
+ Set_Expressions (Name_Node, New_List);
+ Scan; -- past left paren
+
+ loop
+ declare
+ Expr : constant Node_Id := P_Expression_If_OK;
+ Rnam : Node_Id;
+
+ begin
+ -- Case of => for named notation
+
+ if Token = Tok_Arrow then
+
+ -- Named notation allowed only for the special
+ -- case of System'Restriction_Set (No_Dependence =>
+ -- unit_NAME), in which case construct a parameter
+ -- assocation node and append to the arguments.
+
+ if Attr_Name = Name_Restriction_Set
+ and then Nkind (Expr) = N_Identifier
+ and then Chars (Expr) = Name_No_Dependence
+ then
+ Scan; -- past arrow
+ Rnam := P_Name;
+ 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
- -- Special handling for 'Image in Ada 2012, where
- -- the attribute can be parameterless and its value
- -- can be the prefix of a slice. Rewrite name as a
- -- slice, Expr is its low bound.
-
- if Token = Tok_Dot_Dot
- and then Attr_Name = Name_Image
- and then Ada_Version >= Ada_2012
- then
- Set_Expressions (Name_Node, No_List);
- Prefix_Node := Name_Node;
- Name_Node :=
- New_Node (N_Slice, Sloc (Prefix_Node));
- Set_Prefix (Name_Node, Prefix_Node);
- Range_Node := New_Node (N_Range, Token_Ptr);
- Set_Low_Bound (Range_Node, Expr);
- Scan; -- past ..
- Expr_Node := P_Expression;
- Check_Simple_Expression (Expr_Node);
- Set_High_Bound (Range_Node, Expr_Node);
- Set_Discrete_Range (Name_Node, Range_Node);
- T_Right_Paren;
-
- goto Scan_Name_Extension;
-
- else
- Append (Expr, Expressions (Name_Node));
- exit when not Comma_Present;
- end if;
+ Error_Msg_SC
+ ("named parameters not permitted "
+ & "for attributes");
+ Scan; -- past junk arrow
end if;
- end;
- end loop;
- T_Right_Paren;
- end if;
+ -- Here for normal case (not => for named parameter)
+
+ else
+ -- Special handling for 'Image in Ada 2012, where
+ -- the attribute can be parameterless and its value
+ -- can be the prefix of a slice. Rewrite name as a
+ -- slice, Expr is its low bound.
+
+ if Token = Tok_Dot_Dot
+ and then Attr_Name = Name_Image
+ and then Ada_Version >= Ada_2012
+ then
+ Set_Expressions (Name_Node, No_List);
+ Prefix_Node := Name_Node;
+ Name_Node :=
+ New_Node (N_Slice, Sloc (Prefix_Node));
+ Set_Prefix (Name_Node, Prefix_Node);
+ Range_Node := New_Node (N_Range, Token_Ptr);
+ Set_Low_Bound (Range_Node, Expr);
+ Scan; -- past ..
+ Expr_Node := P_Expression;
+ Check_Simple_Expression (Expr_Node);
+ Set_High_Bound (Range_Node, Expr_Node);
+ Set_Discrete_Range (Name_Node, Range_Node);
+ T_Right_Paren;
+
+ goto Scan_Name_Extension;
+
+ else
+ Append (Expr, Expressions (Name_Node));
+ exit when not Comma_Present;
+ end if;
+ end if;
+ end;
+ end loop;
+
+ T_Right_Paren;
end if;
+ end if;
- goto Scan_Name_Extension;
- end Scan_Apostrophe;
+ goto Scan_Name_Extension;
+ end Scan_Apostrophe;
-- Here for left parenthesis extending name (left paren skipped)
<<Scan_Name_Extension_Left_Paren>>
- -- We now have to scan through a list of items, terminated by a
- -- right parenthesis. The scan is handled by a finite state
- -- machine. The possibilities are:
+ -- We now have to scan through a list of items, terminated by a
+ -- right parenthesis. The scan is handled by a finite state
+ -- machine. The possibilities are:
- -- (discrete_range)
+ -- (discrete_range)
- -- This is a slice. This case is handled in LP_State_Init
+ -- This is a slice. This case is handled in LP_State_Init
- -- (expression, expression, ..)
+ -- (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 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.
- -- Note: if and case expressions (without an extra level of
- -- parentheses) are permitted in this context).
+ -- Note: if and case expressions (without an extra level of
+ -- parentheses) are permitted in this context).
- -- (..., identifier => expression , ...)
+ -- (..., identifier => expression , ...)
- -- If there is at least one occurrence of identifier => (but
- -- none of the other cases apply), then we have a call.
+ -- If there is at least one occurrence of identifier => (but
+ -- none of the other cases apply), then we have a call.
- -- Test for Id => case
+ -- Test for Id => case
- if Token = Tok_Identifier then
- Save_Scan_State (Scan_State); -- at Id
- Scan; -- past Id
+ if Token = Tok_Identifier then
+ Save_Scan_State (Scan_State); -- at Id
+ Scan; -- past Id
- -- Test for => (allow := as an error substitute)
+ -- Test for => (allow := as an error substitute)
- if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
- Restore_Scan_State (Scan_State); -- to Id
- Arg_List := New_List;
- goto LP_State_Call;
+ if Token in Tok_Arrow | Tok_Colon_Equal then
+ Restore_Scan_State (Scan_State); -- to Id
+ Arg_List := New_List;
+ goto LP_State_Call;
- else
- Restore_Scan_State (Scan_State); -- to Id
- end if;
+ else
+ Restore_Scan_State (Scan_State); -- to Id
end if;
+ end if;
- -- Here we have an expression after all
-
- Expr_Node := P_Expression_Or_Range_Attribute_If_OK;
+ -- Here we have an expression after all
- -- Check cases of discrete range for a slice
+ Expr_Node := P_Expression_Or_Range_Attribute_If_OK;
- -- First possibility: Range_Attribute_Reference
+ -- Check cases of discrete range for a slice
- if Expr_Form = EF_Range_Attr then
- Range_Node := Expr_Node;
+ -- First possibility: Range_Attribute_Reference
- -- Second possibility: Simple_expression .. Simple_expression
+ if Expr_Form = EF_Range_Attr then
+ Range_Node := Expr_Node;
- elsif Token = Tok_Dot_Dot then
- Check_Simple_Expression (Expr_Node);
- Range_Node := New_Node (N_Range, Token_Ptr);
- Set_Low_Bound (Range_Node, Expr_Node);
- Scan; -- past ..
- Expr_Node := P_Expression;
- Check_Simple_Expression (Expr_Node);
- Set_High_Bound (Range_Node, Expr_Node);
+ -- Second possibility: Simple_expression .. Simple_expression
- -- Third possibility: Type_name range Range
+ elsif Token = Tok_Dot_Dot then
+ Check_Simple_Expression (Expr_Node);
+ Range_Node := New_Node (N_Range, Token_Ptr);
+ Set_Low_Bound (Range_Node, Expr_Node);
+ Scan; -- past ..
+ Expr_Node := P_Expression;
+ Check_Simple_Expression (Expr_Node);
+ Set_High_Bound (Range_Node, Expr_Node);
- elsif Token = Tok_Range then
- if Expr_Form /= EF_Simple_Name then
- Error_Msg_SC ("subtype mark must precede RANGE");
- raise Error_Resync;
- end if;
+ -- Third possibility: Type_name range Range
- Range_Node := P_Subtype_Indication (Expr_Node);
+ elsif Token = Tok_Range then
+ if Expr_Form /= EF_Simple_Name then
+ Error_Msg_SC ("subtype mark must precede RANGE");
+ raise Error_Resync;
+ end if;
- -- Otherwise we just have an expression. It is true that we might
- -- have a subtype mark without a range constraint but this case
- -- is syntactically indistinguishable from the expression case.
+ Range_Node := P_Subtype_Indication (Expr_Node);
- else
- Arg_List := New_List;
- goto LP_State_Expr;
- end if;
+ -- Otherwise we just have an expression. It is true that we might
+ -- have a subtype mark without a range constraint but this case
+ -- is syntactically indistinguishable from the expression case.
- -- Fall through here with unmistakable Discrete range scanned,
- -- which means that we definitely have the case of a slice. The
- -- Discrete range is in Range_Node.
+ else
+ Arg_List := New_List;
+ goto LP_State_Expr;
+ end if;
- if Token = Tok_Comma then
- Error_Msg_SC ("slice cannot have more than one dimension");
- raise Error_Resync;
+ -- Fall through here with unmistakable Discrete range scanned,
+ -- which means that we definitely have the case of a slice. The
+ -- Discrete range is in Range_Node.
- elsif Token /= Tok_Right_Paren then
- if Token = Tok_Arrow then
+ if Token = Tok_Comma then
+ Error_Msg_SC ("slice cannot have more than one dimension");
+ raise Error_Resync;
- -- This may be an aggregate that is missing a qualification
+ elsif Token /= Tok_Right_Paren then
+ if Token = Tok_Arrow then
- Error_Msg_SC
- ("context of aggregate must be a qualified expression");
- raise Error_Resync;
+ -- This may be an aggregate that is missing a qualification
- else
- T_Right_Paren;
- raise Error_Resync;
- end if;
+ Error_Msg_SC
+ ("context of aggregate must be a qualified expression");
+ raise Error_Resync;
else
- Scan; -- past right paren
- Prefix_Node := Name_Node;
- Name_Node := New_Node (N_Slice, Sloc (Prefix_Node));
- Set_Prefix (Name_Node, Prefix_Node);
- Set_Discrete_Range (Name_Node, Range_Node);
+ T_Right_Paren;
+ raise Error_Resync;
+ end if;
+
+ else
+ Scan; -- past right paren
+ Prefix_Node := Name_Node;
+ Name_Node := New_Node (N_Slice, Sloc (Prefix_Node));
+ Set_Prefix (Name_Node, Prefix_Node);
+ Set_Discrete_Range (Name_Node, Range_Node);
- -- An operator node is legal as a prefix to other names,
- -- but not for a slice.
+ -- An operator node is legal as a prefix to other names,
+ -- but not for a slice.
- if Nkind (Prefix_Node) = N_Operator_Symbol then
- Error_Msg_N ("illegal prefix for slice", Prefix_Node);
- end if;
+ if Nkind (Prefix_Node) = N_Operator_Symbol then
+ Error_Msg_N ("illegal prefix for slice", Prefix_Node);
+ end if;
- -- If we have a name extension, go scan it
+ -- If we have a name extension, go scan it
- if Token in Token_Class_Namext then
- goto Scan_Name_Extension_OK;
+ if Token in Token_Class_Namext then
+ goto Scan_Name_Extension_OK;
- -- Otherwise return (a slice is a name, but is not a call)
+ -- Otherwise return (a slice is a name, but is not a call)
- else
- Expr_Form := EF_Name;
- return Name_Node;
- end if;
+ else
+ Expr_Form := EF_Name;
+ return Name_Node;
end if;
+ end if;
-- In LP_State_Expr, we have scanned one or more expressions, and
-- so we have a call or an indexed component which is a name. On
@@ -781,48 +782,48 @@ package body Ch4 is
-- Arg_List contains the list of expressions encountered so far
<<LP_State_Expr>>
- Append (Expr_Node, Arg_List);
+ Append (Expr_Node, Arg_List);
- if Token = Tok_Arrow then
- Error_Msg
- ("expect identifier in parameter association", Sloc (Expr_Node));
- Scan; -- past arrow
+ if Token = Tok_Arrow then
+ Error_Msg
+ ("expect identifier in parameter association", Sloc (Expr_Node));
+ Scan; -- past arrow
- elsif not Comma_Present then
- T_Right_Paren;
+ elsif not Comma_Present then
+ T_Right_Paren;
- Prefix_Node := Name_Node;
- Name_Node := New_Node (N_Indexed_Component, Sloc (Prefix_Node));
- Set_Prefix (Name_Node, Prefix_Node);
- Set_Expressions (Name_Node, Arg_List);
+ Prefix_Node := Name_Node;
+ Name_Node := New_Node (N_Indexed_Component, Sloc (Prefix_Node));
+ Set_Prefix (Name_Node, Prefix_Node);
+ Set_Expressions (Name_Node, Arg_List);
- goto Scan_Name_Extension;
- end if;
+ goto Scan_Name_Extension;
+ end if;
- -- Comma present (and scanned out), test for identifier => case
- -- Test for identifier => case
+ -- Comma present (and scanned out), test for identifier => case
+ -- Test for identifier => case
- if Token = Tok_Identifier then
- Save_Scan_State (Scan_State); -- at Id
- Scan; -- past Id
+ if Token = Tok_Identifier then
+ Save_Scan_State (Scan_State); -- at Id
+ Scan; -- past Id
- -- Test for => (allow := as error substitute)
+ -- Test for => (allow := as error substitute)
- if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
- Restore_Scan_State (Scan_State); -- to Id
- goto LP_State_Call;
+ if Token in Tok_Arrow | Tok_Colon_Equal then
+ Restore_Scan_State (Scan_State); -- to Id
+ goto LP_State_Call;
- -- Otherwise it's just an expression after all, so backup
+ -- Otherwise it's just an expression after all, so backup
- else
- Restore_Scan_State (Scan_State); -- to Id
- end if;
+ else
+ Restore_Scan_State (Scan_State); -- to Id
end if;
+ end if;
- -- Here we have an expression after all, so stay in this state
+ -- Here we have an expression after all, so stay in this state
- Expr_Node := P_Expression_If_OK;
- goto LP_State_Expr;
+ Expr_Node := P_Expression_If_OK;
+ goto LP_State_Expr;
-- LP_State_Call corresponds to the situation in which at least one
-- instance of Id => Expression has been encountered, so we know that
@@ -832,78 +833,78 @@ package body Ch4 is
<<LP_State_Call>>
- -- Test for case of Id => Expression (named parameter)
+ -- Test for case of Id => Expression (named parameter)
- if Token = Tok_Identifier then
- Save_Scan_State (Scan_State); -- at Id
- Ident_Node := Token_Node;
- Scan; -- past Id
+ if Token = Tok_Identifier then
+ Save_Scan_State (Scan_State); -- at Id
+ Ident_Node := Token_Node;
+ Scan; -- past Id
- -- Deal with => (allow := as incorrect substitute)
+ -- Deal with => (allow := as incorrect substitute)
- if Token = Tok_Arrow or else Token = Tok_Colon_Equal then
- Arg_Node := New_Node (N_Parameter_Association, Prev_Token_Ptr);
- Set_Selector_Name (Arg_Node, Ident_Node);
- T_Arrow;
- Set_Explicit_Actual_Parameter (Arg_Node, P_Expression);
- Append (Arg_Node, Arg_List);
+ if Token in Tok_Arrow | Tok_Colon_Equal then
+ Arg_Node := New_Node (N_Parameter_Association, Prev_Token_Ptr);
+ Set_Selector_Name (Arg_Node, Ident_Node);
+ T_Arrow;
+ Set_Explicit_Actual_Parameter (Arg_Node, P_Expression);
+ Append (Arg_Node, Arg_List);
- -- If a comma follows, go back and scan next entry
+ -- If a comma follows, go back and scan next entry
- if Comma_Present then
- goto LP_State_Call;
+ if Comma_Present then
+ goto LP_State_Call;
- -- Otherwise we have the end of a call
+ -- Otherwise we have the end of a call
- else
- Prefix_Node := Name_Node;
- Name_Node := New_Node (N_Function_Call, Sloc (Prefix_Node));
- Set_Name (Name_Node, Prefix_Node);
- Set_Parameter_Associations (Name_Node, Arg_List);
- T_Right_Paren;
+ else
+ Prefix_Node := Name_Node;
+ Name_Node := New_Node (N_Function_Call, Sloc (Prefix_Node));
+ Set_Name (Name_Node, Prefix_Node);
+ Set_Parameter_Associations (Name_Node, Arg_List);
+ T_Right_Paren;
- if Token in Token_Class_Namext then
- goto Scan_Name_Extension_OK;
+ if Token in Token_Class_Namext then
+ goto Scan_Name_Extension_OK;
- -- This is a case of a call which cannot be a name
+ -- This is a case of a call which cannot be a name
- else
- Expr_Form := EF_Name;
- return Name_Node;
- end if;
+ else
+ Expr_Form := EF_Name;
+ return Name_Node;
end if;
+ end if;
- -- Not named parameter: Id started an expression after all
+ -- Not named parameter: Id started an expression after all
- else
- Restore_Scan_State (Scan_State); -- to Id
- end if;
+ else
+ Restore_Scan_State (Scan_State); -- to Id
end if;
+ end if;
- -- Here if entry did not start with Id => which means that it
- -- is a positional parameter, which is not allowed, since we
- -- have seen at least one named parameter already.
+ -- Here if entry did not start with Id => which means that it
+ -- is a positional parameter, which is not allowed, since we
+ -- have seen at least one named parameter already.
- Error_Msg_SC
- ("positional parameter association " &
- "not allowed after named one");
+ Error_Msg_SC
+ ("positional parameter association " &
+ "not allowed after named one");
- Expr_Node := P_Expression_If_OK;
+ Expr_Node := P_Expression_If_OK;
- -- Leaving the '>' in an association is not unusual, so suggest
- -- a possible fix.
+ -- Leaving the '>' in an association is not unusual, so suggest
+ -- a possible fix.
- if Nkind (Expr_Node) = N_Op_Eq then
- Error_Msg_N ("\maybe `='>` was intended", Expr_Node);
- end if;
+ if Nkind (Expr_Node) = N_Op_Eq then
+ Error_Msg_N ("\maybe `='>` was intended", Expr_Node);
+ end if;
- -- We go back to scanning out expressions, so that we do not get
- -- multiple error messages when several positional parameters
- -- follow a named parameter.
+ -- We go back to scanning out expressions, so that we do not get
+ -- multiple error messages when several positional parameters
+ -- follow a named parameter.
- goto LP_State_Expr;
+ goto LP_State_Expr;
- -- End of treatment for name extensions starting with left paren
+ -- End of treatment for name extensions starting with left paren
-- End of loop through name extensions
@@ -1384,7 +1385,7 @@ package body Ch4 is
begin
Save_Scan_State (Scan_State);
Scan; -- past FOR
- Maybe := Token = Tok_All or else Token = Tok_Some;
+ Maybe := Token in Tok_All | Tok_Some;
Restore_Scan_State (Scan_State); -- to FOR
return Maybe;
end Is_Quantified_Expression;
@@ -1609,11 +1610,8 @@ package body Ch4 is
then
Append_New (Expr_Node, Assoc_List);
- elsif Token = Tok_Comma
- or else Token = Tok_Right_Paren
- or else Token = Tok_Others
- or else Token in Token_Class_Lit_Or_Name
- or else Token = Tok_Semicolon
+ elsif Token in Tok_Comma | Tok_Right_Paren | Tok_Others
+ | Token_Class_Lit_Or_Name | Tok_Semicolon
then
if Present (Assoc_List) then
Error_Msg_BC -- CODEFIX
@@ -1945,7 +1943,7 @@ package body Ch4 is
-- Check for case of errant comma or semicolon
- if Token = Tok_Comma or else Token = Tok_Semicolon then
+ if Token in Tok_Comma | Tok_Semicolon then
declare
Com : constant Boolean := Token = Tok_Comma;
Scan_State : Saved_Scan_State;
@@ -1959,7 +1957,7 @@ package body Ch4 is
-- do not deal with AND/OR because those cases get mixed up
-- with the select alternatives case.
- if Token = Tok_And or else Token = Tok_Or then
+ if Token in Tok_And | Tok_Or then
Logop := P_Logical_Operator;
Restore_Scan_State (Scan_State); -- to comma/semicolon
@@ -2008,11 +2006,7 @@ package body Ch4 is
begin
-- Case of conditional, case or quantified expression
- if Token = Tok_Case
- or else Token = Tok_If
- or else Token = Tok_For
- or else Token = Tok_Declare
- then
+ if Token in Tok_Case | Tok_If | Tok_For | Tok_Declare then
return P_Unparen_Cond_Expr_Etc;
-- Normal case, not case/conditional/quantified expression
@@ -2121,11 +2115,7 @@ package body Ch4 is
begin
-- Case of conditional, case or quantified expression
- if Token = Tok_Case
- or else Token = Tok_If
- or else Token = Tok_For
- or else Token = Tok_Declare
- then
+ if Token in Tok_Case | Tok_If | Tok_For | Tok_Declare then
return P_Unparen_Cond_Expr_Etc;
-- Normal case, not one of the above expression types
@@ -2967,7 +2957,7 @@ package body Ch4 is
Save_Scan_State (Scan_State);
Scan; -- past FOR
- if Token = Tok_All or else Token = Tok_Some then
+ if Token in Tok_All | Tok_Some then
Restore_Scan_State (Scan_State); -- To FOR
Node1 := P_Quantified_Expression;
@@ -3638,7 +3628,7 @@ package body Ch4 is
Save_Scan_State (State);
Scan; -- past semicolon
- if Token = Tok_Else or else Token = Tok_Elsif then
+ if Token in Tok_Else | Tok_Elsif then
Error_Msg_SP -- CODEFIX
("|extra "";"" ignored");
@@ -3837,7 +3827,7 @@ package body Ch4 is
Save_Scan_State (Scan_State);
Scan; -- past FOR
- if Token = Tok_All or else Token = Tok_Some then
+ if Token in Tok_All | Tok_Some then
Restore_Scan_State (Scan_State);
Result := P_Quantified_Expression;