From 90e975175757b4ac9712d90d27ec59cd09f22cc9 Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Wed, 18 Mar 2020 23:13:20 +0100 Subject: [PATCH] [Ada] Implement AI12-0269 No_Return for functions 2020-06-12 Eric Botcazou 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) : Accept it on functions and generic functions in Ada 2020. --- gcc/ada/einfo.adb | 3 +- gcc/ada/einfo.ads | 4 +-- gcc/ada/sem_ch3.adb | 20 +++++++++++-- gcc/ada/sem_ch6.adb | 71 ++++++++++++++++++++++++++++++++++++++++---- gcc/ada/sem_ch8.adb | 5 ++-- gcc/ada/sem_disp.adb | 9 ------ gcc/ada/sem_prag.adb | 14 +++++++-- 7 files changed, 101 insertions(+), 25 deletions(-) diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 83beff6f0f1..9176f4a7de1 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -6180,8 +6180,7 @@ package body Einfo is 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; diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 75474cd232d..a1cfd7d37ce 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -3720,8 +3720,8 @@ package Einfo is -- 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 diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 538796efcb9..ff1f6dbd651 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -10868,6 +10868,20 @@ package body Sem_Ch3 is 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 @@ -15450,9 +15464,9 @@ package body Sem_Ch3 is 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)); diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 576e33e6bb1..456bd97c68f 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -676,6 +676,10 @@ package body Sem_Ch6 is 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. @@ -684,6 +688,34 @@ package body Sem_Ch6 is -- 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 -- ------------------------------------------ @@ -1101,6 +1133,19 @@ package body Sem_Ch6 is 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)); @@ -1162,6 +1207,18 @@ package body Sem_Ch6 is ("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; @@ -2091,8 +2148,12 @@ package body Sem_Ch6 is -- 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 @@ -2103,17 +2164,17 @@ package body Sem_Ch6 is -- 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); diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb index e62be5599f8..8a63831aa64 100644 --- a/gcc/ada/sem_ch8.adb +++ b/gcc/ada/sem_ch8.adb @@ -3106,9 +3106,10 @@ package body Sem_Ch8 is 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 diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb index a2fbcfcff39..3b40f4c3be6 100644 --- a/gcc/ada/sem_disp.adb +++ b/gcc/ada/sem_disp.adb @@ -2548,14 +2548,6 @@ package body Sem_Disp is 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. @@ -2666,7 +2658,6 @@ package body Sem_Disp is 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; diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 05171d45208..75d5b0e4ae8 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -19814,7 +19814,7 @@ package body Sem_Prag is raise Pragma_Exit; end if; - -- Loop to find matching procedures + -- Loop to find matching procedures or functions (Ada 2020) E := Entity (Id); @@ -19822,8 +19822,13 @@ package body Sem_Prag is 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 @@ -19905,6 +19910,11 @@ package body Sem_Prag is 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; -- 2.30.2