2020-06-12 Eric Botcazou <ebotcazou@adacore.com>
gcc/ada/
* einfo.ads (No_Return): Document it for all subprograms.
* einfo.adb (Set_No_Return): Adjust assertion accordingly.
* sem_ch3.adb (Check_Abstract_Overriding): Implement the
check prescribed by RM 6.5.1(6/2) here instead of...
(Derive_Subprogram): Adjust comment accordingly.
* sem_disp.adb (Override_Dispatching_Operation): ...here.
Remove superfluous return statement.
* sem_ch6.adb (Check_No_Return_Expression): New procedure.
(Analyze_Function_Return): Call it to implement the check
prescribed by AI12-0269 for simple return statements of
No_Return functions, and also checks extended statements.
(Analyze_Return_Statement): Only give an error on a return
statement in No_Return procedures. Use idiomatic form.
* sem_ch8.adb (Analyze_Subprogram_Renaming): Adjust error
message for No_Return renaming subprogram.
* sem_prag.adb (Analyze_Pragma) <Pragma_No_Return>: Accept
it on functions and generic functions in Ada 2020.
procedure Set_No_Return (Id : E; V : B := True) is
begin
- pragma Assert
- (V = False or else Ekind_In (Id, E_Procedure, E_Generic_Procedure));
+ pragma Assert (Is_Subprogram (Id) or else Is_Generic_Subprogram (Id));
Set_Flag113 (Id, V);
end Set_No_Return;
-- pragma No_Component_Reordering applies.
-- No_Return (Flag113)
--- Defined in all entities. Always false except in the case of procedures
--- and generic procedures for which a pragma No_Return is given.
+-- Defined in all entities. Set for subprograms and generic subprograms
+-- to which a valid aspect or pragma No_Return applies.
-- No_Strict_Aliasing (Flag136) [base type only]
-- Defined in access types. Set to direct the backend to avoid any
end if;
end if;
+ -- Ada 2005 (AI95-0414) and Ada 2020 (AI12-0269): Diagnose failure to
+ -- match No_Return in parent, but do it unconditionally in Ada 95 too
+ -- for procedures, since this is our pragma.
+
+ if Present (Overridden_Operation (Subp))
+ and then No_Return (Overridden_Operation (Subp))
+ and then not No_Return (Subp)
+ then
+ Error_Msg_N ("overriding subprogram & must be No_Return", Subp);
+ Error_Msg_N
+ ("\since overridden subprogram is No_Return (RM 6.5.1(6/2))",
+ Subp);
+ end if;
+
-- If the operation is a wrapper for a synchronized primitive, it
-- may be called indirectly through a dispatching select. We assume
-- that it will be referenced elsewhere indirectly, and suppress
end if;
-- No_Return must be inherited properly. If this is overridden in the
- -- case of a dispatching operation, then a check is made in Sem_Disp
- -- that the overriding operation is also No_Return (no such check is
- -- required for the case of non-dispatching operation.
+ -- case of a dispatching operation, then the check is made later in
+ -- Check_Abstract_Overriding that the overriding operation is also
+ -- No_Return (no such check is required for the nondispatching case).
Set_No_Return (New_Subp, No_Return (Parent_Subp));
R_Type : constant Entity_Id := Etype (Scope_Id);
-- Function result subtype
+ procedure Check_No_Return_Expression (Return_Expr : Node_Id);
+ -- Ada 2020: Check that the return expression in a No_Return function
+ -- meets the conditions specified by RM 6.5.1(5.1/5).
+
procedure Check_Return_Construct_Accessibility (Return_Stmt : Node_Id);
-- Apply legality rule of 6.5 (5.9) to the access discriminants of an
-- aggregate in a return statement.
-- Check that the return_subtype_indication properly matches the result
-- subtype of the function, as required by RM-6.5(5.1/2-5.3/2).
+ --------------------------------
+ -- Check_No_Return_Expression --
+ --------------------------------
+
+ procedure Check_No_Return_Expression (Return_Expr : Node_Id) is
+ Kind : constant Node_Kind := Nkind (Return_Expr);
+
+ begin
+ if Kind = N_Raise_Expression then
+ return;
+
+ elsif Kind = N_Function_Call
+ and then Is_Entity_Name (Name (Return_Expr))
+ and then Ekind_In (Entity (Name (Return_Expr)), E_Function,
+ E_Generic_Function)
+ and then No_Return (Entity (Name (Return_Expr)))
+ then
+ return;
+ end if;
+
+ Error_Msg_N
+ ("illegal expression in RETURN statement of No_Return function",
+ Return_Expr);
+ Error_Msg_N
+ ("\must be raise expression or call to No_Return (RM 6.5.1(5.1/5))",
+ Return_Expr);
+ end Check_No_Return_Expression;
+
------------------------------------------
-- Check_Return_Construct_Accessibility --
------------------------------------------
Check_Limited_Return (N, Expr, R_Type);
Check_Return_Construct_Accessibility (N);
+
+ -- Ada 2020 (AI12-0269): Any return statement that applies to a
+ -- nonreturning function shall be a simple_return_statement with
+ -- an expression that is a raise_expression, or else a call on a
+ -- nonreturning function, or else a parenthesized expression of
+ -- one of these.
+
+ if Ada_Version >= Ada_2020
+ and then No_Return (Scope_Id)
+ and then Comes_From_Source (N)
+ then
+ Check_No_Return_Expression (Original_Node (Expr));
+ end if;
end if;
else
Obj_Decl := Last (Return_Object_Declarations (N));
("aliased only allowed for limited return objects", N);
end if;
end if;
+
+ -- Ada 2020 (AI12-0269): Any return statement that applies to a
+ -- nonreturning function shall be a simple_return_statement.
+
+ if Ada_Version >= Ada_2020
+ and then No_Return (Scope_Id)
+ and then Comes_From_Source (N)
+ then
+ Error_Msg_N
+ ("extended RETURN statement not allowed in No_Return "
+ & "function", N);
+ end if;
end;
end if;
-- Check that pragma No_Return is obeyed. Don't complain about the
-- implicitly-generated return that is placed at the end.
- if No_Return (Scope_Id) and then Comes_From_Source (N) then
- Error_Msg_N ("RETURN statement not allowed (No_Return)", N);
+ if No_Return (Scope_Id)
+ and then Ekind_In (Kind, E_Procedure, E_Generic_Procedure)
+ and then Comes_From_Source (N)
+ then
+ Error_Msg_N
+ ("RETURN statement not allowed in No_Return procedure", N);
end if;
-- Warn on any unassigned OUT parameters if in procedure
-- Check that functions return objects, and other things do not
- if Kind = E_Function or else Kind = E_Generic_Function then
+ if Ekind_In (Kind, E_Function, E_Generic_Function) then
if not Returns_Object then
Error_Msg_N ("missing expression in return from function", N);
end if;
- elsif Kind = E_Procedure or else Kind = E_Generic_Procedure then
+ elsif Ekind_In (Kind, E_Procedure, E_Generic_Procedure) then
if Returns_Object then
Error_Msg_N ("procedure cannot return value (use function)", N);
end if;
- elsif Kind = E_Entry or else Kind = E_Entry_Family then
+ elsif Ekind_In (Kind, E_Entry, E_Entry_Family) then
if Returns_Object then
if Is_Protected_Type (Scope (Scope_Id)) then
Error_Msg_N ("entry body cannot return value", N);
if No_Return (Rename_Spec)
and then not No_Return (Entity (Nam))
then
- Error_Msg_N ("renaming completes a No_Return procedure", N);
+ Error_Msg_NE
+ ("renamed subprogram & must be No_Return", N, Entity (Nam));
Error_Msg_N
- ("\renamed procedure must be nonreturning (RM 6.5.1 (7/2))", N);
+ ("\since renaming subprogram is No_Return (RM 6.5.1(7/2))", N);
end if;
-- The specification does not introduce new formals, but only
Prim : Node_Id;
begin
- -- Diagnose failure to match No_Return in parent (Ada-2005, AI-414, but
- -- we do it unconditionally in Ada 95 now, since this is our pragma).
-
- if No_Return (Prev_Op) and then not No_Return (New_Op) then
- Error_Msg_N ("procedure & must have No_Return pragma", New_Op);
- Error_Msg_N ("\since overridden procedure has No_Return", New_Op);
- end if;
-
-- If there is no previous operation to override, the type declaration
-- was malformed, and an error must have been emitted already.
Set_Alias (Prev_Op, New_Op);
Set_DTC_Entity (Prev_Op, Empty);
Set_Has_Controlling_Result (New_Op, Has_Controlling_Result (Prev_Op));
- return;
end if;
end Override_Dispatching_Operation;
raise Pragma_Exit;
end if;
- -- Loop to find matching procedures
+ -- Loop to find matching procedures or functions (Ada 2020)
E := Entity (Id);
while Present (E)
and then Scope (E) = Current_Scope
loop
- if Ekind_In (E, E_Generic_Procedure, E_Procedure) then
+ -- Ada 2020 (AI12-0269): A function can be No_Return
+ if Ekind_In (E, E_Generic_Procedure, E_Procedure)
+ or else (Ada_Version >= Ada_2020
+ and then
+ Ekind_In (E, E_Generic_Function, E_Function))
+ then
-- Check that the pragma is not applied to a body.
-- First check the specless body case, to give a
-- different error message. These checks do not apply
and then From_Aspect_Specification (N)
then
Set_No_Return (Entity (Id));
+
+ elsif Ada_Version >= Ada_2020 then
+ Error_Pragma_Arg
+ ("no subprogram& found for pragma%", Arg);
+
else
Error_Pragma_Arg ("no procedure& found for pragma%", Arg);
end if;
projects / platform / upstream / gcc.git / commitdiff