* [Ada] Emit error messages for null/generic nonreturning procedures
@ 2020-11-27 9:18 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2020-11-27 9:18 UTC (permalink / raw)
To: gcc-patches; +Cc: Ghjuvan Lacambre
[-- Attachment #1: Type: text/plain, Size: 498 bytes --]
This commit adds checks for rule 6.5.1 4/3 of the Ada RM which declares
nonreturning procedures and nonreturning generic procedure instances
illegal.
The reason this check is performed in sem_prag.adb rather than in
Check_Returns in sem_ch6.adb is that generic procedure instances won't
have their No_Return flag set yet when Check_Returns is called.
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
* sem_prag.adb (Analyze_Pragma): declare new Check_No_Return
function and call it.
[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 3967 bytes --]
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
--- 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 --
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2020-11-27 9:18 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2020-11-27 9:18 [Ada] Emit error messages for null/generic nonreturning procedures Pierre-Marie de Rodat
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).