public inbox for gcc-cvs@sourceware.org
help / color / mirror / Atom feed
* [gcc r14-3984] ada: Fix premature finalization in loop over limited iterable container
@ 2023-09-14 12:45 Marc Poulhi?s
0 siblings, 0 replies; only message in thread
From: Marc Poulhi?s @ 2023-09-14 12:45 UTC (permalink / raw)
To: gcc-cvs
https://gcc.gnu.org/g:c3e95117406ad0f1dbe038c883122a8824a8105c
commit r14-3984-gc3e95117406ad0f1dbe038c883122a8824a8105c
Author: Eric Botcazou <ebotcazou@adacore.com>
Date: Fri Aug 25 10:47:30 2023 +0200
ada: Fix premature finalization in loop over limited iterable container
This happens when the iterable container is obtained as the result of a
call to a function that is a subprogram parameter of a generic construct.
gcc/ada/
* exp_util.adb (Initialized_By_Aliased_BIP_Func_Call): Make the name
matching more robust.
Diff:
---
gcc/ada/exp_util.adb | 88 ++++++++++++++++++++++++++++------------------------
1 file changed, 48 insertions(+), 40 deletions(-)
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index a4b5ec366f3..0dafa1cd6be 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -8399,65 +8399,73 @@ package body Exp_Util is
Call := Unqual_Conv (Call);
+ -- We search for a formal with a matching suffix. We can't search
+ -- for the full name, because of the code at the end of Sem_Ch6.-
+ -- Create_Extra_Formals, which copies the Extra_Formals over to
+ -- the Alias of an instance, which will cause the formals to have
+ -- "incorrect" names. See also Exp_Ch6.Build_In_Place_Formal.
+
if Is_Build_In_Place_Function_Call (Call) then
declare
Caller_Allocation_Val : constant Uint :=
UI_From_Int (BIP_Allocation_Form'Pos (Caller_Allocation));
+ Access_Suffix : constant String :=
+ BIP_Formal_Suffix (BIP_Object_Access);
+ Alloc_Suffix : constant String :=
+ BIP_Formal_Suffix (BIP_Alloc_Form);
+
+ function Has_Suffix (Name, Suffix : String) return Boolean;
+ -- Return True if Name has suffix Suffix
+
+ ----------------
+ -- Has_Suffix --
+ ----------------
+
+ function Has_Suffix (Name, Suffix : String) return Boolean is
+ Len : constant Natural := Suffix'Length;
+
+ begin
+ return Name'Length > Len
+ and then Name (Name'Last - Len + 1 .. Name'Last) = Suffix;
+ end Has_Suffix;
- Access_Nam : Name_Id := No_Name;
Access_OK : Boolean := False;
- Actual : Node_Id;
- Alloc_Nam : Name_Id := No_Name;
Alloc_OK : Boolean := True;
- Formal : Node_Id;
- Func_Id : Entity_Id;
Param : Node_Id;
begin
-- Examine all parameter associations of the function call
Param := First (Parameter_Associations (Call));
+
while Present (Param) loop
if Nkind (Param) = N_Parameter_Association
and then Nkind (Selector_Name (Param)) = N_Identifier
then
- Actual := Explicit_Actual_Parameter (Param);
- Formal := Selector_Name (Param);
-
- -- Construct the names of formals BIPaccess and BIPalloc
- -- using the function name retrieved from an arbitrary
- -- formal.
-
- if Access_Nam = No_Name
- and then Alloc_Nam = No_Name
- and then Present (Entity (Formal))
- then
- Func_Id := Scope (Entity (Formal));
-
- Access_Nam :=
- New_External_Name (Chars (Func_Id),
- BIP_Formal_Suffix (BIP_Object_Access));
-
- Alloc_Nam :=
- New_External_Name (Chars (Func_Id),
- BIP_Formal_Suffix (BIP_Alloc_Form));
- end if;
+ declare
+ Actual : constant Node_Id
+ := Explicit_Actual_Parameter (Param);
+ Formal : constant Node_Id
+ := Selector_Name (Param);
+ Name : constant String
+ := Get_Name_String (Chars (Formal));
- -- A nonnull BIPaccess has been found
+ begin
+ -- A nonnull BIPaccess has been found
- if Chars (Formal) = Access_Nam
- and then Nkind (Actual) /= N_Null
- then
- Access_OK := True;
- end if;
+ if Has_Suffix (Name, Access_Suffix)
+ and then Nkind (Actual) /= N_Null
+ then
+ Access_OK := True;
- -- A BIPalloc has been found
+ -- A BIPalloc has been found
- if Chars (Formal) = Alloc_Nam
- and then Nkind (Actual) = N_Integer_Literal
- then
- Alloc_OK := Intval (Actual) = Caller_Allocation_Val;
- end if;
+ elsif Has_Suffix (Name, Alloc_Suffix)
+ and then Nkind (Actual) = N_Integer_Literal
+ then
+ Alloc_OK := Intval (Actual) = Caller_Allocation_Val;
+ end if;
+ end;
end if;
Next (Param);
@@ -8674,7 +8682,7 @@ package body Exp_Util is
-- first parameter is the transient. Such a call appears as:
-- It : Access_To_Constant_Reference_Type :=
- -- Constant_Indexing (Tran_Id.all, ...)'reference;
+ -- Constant_Indexing (Trans_Id.all, ...)'reference;
Stmt := First_Stmt;
while Present (Stmt) loop
@@ -8759,7 +8767,7 @@ package body Exp_Util is
-- first parameter is the transient. Such a call appears as:
-- It : Access_To_CW_Iterator :=
- -- Iterate (Tran_Id.all, ...)'reference;
+ -- Iterate (Trans_Id.all, ...)'reference;
Stmt := First_Stmt;
while Present (Stmt) loop
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2023-09-14 12:45 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-09-14 12:45 [gcc r14-3984] ada: Fix premature finalization in loop over limited iterable container 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).