This patch fixes a bug in the compiler whereby the experimental "return
when" feature was not supported for return values which were not
identifiers.
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
* par-ch6.adb (Get_Return_Kind): Removed.
(Is_Extended): Created to identify simple and "when" return
statements from extended return statements.
(P_Return_Statement): Merged simple and "when" return statement
processing.diff --git a/gcc/ada/par-ch6.adb b/gcc/ada/par-ch6.adb
--- a/gcc/ada/par-ch6.adb
+++ b/gcc/ada/par-ch6.adb
@@ -1874,48 +1874,38 @@ package body Ch6 is
function P_Return_Statement return Node_Id is
-- The caller has checked that the initial token is RETURN
- type Return_Kind is (Simple_Return, Extended_Return, Return_When);
-
- function Get_Return_Kind return Return_Kind;
+ function Is_Extended return Boolean;
-- Scan state is just after RETURN (and is left that way). Determine
-- whether this is a simple or extended return statement by looking
-- ahead for "identifier :", which implies extended.
- ---------------------
- -- Get_Return_Kind --
- ---------------------
+ -----------------
+ -- Is_Extended --
+ -----------------
- function Get_Return_Kind return Return_Kind is
- Scan_State : Saved_Scan_State;
- Result : Return_Kind := Simple_Return;
+ function Is_Extended return Boolean is
+ Scan_State : Saved_Scan_State;
+ Is_Extended : Boolean := False;
begin
+
if Token = Tok_Identifier then
Save_Scan_State (Scan_State); -- at identifier
Scan; -- past identifier
if Token = Tok_Colon then
- Result := Extended_Return; -- It's an extended_return_statement
- elsif Token = Tok_When then
- Error_Msg_GNAT_Extension ("return when statement");
-
- Result := Return_When;
+ Is_Extended := True;
end if;
Restore_Scan_State (Scan_State); -- to identifier
-
- elsif Token = Tok_When then
- Error_Msg_GNAT_Extension ("return when statement");
-
- Result := Return_When;
end if;
- return Result;
- end Get_Return_Kind;
+ return Is_Extended;
+ end Is_Extended;
Ret_Sloc : constant Source_Ptr := Token_Ptr;
Ret_Strt : constant Column_Number := Start_Column;
- Ret_Node : Node_Id := New_Node (N_Simple_Return_Statement, Ret_Sloc);
+ Ret_Node : Node_Id;
Decl : Node_Id;
-- Start of processing for P_Return_Statement
@@ -1928,75 +1918,73 @@ package body Ch6 is
if Token = Tok_Semicolon then
Scan; -- past ;
+ Ret_Node := New_Node (N_Simple_Return_Statement, Ret_Sloc);
-- Nontrivial case
else
- -- Simple_return_statement with expression
+ -- Extended_return_statement (Ada 2005 only -- AI-318):
- -- We avoid trying to scan an expression if we are at an
- -- expression terminator since in that case the best error
- -- message is probably that we have a missing semicolon.
+ if Is_Extended then
+ Error_Msg_Ada_2005_Extension ("extended return statement");
- case Get_Return_Kind is
- -- Return_when_statement (Experimental only)
+ Ret_Node := New_Node (N_Extended_Return_Statement, Ret_Sloc);
+ Decl := P_Return_Object_Declaration;
+ Set_Return_Object_Declarations (Ret_Node, New_List (Decl));
- when Return_When =>
- Ret_Node := New_Node (N_Return_When_Statement, Ret_Sloc);
-
- if Token not in Token_Class_Eterm then
- Set_Expression (Ret_Node, P_Expression_No_Right_Paren);
- end if;
-
- if Token = Tok_When and then not Missing_Semicolon_On_When then
- Scan; -- past WHEN
- Set_Condition (Ret_Node, P_Condition);
-
- -- Allow IF instead of WHEN, giving error message
+ if Token = Tok_With then
+ P_Aspect_Specifications (Decl, False);
+ end if;
- elsif Token = Tok_If then
- T_When;
- Scan; -- past IF used in place of WHEN
- Set_Condition (Ret_Node, P_Expression_No_Right_Paren);
- end if;
+ if Token = Tok_Do then
+ Push_Scope_Stack;
+ Scopes (Scope.Last).Ecol := Ret_Strt;
+ Scopes (Scope.Last).Etyp := E_Return;
+ Scopes (Scope.Last).Labl := Error;
+ Scopes (Scope.Last).Sloc := Ret_Sloc;
+ Scan; -- past DO
+ Set_Handled_Statement_Sequence
+ (Ret_Node, P_Handled_Sequence_Of_Statements);
+ End_Statements;
+
+ -- Do we need to handle Error_Resync here???
+ end if;
- -- Simple_return_statement
+ -- Simple_return_statement or Return_when_Statement
+ -- with expression.
- when Simple_Return =>
- Ret_Node := New_Node (N_Simple_Return_Statement, Ret_Sloc);
+ -- We avoid trying to scan an expression if we are at an
+ -- expression terminator since in that case the best error
+ -- message is probably that we have a missing semicolon.
- if Token not in Token_Class_Eterm then
- Set_Expression (Ret_Node, P_Expression_No_Right_Paren);
- end if;
+ else
+ Ret_Node := New_Node (N_Simple_Return_Statement, Ret_Sloc);
- -- Extended_return_statement (Ada 2005 only -- AI-318):
+ if Token not in Token_Class_Eterm then
+ Set_Expression (Ret_Node, P_Expression_No_Right_Paren);
+ end if;
- when Extended_Return =>
- Error_Msg_Ada_2005_Extension ("extended return statement");
+ -- When the next token is WHEN or IF we know that we are looking
+ -- at a Return_when_statement
- Ret_Node := New_Node (N_Extended_Return_Statement, Ret_Sloc);
- Decl := P_Return_Object_Declaration;
- Set_Return_Object_Declarations (Ret_Node, New_List (Decl));
+ if Token = Tok_When and then not Missing_Semicolon_On_When then
+ Error_Msg_GNAT_Extension ("return when statement");
+ Mutate_Nkind (Ret_Node, N_Return_When_Statement);
- if Token = Tok_With then
- P_Aspect_Specifications (Decl, False);
- end if;
+ Scan; -- past WHEN
+ Set_Condition (Ret_Node, P_Condition);
- if Token = Tok_Do then
- Push_Scope_Stack;
- Scopes (Scope.Last).Ecol := Ret_Strt;
- Scopes (Scope.Last).Etyp := E_Return;
- Scopes (Scope.Last).Labl := Error;
- Scopes (Scope.Last).Sloc := Ret_Sloc;
+ -- Allow IF instead of WHEN, giving error message
- Scan; -- past DO
- Set_Handled_Statement_Sequence
- (Ret_Node, P_Handled_Sequence_Of_Statements);
- End_Statements;
+ elsif Token = Tok_If then
+ Error_Msg_GNAT_Extension ("return when statement");
+ Mutate_Nkind (Ret_Node, N_Return_When_Statement);
- -- Do we need to handle Error_Resync here???
- end if;
- end case;
+ T_When;
+ Scan; -- past IF used in place of WHEN
+ Set_Condition (Ret_Node, P_Condition);
+ end if;
+ end if;
TF_Semicolon;
end if;
