* [COMMITTED] ada: Improve pragma No_Return's pre-Ada2022 handling of functions
@ 2024-05-07 8:00 Marc Poulhiès
0 siblings, 0 replies; only message in thread
From: Marc Poulhiès @ 2024-05-07 8:00 UTC (permalink / raw)
To: gcc-patches; +Cc: Steve Baird
From: Steve Baird <baird@adacore.com>
Ada 2022 allows pragma No_Return to apply to a function (or a generic function).
For earlier Ada versions, if a No_Return pragma argument's possible
resolutions include a function (or a generic function) then we want to ignore
that candidate if a non-function candidate is also available and otherwise
to generate an error message mentioning that this is an Ada 2022 feature.
gcc/ada/
* sem_prag.adb (Analyze_Pragma): Restructure the loop over
possible resolutions of a No_Return pragma's argument so that
functions (and generic functions) are not processed until after it
is known whether there is a non-function candidate resolution. For
a pre-2022 Ada version, terminate the iteration before processing
functions if a non-function resolution is found.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/sem_prag.adb | 166 +++++++++++++++++++++++++------------------
1 file changed, 97 insertions(+), 69 deletions(-)
diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
index a2996137648..ff02ae9a7af 100644
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -20771,96 +20771,124 @@ package body Sem_Prag is
raise Pragma_Exit;
end if;
+ Found := False;
-- Loop to find matching procedures or functions (Ada 2022)
- E := Entity (Id);
+ Outer_Loop :
+ for Process_Functions in Boolean loop
- Found := False;
- while Present (E)
- and then Scope (E) = Current_Scope
- loop
- -- Ada 2022 (AI12-0269): A function can be No_Return
+ -- We make two passes over the Homonym list, first looking
+ -- at procedures and then at functions. This is done
+ -- in order to get the desired behavior in the pre-Ada2022
+ -- case. There are two subcases of the pre-Ada2022 case -
+ -- either we found a non-function candidate in the first
+ -- pass or we didn't. If we found one, then exit early
+ -- (i.e., skip the second pass); we want to silently ignore
+ -- any functions. But if we didn't find one then we do not
+ -- want to exit early because looking at functions will
+ -- allow us (if we find one) to generate a more useful
+ -- error message ("this is an Ada 2022 construct" instead of
+ -- "name could not be resolved").
- if Ekind (E) in E_Generic_Procedure | E_Procedure
- | 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
- -- if Relaxed_RM_Semantics, to accommodate other Ada
- -- compilers. Disable these checks under -gnatd.J.
-
- if not Debug_Flag_Dot_JJ then
- if Nkind (Parent (Declaration_Node (E))) =
- N_Subprogram_Body
- and then not Relaxed_RM_Semantics
- then
- Error_Pragma
- ("pragma% requires separate spec and must come "
- & "before body");
- end if;
+ exit Outer_Loop when Found and Ada_Version < Ada_2022;
- -- Now the "specful" body case
+ E := Entity (Id);
- if Rep_Item_Too_Late (E, N) then
- raise Pragma_Exit;
- end if;
- end if;
+ while Present (E)
+ and then Scope (E) = Current_Scope
+ loop
+ -- Ada 2022 (AI12-0269): A function can be No_Return
- if Check_No_Return (E, N) then
- Set_No_Return (E);
- end if;
+ if (if Process_Functions
+ then Ekind (E) in E_Generic_Function | E_Function
+ else Ekind (E) in E_Generic_Procedure | E_Procedure)
- -- A pragma that applies to a Ghost entity becomes Ghost
- -- for the purposes of legality checks and removal of
- -- ignored Ghost code.
+ -- if From_Aspect_Specification, then only one
+ -- candidate should be considered.
- Mark_Ghost_Pragma (N, E);
+ and then (not From_Aspect_Specification (N)
+ or else E = Entity (Id)
+ or else No (Entity (Id)))
- -- Capture the entity of the first Ghost procedure being
- -- processed for error detection purposes.
+ 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
+ -- if Relaxed_RM_Semantics, to accommodate other Ada
+ -- compilers. Disable these checks under -gnatd.J.
+
+ if not Debug_Flag_Dot_JJ then
+ if Nkind (Parent (Declaration_Node (E))) =
+ N_Subprogram_Body
+ and then not Relaxed_RM_Semantics
+ then
+ Error_Pragma
+ ("pragma% requires separate spec and must "
+ & "come before body");
+ end if;
- if Is_Ghost_Entity (E) then
- if No (Ghost_Id) then
- Ghost_Id := E;
+ -- Now the "specful" body case
+
+ if Rep_Item_Too_Late (E, N) then
+ raise Pragma_Exit;
+ end if;
end if;
- -- Otherwise the subprogram is non-Ghost. It is illegal
- -- to mix references to Ghost and non-Ghost entities
- -- (SPARK RM 6.9).
+ if Check_No_Return (E, N) then
+ Set_No_Return (E);
+ end if;
- elsif Present (Ghost_Id)
- and then not Ghost_Error_Posted
- then
- Ghost_Error_Posted := True;
+ -- A pragma that applies to a Ghost entity becomes
+ -- Ghost for the purposes of legality checks and
+ -- removal of ignored Ghost code.
- Error_Msg_Name_1 := Pname;
- Error_Msg_N
- ("pragma % cannot mention ghost and non-ghost "
- & "procedures", N);
+ Mark_Ghost_Pragma (N, E);
- Error_Msg_Sloc := Sloc (Ghost_Id);
- Error_Msg_NE ("\& # declared as ghost", N, Ghost_Id);
+ -- Capture the entity of the first Ghost procedure
+ -- being processed for error detection purposes.
- Error_Msg_Sloc := Sloc (E);
- Error_Msg_NE ("\& # declared as non-ghost", N, E);
- end if;
+ if Is_Ghost_Entity (E) then
+ if No (Ghost_Id) then
+ Ghost_Id := E;
+ end if;
- -- Set flag on any alias as well
+ -- Otherwise the subprogram is non-Ghost. It is
+ -- illegal to mix references to Ghost and non-Ghost
+ -- entities (SPARK RM 6.9).
- 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;
+ elsif Present (Ghost_Id)
+ and then not Ghost_Error_Posted
+ then
+ Ghost_Error_Posted := True;
- Found := True;
- end if;
+ Error_Msg_Name_1 := Pname;
+ Error_Msg_N
+ ("pragma % cannot mention ghost and non-ghost "
+ & "procedures", N);
- exit when From_Aspect_Specification (N);
- E := Homonym (E);
- end loop;
+ Error_Msg_Sloc := Sloc (Ghost_Id);
+ Error_Msg_NE
+ ("\& # declared as ghost", N, Ghost_Id);
+
+ Error_Msg_Sloc := Sloc (E);
+ Error_Msg_NE ("\& # declared as non-ghost", N, E);
+ end if;
+
+ -- Set flag on any alias as well
+
+ 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;
+
+ Found := True;
+ end if;
+
+ E := Homonym (E);
+ end loop;
+ end loop Outer_Loop;
-- If entity in not in current scope it may be the enclosing
-- subprogram body to which the aspect applies.
--
2.43.2
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2024-05-07 8:00 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2024-05-07 8:00 [COMMITTED] ada: Improve pragma No_Return's pre-Ada2022 handling of functions Marc Poulhiès
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).