public inbox for gcc-cvs@sourceware.org help / color / mirror / Atom feed
From: Eric Botcazou <ebotcazou@gcc.gnu.org> To: gcc-cvs@gcc.gnu.org Subject: [gcc r13-7905] ada: Fix premature finalization in loop over limited iterable container Date: Wed, 27 Sep 2023 08:28:26 +0000 (GMT) [thread overview] Message-ID: <20230927082826.9D3383875425@sourceware.org> (raw) https://gcc.gnu.org/g:dfbca296ef561124d9931d6ceeaca5b21ab1d17e commit r13-7905-gdfbca296ef561124d9931d6ceeaca5b21ab1d17e 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 52c5753ab93..6ae671c43a6 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -8340,65 +8340,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); @@ -8615,7 +8623,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 @@ -8700,7 +8708,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
reply other threads:[~2023-09-27 8:28 UTC|newest] Thread overview: [no followups] expand[flat|nested] mbox.gz Atom feed
Reply instructions: You may reply publicly to this message via plain-text email using any one of the following methods: * Save the following mbox file, import it into your mail client, and reply-to-all from there: mbox Avoid top-posting and favor interleaved quoting: https://en.wikipedia.org/wiki/Posting_style#Interleaved_style * Reply using the --to, --cc, and --in-reply-to switches of git-send-email(1): git send-email \ --in-reply-to=20230927082826.9D3383875425@sourceware.org \ --to=ebotcazou@gcc.gnu.org \ --cc=gcc-cvs@gcc.gnu.org \ /path/to/YOUR_REPLY https://kernel.org/pub/software/scm/git/docs/git-send-email.html * If your mail client supports setting the In-Reply-To header via mailto: links, try the mailto: linkBe sure your reply has a Subject: header at the top and a blank line before the message body.
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).