From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mail-wm1-x335.google.com (mail-wm1-x335.google.com [IPv6:2a00:1450:4864:20::335]) by sourceware.org (Postfix) with ESMTPS id 485E7382E689 for ; Tue, 23 May 2023 08:09:15 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 485E7382E689 Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=adacore.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=adacore.com Received: by mail-wm1-x335.google.com with SMTP id 5b1f17b1804b1-3f423521b10so45544675e9.0 for ; Tue, 23 May 2023 01:09:15 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=adacore.com; s=google; t=1684829354; x=1687421354; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:from:to:cc:subject:date:message-id:reply-to; bh=qYWYR4PEJRUYQnzyuLFu77+l7d2INVjCdnqWXIFlTKo=; b=CMbY02GTQiWg42RB/v7exR7eDp7bUr9HDApG0I3RKU5+5pvDQQg+E08DkYkEYOlNZG rzmkyvSFGfk9ZHHenMHnf1lzu0ATV4Xf9K3qB15n1LRphc9+V7mv+VHUE4IdwabrPk1v A/s71L2MezdUSJM1nAInfWJc4zJrg0r4kLl2tEqDg6by8j3tjv5PSomcVaGhiJD70jug a5I1PwSGBPS5YTKNLKL7P2b6Tp9K8VsHk5gyOP9GZEmWMC/SV/RRiqInqoBuGirK3rrJ jAcXg4WM0ch/KGrcdugzUK0ZxhOuIgapXKxbANljkEdGvfyJb/M0mSLsms/nWST2afvE aYcA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20221208; t=1684829354; x=1687421354; h=content-transfer-encoding:mime-version:message-id:date:subject:cc :to:from:x-gm-message-state:from:to:cc:subject:date:message-id :reply-to; bh=qYWYR4PEJRUYQnzyuLFu77+l7d2INVjCdnqWXIFlTKo=; b=SPoPdfIt/JRm8niAWHebb43E7j1VU3vttttwzd5gaXVNlyAzGymvn9VMNetXesHvZQ 4VzZlrSobL+Qxwj0GRyjmPbfAQLHZQ902WmHMfjLOjhjwm5IIIR3mC7oLjMa2mk2jqAV IUFmsR7FjjjS6KJabcItoJBAEegj3MPki/A5otQs6esA6cI0e+/OLYHnDt1tUUsUdj23 K6gy52qqe1EXeMJwpOK/k3hQJb371qAqagwN1l47igREXp0Joi/xao1VpC6NW5UutU2w DlbHdCpKUkIinTTfFm+IVKRKAfnbiMcmuJw9HS5y9mrHPe2xfv2xK4H5JY7J4slC3CYX Wflg== X-Gm-Message-State: AC+VfDy8zKLA5/jQz0elsElJ9IjCprsn5Q2zmvfcJA3eEloev8UFwxmU fKPULX+A94Apt3dEGI1E5rBnZpjqXl+pYXme18+fXw== X-Google-Smtp-Source: ACHHUZ6kbqhr/TPUNRUBjOMcCyvZl0YAeoGa7f+ewqmGyUS6Zk1B4LHGaOTMnBL3L7tHEOAL97HQRg== X-Received: by 2002:a7b:c450:0:b0:3f4:2bb3:a5c9 with SMTP id l16-20020a7bc450000000b003f42bb3a5c9mr10217089wmi.8.1684829353862; Tue, 23 May 2023 01:09:13 -0700 (PDT) Received: from poulhies-Precision-5550.telnowedge.local (lmontsouris-659-1-24-67.w81-250.abo.wanadoo.fr. [81.250.175.67]) by smtp.gmail.com with ESMTPSA id u7-20020a7bc047000000b003f3157988f8sm10794426wmc.26.2023.05.23.01.09.12 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 23 May 2023 01:09:13 -0700 (PDT) From: =?UTF-8?q?Marc=20Poulhi=C3=A8s?= To: gcc-patches@gcc.gnu.org Cc: Eric Botcazou Subject: [COMMITTED] ada: Fix latent issue in support for protected entries Date: Tue, 23 May 2023 10:09:12 +0200 Message-Id: <20230523080912.1874731-1-poulhies@adacore.com> X-Mailer: git-send-email 2.40.0 MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Status: No, score=-13.6 required=5.0 tests=BAYES_00,DKIM_SIGNED,DKIM_VALID,DKIM_VALID_AU,DKIM_VALID_EF,GIT_PATCH_0,RCVD_IN_DNSWL_NONE,SPF_HELO_NONE,SPF_PASS,TXREP,T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org List-Id: From: Eric Botcazou The problem is that, unlike for protected subprograms, the expansion of cleanups for protected entries is not delayed when they contain package instances with a body, so the cleanups are generated twice and this may yield two finalizers if the secondary stack is used in the entry body. This restores the delaying, which uncovers the missing propagation of the Uses_Sec_Stack flag as is done for protected subprograms, which in turn requires using a Corresponding_Spec field as for protected subprograms. This also gets rid of the Delay_Subprogram_Descriptors flag on entities, whose only remaining use in Expand_Cleanup_Actions was unreachable. The last change is to unconditionally reset the scopes in the case of protected subprograms when they are expanded, as is done in the case of protected entries. This makes it possible to remove the code adjusting the scope on the fly in Cleanup_Scopes but requires a few adjustments. gcc/ada/ * einfo.ads (Delay_Subprogram_Descriptors): Delete. * gen_il-fields.ads (Opt_Field_Enum): Remove Delay_Subprogram_Descriptors. * gen_il-gen-gen_entities.adb (Gen_Entities): Likewise. * gen_il-gen-gen_nodes.adb (N_Entry_Body): Add Corresponding_Spec. * sinfo.ads (Corresponding_Spec): Document new use. (N_Entry_Body): Likewise. * exp_ch6.adb (Expand_Protected_Object_Reference): Be prepared for protected subprograms that have been expanded. * exp_ch7.adb (Expand_Cleanup_Actions): Remove unreachable code. * exp_ch9.adb (Build_Protected_Entry): Add a local variable for the new block and propagate Uses_Sec_Stack from the corresponding spec. (Expand_N_Protected_Body) : Unconditionally reset the scopes of top-level entities in the new body. * inline.adb (Cleanup_Scopes): Do not adjust the scope on the fly. * sem_ch9.adb (Analyze_Entry_Body): Set Corresponding_Spec. * sem_ch12.adb (Analyze_Package_Instantiation): Remove obsolete code setting Delay_Subprogram_Descriptors and tidy up. * sem_util.adb (Scope_Within): Deal with protected subprograms that have been expanded. (Scope_Within_Or_Same): Likewise. Tested on x86_64-pc-linux-gnu, committed on master. --- gcc/ada/einfo.ads | 21 ----------------- gcc/ada/exp_ch6.adb | 9 +++++--- gcc/ada/exp_ch7.adb | 10 --------- gcc/ada/exp_ch9.adb | 35 ++++++++++++++++------------- gcc/ada/gen_il-fields.ads | 1 - gcc/ada/gen_il-gen-gen_entities.adb | 1 - gcc/ada/gen_il-gen-gen_nodes.adb | 3 ++- gcc/ada/inline.adb | 10 --------- gcc/ada/sem_ch12.adb | 27 +--------------------- gcc/ada/sem_ch9.adb | 1 + gcc/ada/sem_util.adb | 16 +++++++++++++ gcc/ada/sinfo.ads | 5 +++-- 12 files changed, 48 insertions(+), 91 deletions(-) diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index d346eddac57..78a1534c749 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -871,23 +871,6 @@ package Einfo is -- entity must be delayed, since the insertion of the generic body -- may affect cleanup generation (see Inline for further details). --- Delay_Subprogram_Descriptors --- Defined in entities for which exception subprogram descriptors --- are generated (subprograms, package declarations and package --- bodies). Defined if there are pending generic body instantiations --- for the corresponding entity. If this flag is set, then generation --- of the subprogram descriptor for the corresponding entities must --- be delayed, since the insertion of the generic body may add entries --- to the list of handlers. --- --- Note: for subprograms, Delay_Subprogram_Descriptors is set if and --- only if Delay_Cleanups is set. But Delay_Cleanups can be set for a --- a block (in which case Delay_Subprogram_Descriptors is set for the --- containing subprogram). In addition Delay_Subprogram_Descriptors is --- set for a library level package declaration or body which contains --- delayed instantiations (in this case the descriptor refers to the --- enclosing elaboration procedure). - -- Delta_Value -- Defined in fixed and decimal types. Points to a universal real -- that holds value of delta for the type, as given in the declaration @@ -5552,7 +5535,6 @@ package Einfo is -- Contains_Ignored_Ghost_Code -- Default_Expressions_Processed -- Delay_Cleanups - -- Delay_Subprogram_Descriptors -- Discard_Names -- Elaboration_Entity_Required -- Has_Completion @@ -5801,7 +5783,6 @@ package Einfo is -- Body_Needed_For_Inlining -- Body_Needed_For_SAL -- Contains_Ignored_Ghost_Code - -- Delay_Subprogram_Descriptors -- Discard_Names -- Elaborate_Body_Desirable (non-generic case only) -- Elaboration_Entity_Required @@ -5844,7 +5825,6 @@ package Einfo is -- SPARK_Pragma -- SPARK_Aux_Pragma -- Contains_Ignored_Ghost_Code - -- Delay_Subprogram_Descriptors -- Ignore_SPARK_Mode_Pragmas -- SPARK_Aux_Pragma_Inherited -- SPARK_Pragma_Inherited @@ -5918,7 +5898,6 @@ package Einfo is -- Elaboration_Entity_Required -- Default_Expressions_Processed -- Delay_Cleanups - -- Delay_Subprogram_Descriptors -- Discard_Names -- Has_Completion -- Has_Expanded_Contract (non-generic case only) diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 3f81b2a6c27..28b746ba2c4 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -6265,10 +6265,13 @@ package body Exp_Ch6 is -- body subprogram points to itself. Proc := Current_Scope; - while Present (Proc) - and then Scope (Proc) /= Scop - loop + while Present (Proc) and then Scope (Proc) /= Scop loop Proc := Scope (Proc); + if Is_Subprogram (Proc) + and then Present (Protected_Subprogram (Proc)) + then + Proc := Protected_Subprogram (Proc); + end if; end loop; Corr := Protected_Body_Subprogram (Proc); diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index db2644fb287..98a62970cd0 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -5054,16 +5054,6 @@ package body Exp_Ch7 is if not Actions_Required then return; - - -- If the current node is a rewritten task body and the descriptors have - -- not been delayed (due to some nested instantiations), do not generate - -- redundant cleanup actions. - - elsif Is_Task_Body - and then Nkind (N) = N_Subprogram_Body - and then not Delay_Subprogram_Descriptors (Corresponding_Spec (N)) - then - return; end if; -- If an extended return statement contains something like diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index b51c60ea506..e0eeec49c01 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -3398,6 +3398,7 @@ package body Exp_Ch9 is Loc : constant Source_Ptr := Sloc (N); + Block_Id : Entity_Id; Bod_Id : Entity_Id; Bod_Spec : Node_Id; Bod_Stmts : List_Id; @@ -3456,11 +3457,12 @@ package body Exp_Ch9 is Analyze_Statements (Bod_Stmts); - Set_Scope (Entity (Identifier (First (Bod_Stmts))), - Protected_Body_Subprogram (Ent)); + Block_Id := Entity (Identifier (First (Bod_Stmts))); - Reset_Scopes_To - (First (Bod_Stmts), Entity (Identifier (First (Bod_Stmts)))); + Set_Scope (Block_Id, Protected_Body_Subprogram (Ent)); + Set_Uses_Sec_Stack (Block_Id, Uses_Sec_Stack (Corresponding_Spec (N))); + + Reset_Scopes_To (First (Bod_Stmts), Block_Id); case Corresponding_Runtime_Package (Pid) is when System_Tasking_Protected_Objects_Entries => @@ -8537,19 +8539,10 @@ package body Exp_Ch9 is New_Op_Spec := Corresponding_Spec (New_Op_Body); -- When the original subprogram body has nested subprograms, - -- the new body also has them, so set the flag accordingly - -- and reset the scopes of the top-level nested subprograms - -- and other declaration entities so that they now refer to - -- the new body's entity. (It would preferable to do this - -- within Build_Protected_Sub_Specification, which is called - -- from Build_Unprotected_Subprogram_Body, but the needed - -- subprogram entity isn't available via Corresponding_Spec - -- until after the above Analyze call.) + -- the new body also has them, so set the flag accordingly. - if Has_Nested_Subprogram (Op_Spec) then - Set_Has_Nested_Subprogram (New_Op_Spec); - Reset_Scopes_To (New_Op_Body, New_Op_Spec); - end if; + Set_Has_Nested_Subprogram + (New_Op_Spec, Has_Nested_Subprogram (New_Op_Spec)); -- Similarly, when the original subprogram body uses the -- secondary stack, the new body also does. This is needed @@ -8558,6 +8551,16 @@ package body Exp_Ch9 is Set_Uses_Sec_Stack (New_Op_Spec, Uses_Sec_Stack (Op_Spec)); + -- Now reset the scopes of the top-level nested subprograms + -- and other declaration entities so that they now refer to + -- the new body's entity (it would preferable to do this + -- within Build_Protected_Sub_Specification, which is called + -- from Build_Unprotected_Subprogram_Body, but the needed + -- subprogram entity isn't available via Corresponding_Spec + -- until after the above Analyze call). + + Reset_Scopes_To (New_Op_Body, New_Op_Spec); + -- Build the corresponding protected operation. This is -- needed only if this is a public or private operation of -- the type. diff --git a/gcc/ada/gen_il-fields.ads b/gcc/ada/gen_il-fields.ads index fd89fac869d..8a1db381c1f 100644 --- a/gcc/ada/gen_il-fields.ads +++ b/gcc/ada/gen_il-fields.ads @@ -490,7 +490,6 @@ package Gen_IL.Fields is Default_Expressions_Processed, Default_Value, Delay_Cleanups, - Delay_Subprogram_Descriptors, Delta_Value, Dependent_Instances, Depends_On_Private, diff --git a/gcc/ada/gen_il-gen-gen_entities.adb b/gcc/ada/gen_il-gen-gen_entities.adb index d531e4a8efa..ebc0f204b03 100644 --- a/gcc/ada/gen_il-gen-gen_entities.adb +++ b/gcc/ada/gen_il-gen-gen_entities.adb @@ -57,7 +57,6 @@ begin -- Gen_IL.Gen.Gen_Entities Sm (Debug_Info_Off, Flag), Sm (Default_Expressions_Processed, Flag), Sm (Delay_Cleanups, Flag), - Sm (Delay_Subprogram_Descriptors, Flag), Sm (Depends_On_Private, Flag), Sm (Disable_Controlled, Flag, Base_Type_Only), Sm (Discard_Names, Flag), diff --git a/gcc/ada/gen_il-gen-gen_nodes.adb b/gcc/ada/gen_il-gen-gen_nodes.adb index a330f6913c5..864b7c49198 100644 --- a/gcc/ada/gen_il-gen-gen_nodes.adb +++ b/gcc/ada/gen_il-gen-gen_nodes.adb @@ -1345,7 +1345,8 @@ begin -- Gen_IL.Gen.Gen_Nodes Sy (Declarations, List_Id, Default_No_List), Sy (Handled_Statement_Sequence, Node_Id, Default_Empty), Sy (At_End_Proc, Node_Id, Default_Empty), - Sm (Activation_Chain_Entity, Node_Id))); + Sm (Activation_Chain_Entity, Node_Id), + Sm (Corresponding_Spec, Node_Id))); Cc (N_Entry_Call_Alternative, Node_Kind, (Sy (Entry_Call_Statement, Node_Id), diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index 07f806a40de..b2ff7c9e405 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -2824,16 +2824,6 @@ package body Inline is while Present (Elmt) loop Scop := Node (Elmt); - if Ekind (Scop) = E_Entry then - Scop := Protected_Body_Subprogram (Scop); - - elsif Is_Subprogram (Scop) - and then Is_Protected_Type (Underlying_Type (Scope (Scop))) - and then Present (Protected_Body_Subprogram (Scop)) - then - Scop := Protected_Body_Subprogram (Scop); - end if; - if Ekind (Scop) = E_Block then Decl := Parent (Block_Node (Scop)); diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index c31d0c62faa..91a1fad444c 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -4810,16 +4810,7 @@ package body Sem_Ch12 is Scope_Loop : while Enclosing_Master /= Standard_Standard loop if Ekind (Enclosing_Master) = E_Package then if Is_Compilation_Unit (Enclosing_Master) then - if In_Package_Body (Enclosing_Master) then - Set_Delay_Subprogram_Descriptors - (Body_Entity (Enclosing_Master)); - else - Set_Delay_Subprogram_Descriptors - (Enclosing_Master); - end if; - exit Scope_Loop; - else Enclosing_Master := Scope (Enclosing_Master); end if; @@ -4835,35 +4826,19 @@ package body Sem_Ch12 is exit Scope_Loop; else - if Ekind (Enclosing_Master) = E_Entry - and then - Ekind (Scope (Enclosing_Master)) = E_Protected_Type - then - if not Expander_Active then - exit Scope_Loop; - else - Enclosing_Master := - Protected_Body_Subprogram (Enclosing_Master); - end if; - end if; - Set_Delay_Cleanups (Enclosing_Master); while Ekind (Enclosing_Master) = E_Block loop Enclosing_Master := Scope (Enclosing_Master); end loop; - if Is_Subprogram (Enclosing_Master) then - Set_Delay_Subprogram_Descriptors (Enclosing_Master); - - elsif Is_Task_Type (Enclosing_Master) then + if Is_Task_Type (Enclosing_Master) then declare TBP : constant Node_Id := Get_Task_Body_Procedure (Enclosing_Master); begin if Present (TBP) then - Set_Delay_Subprogram_Descriptors (TBP); Set_Delay_Cleanups (TBP); end if; end; diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb index 67f8aa9c7ba..90b0ff08540 100644 --- a/gcc/ada/sem_ch9.adb +++ b/gcc/ada/sem_ch9.adb @@ -1305,6 +1305,7 @@ package body Sem_Ch9 is Entry_Name := E; Set_Convention (Id, Convention (E)); Set_Corresponding_Body (Parent (E), Id); + Set_Corresponding_Spec (N, E); Check_Fully_Conformant (Id, E, N); if Ekind (Id) = E_Entry_Family then diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 7e302897888..22dc9376b92 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -27268,6 +27268,15 @@ package body Sem_Util is then return True; + -- The body of a protected operation is within the protected type + + elsif Is_Subprogram (Curr) + and then Present (Protected_Subprogram (Curr)) + and then Is_Protected_Type (Outer) + and then Scope (Protected_Subprogram (Curr)) = Outer + then + return True; + -- Outside of its scope, a synchronized type may just be private elsif Is_Private_Type (Curr) @@ -27309,6 +27318,13 @@ package body Sem_Util is then return True; + elsif Is_Subprogram (Curr) + and then Present (Protected_Subprogram (Curr)) + and then Is_Protected_Type (Outer) + and then Scope (Protected_Subprogram (Curr)) = Outer + then + return True; + elsif Is_Private_Type (Curr) and then Present (Full_View (Curr)) then diff --git a/gcc/ada/sinfo.ads b/gcc/ada/sinfo.ads index ce54dd3fb91..b0ac6f900ed 100644 --- a/gcc/ada/sinfo.ads +++ b/gcc/ada/sinfo.ads @@ -1052,8 +1052,8 @@ package Sinfo is -- and their first named subtypes. -- Corresponding_Spec - -- This field is set in subprogram, package, task, and protected body - -- nodes, where it points to the defining entity in the corresponding + -- This field is set in subprogram, package, task, entry and protected + -- body nodes where it points to the defining entity in the corresponding -- spec. The attribute is also set in N_With_Clause nodes where it points -- to the defining entity for the with'ed spec, and in a subprogram -- renaming declaration when it is a Renaming_As_Body. The field is Empty @@ -6206,6 +6206,7 @@ package Sinfo is -- Declarations -- Handled_Statement_Sequence -- Activation_Chain_Entity + -- Corresponding_Spec -- At_End_Proc (set to Empty if no clean up procedure) ----------------------------------- -- 2.40.0