From bf85ff03b3e6a17da5bee164114721ea076e33ad Mon Sep 17 00:00:00 2001 From: Ghjuvan Lacambre Date: Wed, 28 Oct 2020 11:03:16 +0100 Subject: [PATCH] [Ada] Emit error messages for null/generic nonreturning procedures gcc/ada/ * sem_prag.adb (Analyze_Pragma): declare new Check_No_Return function and call it. --- gcc/ada/sem_prag.adb | 66 +++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 62 insertions(+), 4 deletions(-) diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 05ff5114ac7..bb891326b33 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -19670,7 +19670,59 @@ package body Sem_Prag is -- pragma No_Return (procedure_LOCAL_NAME {, procedure_Local_Name}); - when Pragma_No_Return => No_Return : declare + when Pragma_No_Return => Prag_No_Return : declare + + function Check_No_Return + (E : Entity_Id; + N : Node_Id) return Boolean; + -- Check rule 6.5.1 4/3 of the Ada Ref Manual. If the rule is + -- violated, emit an error message and return False, otherwise + -- return True. + -- 6.5.1 Nonreturning procedures: + -- 4/3 "Aspect No_Return shall not be specified for a null + -- procedure nor an instance of a generic unit." + + --------------------- + -- Check_No_Return -- + --------------------- + + function Check_No_Return + (E : Entity_Id; + N : Node_Id) return Boolean + is + Ok : Boolean := True; + begin + if Ekind (E) = E_Procedure then + + -- If E is a generic instance, marking it with No_Return is + -- forbidden, but having it inherit the No_Return of the + -- generic is allowed. We check if E is inheriting its + -- No_Return flag from the generic by checking if No_Return + -- is already set. + + if Is_Generic_Instance (E) and then not No_Return (E) then + Error_Msg_NE + ("generic instance & is marked as No_Return", N, E); + Error_Msg_NE + ("\generic procedure & must be marked No_Return", + N, + Generic_Parent (Parent (E))); + Ok := False; + + else + if Null_Present (Subprogram_Specification (E)) then + Error_Msg_NE + ("null procedure & cannot be marked No_Return", + N, + E); + Ok := False; + end if; + end if; + end if; + + return Ok; + end Check_No_Return; + Arg : Node_Id; E : Entity_Id; Found : Boolean; @@ -19742,7 +19794,9 @@ package body Sem_Prag is end if; end if; - Set_No_Return (E); + if Check_No_Return (E, N) then + Set_No_Return (E); + end if; -- A pragma that applies to a Ghost entity becomes Ghost -- for the purposes of legality checks and removal of @@ -19781,7 +19835,10 @@ package body Sem_Prag is -- Set flag on any alias as well - if Is_Overloadable (E) and then Present (Alias (E)) then + if Is_Overloadable (E) + and then Present (Alias (E)) + and then Check_No_Return (Alias (E), N) + then Set_No_Return (Alias (E)); end if; @@ -19798,6 +19855,7 @@ package body Sem_Prag is if not Found then if Entity (Id) = Current_Scope and then From_Aspect_Specification (N) + and then Check_No_Return (Entity (Id), N) then Set_No_Return (Entity (Id)); @@ -19812,7 +19870,7 @@ package body Sem_Prag is Next (Arg); end loop; - end No_Return; + end Prag_No_Return; ----------------- -- No_Run_Time -- -- 2.30.2